From 469e1be7381a5739e89cc5277853a532d7a3a063 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 3 Aug 2025 19:28:01 +0200
Subject: Add create-identity/owner command-line options

---
 main/State.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'main/State.hs')

diff --git a/main/State.hs b/main/State.hs
index 150178e..f7bc367 100644
--- a/main/State.hs
+++ b/main/State.hs
@@ -1,15 +1,18 @@
 module State (
     loadLocalStateHead,
+    createLocalStateHead,
     updateSharedIdentity,
     interactiveIdentityUpdate,
 ) where
 
+import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 
 import Data.Foldable
 import Data.Maybe
 import Data.Proxy
+import Data.Text (Text)
 import Data.Text qualified as T
 
 import Erebos.Error
@@ -50,6 +53,25 @@ loadLocalStateHead term st = loadHeads st >>= \case
             , lsOther = []
             }
 
+createLocalStateHead :: (MonadIO m, MonadFail m) => Storage -> [ Maybe Text ] -> m (Head LocalState)
+createLocalStateHead _ [] = fail "createLocalStateHead: empty name list"
+createLocalStateHead st ( ownerName : names ) = liftIO $ do
+    owner <- createIdentity st ownerName Nothing
+    identity <- foldM createSingleIdentity owner names
+    shared <- wrappedStore st $ SharedState
+        { ssPrev = []
+        , ssType = Just $ sharedTypeID @(Maybe ComposedIdentity) Proxy
+        , ssValue = [ storedRef $ idExtData owner ]
+        }
+    storeHead st $ LocalState
+        { lsPrev = Nothing
+        , lsIdentity = idExtData identity
+        , lsShared = [ shared ]
+        , lsOther = []
+        }
+  where
+    createSingleIdentity owner name = createIdentity st name (Just owner)
+
 
 updateSharedIdentity :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => Terminal -> m ()
 updateSharedIdentity term = updateLocalState_ $ updateSharedState_ $ \case
-- 
cgit v1.2.3