Provide createIdentity function from Identity module

2 files changed, 24 insertions, 20 deletions

diff --git a/src/Identity.hs b/src/Identity.hs
index 0f3e81b..0e3e318 100644
--- a/src/Identity.hs
+++ b/src/Identity.hs
@@ -5,6 +5,7 @@ module Identity (
     idData, idDataF, idName, idOwner, idUpdates, idKeyIdentity, idKeyMessage,
 
     emptyIdentityData,
+    createIdentity,
     validateIdentity, validateIdentityF,
     loadIdentity, loadUnifiedIdentity,
 
@@ -108,6 +109,22 @@ emptyIdentityData key = IdentityData
     , iddKeyMessage = Nothing
     }
 
+createIdentity :: Storage -> Maybe Text -> Maybe UnifiedIdentity -> IO UnifiedIdentity
+createIdentity st name owner = do
+    (secret, public) <- generateKeys st
+    (_secretMsg, publicMsg) <- generateKeys st
+
+    let signOwner idd
+            | Just o <- owner = do
+                Just ownerSecret <- loadKey (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 }
+    return identity
+
 validateIdentity :: Stored (Signed IdentityData) -> Maybe UnifiedIdentity
 validateIdentity = validateIdentityF . I.Identity
 
diff --git a/src/State.hs b/src/State.hs
index 8e9e320..55c55e1 100644
--- a/src/State.hs
+++ b/src/State.hs
@@ -90,32 +90,19 @@ loadLocalStateHead st = loadHeads st >>= \case
         hFlush stdout
         devName <- T.getLine
 
-        (owner, secret) <- if
-            | T.null name -> return (Nothing, Nothing)
-            | otherwise -> do
-                (secret, public) <- generateKeys st
-                (_secretMsg, publicMsg) <- generateKeys st
-
-                return . (, Just secret) . Just =<< wrappedStore st =<< sign secret =<<
-                    wrappedStore st (emptyIdentityData public)
-                    { iddName = Just name, iddKeyMessage = Just publicMsg }
-
-        (devSecret, devPublic) <- generateKeys st
-        (_devSecretMsg, devPublicMsg) <- generateKeys st
-
-        identity <- wrappedStore st =<< maybe return signAdd secret =<< sign devSecret =<< wrappedStore st (emptyIdentityData devPublic)
-            { iddName = if T.null devName then Nothing else Just devName
-            , iddOwner = owner
-            , iddKeyMessage = Just devPublicMsg
-            }
+        owner <- if
+            | T.null name -> return Nothing
+            | otherwise -> Just <$> createIdentity st (Just name) Nothing
+
+        identity <- createIdentity st (if T.null devName then Nothing else Just devName) owner
 
         shared <- wrappedStore st $ SharedState
             { ssPrev = []
             , ssType = Just $ sharedTypeID @(Signed IdentityData) Proxy
-            , ssValue = [storedRef $ fromMaybe identity owner]
+            , ssValue = [storedRef $ idData $ fromMaybe identity owner]
             }
         storeHead st $ LocalState
-            { lsIdentity = identity
+            { lsIdentity = idData identity
             , lsShared = [shared]
             }