Interactive identity update for custom refs

2 files changed, 20 insertions, 6 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 93517b2..b143253 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -71,6 +71,14 @@ main = do
 
         ["update-identity"] -> updateSharedIdentity st
 
+        ("update-identity" : srefs) -> do
+            sequence <$> mapM (readRef st . BC.pack) srefs >>= \case
+                Nothing -> error "ref does not exist"
+                Just refs
+                    | Just idt <- validateIdentityF $ map wrappedLoad refs -> do
+                        BC.putStrLn . showRefDigest . refDigest . storedRef . idData =<< interactiveIdentityUpdate idt
+                    | otherwise -> error "invalid identity"
+
         [bhost] -> interactiveLoop st bhost
         _       -> error "Expecting broadcast address"
 
diff --git a/src/State.hs b/src/State.hs
index cd94052..f3bd2d9 100644
--- a/src/State.hs
+++ b/src/State.hs
@@ -11,10 +11,12 @@ module State (
 
     mergeSharedIdentity,
     updateSharedIdentity,
+    interactiveIdentityUpdate,
 ) where
 
 import Control.Monad
 
+import Data.Foldable
 import Data.List
 import Data.Maybe
 import qualified Data.Text as T
@@ -155,6 +157,12 @@ updateSharedIdentity :: Storage -> IO ()
 updateSharedIdentity st = updateSharedState_ st $ \sshared -> do
     let shared = fromStored sshared
         Just identity = validateIdentityF $ ssIdentity shared
+    identity' <- interactiveIdentityUpdate identity
+    wrappedStore st shared { ssIdentity = [idData identity'] }
+
+interactiveIdentityUpdate :: Foldable m => Identity m -> IO UnifiedIdentity
+interactiveIdentityUpdate identity = do
+    let st = storedStorage $ head $ toList $ idDataF $ identity
         public = idKeyIdentity identity
 
     T.putStr $ T.concat $ concat
@@ -167,13 +175,11 @@ updateSharedIdentity st = updateSharedState_ st $ \sshared -> do
     hFlush stdout
     name <- T.getLine
 
-    identity' <- if
-        | T.null name -> idData <$> mergeIdentity identity
+    if  | T.null name -> mergeIdentity identity
         | otherwise -> do
             Just secret <- loadKey public
-            wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentityData public)
-                { iddPrev = ssIdentity shared
+            maybe (error "created invalid identity") return . validateIdentity =<<
+                wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentityData public)
+                { iddPrev = toList $ idDataF identity
                 , iddName = Just name
                 }
-
-    wrappedStore st shared { ssIdentity = [identity'] }