summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs8
-rw-r--r--src/State.hs18
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'] }