diff options
Diffstat (limited to 'src/Erebos/Identity.hs')
| -rw-r--r-- | src/Erebos/Identity.hs | 47 |
1 files changed, 25 insertions, 22 deletions
diff --git a/src/Erebos/Identity.hs b/src/Erebos/Identity.hs index a3f17b5..491df6e 100644 --- a/src/Erebos/Identity.hs +++ b/src/Erebos/Identity.hs @@ -214,29 +214,33 @@ isExtension x = case fromSigned x of BaseIdentityData {} -> False _ -> True -createIdentity :: Storage -> Maybe Text -> Maybe UnifiedIdentity -> IO UnifiedIdentity -createIdentity st name owner = do - (secret, public) <- generateKeys st - (_secretMsg, publicMsg) <- generateKeys st - - let signOwner :: Signed a -> ReaderT Storage IO (Signed a) +createIdentity + :: forall m e. (MonadStorage m, MonadError e m, FromErebosError e, MonadIO m) + => Maybe Text -> Maybe UnifiedIdentity -> m UnifiedIdentity +createIdentity name owner = do + st <- getStorage + ( secret, public ) <- liftIO $ generateKeys st + ( _secretMsg, publicMsg ) <- liftIO $ generateKeys st + + let signOwner :: Signed a -> m (Signed a) signOwner idd | Just o <- owner = do - Just ownerSecret <- loadKeyMb (iddKeyIdentity $ fromSigned $ idData o) + ownerSecret <- maybe (throwOtherError "failed to load private key") return =<< + loadKeyMb (iddKeyIdentity $ fromSigned $ idData o) signAdd ownerSecret idd | otherwise = return idd - Just identity <- flip runReaderT st $ do - baseData <- mstore =<< signOwner =<< sign secret =<< - mstore (emptyIdentityData public) - { iddOwner = idData <$> owner - , iddKeyMessage = Just publicMsg - } - let extOwner = do - odata <- idExtData <$> owner - guard $ isExtension odata - return odata - + baseData <- mstore =<< signOwner =<< sign secret =<< + mstore (emptyIdentityData public) + { iddOwner = idData <$> owner + , iddKeyMessage = Just publicMsg + } + let extOwner = do + odata <- idExtData <$> owner + guard $ isExtension odata + return odata + + maybe (throwOtherError "created invalid identity") return =<< do validateExtendedIdentityF . I.Identity <$> if isJust name || isJust extOwner then mstore =<< signOwner =<< sign secret =<< @@ -245,7 +249,6 @@ createIdentity st name owner = do , ideOwner = extOwner } else return $ baseToExtended baseData - return identity validateIdentity :: Stored (Signed IdentityData) -> Maybe UnifiedIdentity validateIdentity = validateIdentityF . I.Identity @@ -388,13 +391,13 @@ sameIdentity x y = intersectsSorted (roots x) (roots y) roots idt = uniq $ sort $ concatMap storedRoots $ toList $ idDataF idt -unfoldOwners :: (Foldable m) => Identity m -> [ComposedIdentity] +unfoldOwners :: Foldable m => Identity m -> [ComposedIdentity] unfoldOwners = unfoldr (fmap (\i -> (i, idOwner i))) . Just . toComposedIdentity -finalOwner :: (Foldable m, Applicative m) => Identity m -> ComposedIdentity +finalOwner :: Foldable m => Identity m -> ComposedIdentity finalOwner = last . unfoldOwners -displayIdentity :: (Foldable m, Applicative m) => Identity m -> Text +displayIdentity :: Foldable m => Identity m -> Text displayIdentity identity = T.concat [ T.intercalate (T.pack " / ") $ map (fromMaybe (T.pack "<unnamed>") . idName) owners ] |