1 files changed, 32 insertions, 23 deletions
diff --git a/src/Erebos/Identity.hs b/src/Erebos/Identity.hs
index f2094f6..bd5acb3 100644
--- a/src/Erebos/Identity.hs
+++ b/src/Erebos/Identity.hs
@@ -13,7 +13,7 @@ module Erebos.Identity (
     createIdentity,
     validateIdentity, validateIdentityF, validateIdentityFE,
     validateExtendedIdentity, validateExtendedIdentityF, validateExtendedIdentityFE,
-    loadIdentity, loadUnifiedIdentity,
+    loadIdentity, loadMbIdentity, loadUnifiedIdentity, loadMbUnifiedIdentity,
 
     mergeIdentity, toUnifiedIdentity, toComposedIdentity,
     updateIdentity, updateOwners,
@@ -41,7 +41,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 
 import Erebos.PubKey
-import Erebos.Storage
+import Erebos.Storable
 import Erebos.Storage.Merge
 import Erebos.Util
 
@@ -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
+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 -> ReaderT Storage IO (Signed a)
+    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
@@ -280,10 +283,16 @@ validateExtendedIdentityFE mdata = do
                  Just mk -> return mk
 
 loadIdentity :: String -> LoadRec ComposedIdentity
-loadIdentity name = maybe (throwError "identity validation failed") return . validateExtendedIdentityF =<< loadRefs name
+loadIdentity name = maybe (throwOtherError "identity validation failed") return . validateExtendedIdentityF =<< loadRefs name
+
+loadMbIdentity :: String -> LoadRec (Maybe ComposedIdentity)
+loadMbIdentity name = return . validateExtendedIdentityF =<< loadRefs name
 
 loadUnifiedIdentity :: String -> LoadRec UnifiedIdentity
-loadUnifiedIdentity name = maybe (throwError "identity validation failed") return . validateExtendedIdentity =<< loadRef name
+loadUnifiedIdentity name = maybe (throwOtherError "identity validation failed") return . validateExtendedIdentity =<< loadRef name
+
+loadMbUnifiedIdentity :: String -> LoadRec (Maybe UnifiedIdentity)
+loadMbUnifiedIdentity name = return . (validateExtendedIdentity =<<) =<< loadMbRef name
 
 
 gatherPrevious :: Set (Stored (Signed ExtendedIdentityData)) -> [Stored (Signed ExtendedIdentityData)] -> Set (Stored (Signed ExtendedIdentityData))
@@ -316,7 +325,7 @@ lookupProperty sel topHeads = findResult propHeads
     findResult [] = Nothing
     findResult xs = sel $ fromSigned $ minimum xs
 
-mergeIdentity :: (MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity
+mergeIdentity :: (MonadStorage m, MonadError e m, FromErebosError e, MonadIO m) => Identity f -> m UnifiedIdentity
 mergeIdentity idt | Just idt' <- toUnifiedIdentity idt = return idt'
 mergeIdentity idt@Identity {..} = do
     (owner, ownerData) <- case idOwner_ of