diff options
Diffstat (limited to 'src/Identity.hs')
| -rw-r--r-- | src/Identity.hs | 25 |
1 files changed, 14 insertions, 11 deletions
diff --git a/src/Identity.hs b/src/Identity.hs index 834e5ee..9653077 100644 --- a/src/Identity.hs +++ b/src/Identity.hs @@ -21,7 +21,8 @@ module Identity ( import Control.Arrow import Control.Monad import Control.Monad.Except -import qualified Control.Monad.Identity as I +import Control.Monad.Identity qualified as I +import Control.Monad.Reader import Data.Either import Data.Foldable @@ -122,13 +123,17 @@ createIdentity st name owner = do let signOwner idd | Just o <- owner = do - Just ownerSecret <- loadKey (iddKeyIdentity $ fromStored $ signedData $ fromStored $ idData o) + Just ownerSecret <- loadKeyMb (iddKeyIdentity $ fromStored $ signedData $ fromStored $ idData o) signAdd ownerSecret idd | otherwise = return idd - Just identity <- return . validateIdentity =<< wrappedStore st =<< signOwner =<< sign secret =<< - wrappedStore st (emptyIdentityData public) - { iddName = name, iddOwner = idData <$> owner, iddKeyMessage = Just publicMsg } + Just identity <- flip runReaderT st $ do + return . validateIdentity =<< mstore =<< signOwner =<< sign secret =<< + mstore (emptyIdentityData public) + { iddName = name + , iddOwner = idData <$> owner + , iddKeyMessage = Just publicMsg + } return identity validateIdentity :: Stored (Signed IdentityData) -> Maybe UnifiedIdentity @@ -192,7 +197,7 @@ lookupProperty sel topHeads = findResult filteredLayers findResult [xs] = Just $ snd $ minimumBy (comparing fst) xs findResult (_:rest) = findResult rest -mergeIdentity :: Foldable m => Identity m -> IO UnifiedIdentity +mergeIdentity :: (Foldable f, MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity mergeIdentity idt | Just idt' <- toUnifiedIdentity idt = return idt' mergeIdentity idt = do (owner, ownerData) <- case idOwner_ idt of @@ -201,11 +206,9 @@ mergeIdentity idt = do | otherwise -> do owner <- mergeIdentity cowner return (Just owner, Just $ idData owner) - (sid:_) <- return $ toList $ idDataF idt - let st = storedStorage sid - public = idKeyIdentity idt - Just secret <- loadKey public - sdata <- wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentityData public) + let public = idKeyIdentity idt + secret <- loadKey public + sdata <- mstore =<< sign secret =<< mstore (emptyIdentityData public) { iddPrev = toList $ idDataF idt, iddOwner = ownerData } return $ idt { idData_ = I.Identity sdata, idOwner_ = toComposedIdentity <$> owner } |