diff options
Diffstat (limited to 'main/State.hs')
-rw-r--r-- | main/State.hs | 22 |
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 |