summaryrefslogtreecommitdiff
path: root/main/State.hs
diff options
context:
space:
mode:
Diffstat (limited to 'main/State.hs')
-rw-r--r--main/State.hs22
1 files changed, 22 insertions, 0 deletions
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