diff options
Diffstat (limited to 'src/State.hs')
-rw-r--r-- | src/State.hs | 34 |
1 files changed, 26 insertions, 8 deletions
diff --git a/src/State.hs b/src/State.hs index 515391d..bb193a3 100644 --- a/src/State.hs +++ b/src/State.hs @@ -2,15 +2,19 @@ module State ( LocalState(..), SharedState(..), - loadLocalState, + loadLocalState, loadLocalStateHead, updateLocalState, updateLocalState_, updateSharedState, updateSharedState_, mergeSharedStates, + loadLocalIdentity, headLocalIdentity, + mergeSharedIdentity, - updateIdentity, + updateSharedIdentity, ) where +import Control.Monad + import Data.List import Data.Maybe import qualified Data.Text as T @@ -56,8 +60,11 @@ instance Storable SharedState where <*> loadRefs "id" -loadLocalState :: Storage -> IO Head -loadLocalState st = loadHeadDef st "erebos" $ do +loadLocalState :: Storage -> IO (Stored LocalState) +loadLocalState = return . wrappedLoad . headRef <=< loadLocalStateHead + +loadLocalStateHead :: Storage -> IO Head +loadLocalStateHead st = loadHeadDef st "erebos" $ do putStr "Name: " hFlush stdout name <- T.getLine @@ -97,6 +104,17 @@ loadLocalState st = loadHeadDef st "erebos" $ do , lsMessages = msgs } +loadLocalIdentity :: Storage -> IO UnifiedIdentity +loadLocalIdentity = return . headLocalIdentity <=< loadLocalStateHead + +headLocalIdentity :: Head -> UnifiedIdentity +headLocalIdentity h = + let ls = load $ headRef h + in maybe (error "failed to verify local identity") + (updateOwners (ssIdentity . fromStored =<< lsShared ls)) + (validateIdentity $ lsIdentity ls) + + updateLocalState_ :: Storage -> (Stored LocalState -> IO (Stored LocalState)) -> IO () updateLocalState_ st f = updateLocalState st (fmap (,()) . f) @@ -127,15 +145,15 @@ mergeSharedStates [] = error "mergeSharedStates: empty list" mergeSharedIdentity :: Storage -> IO UnifiedIdentity mergeSharedIdentity st = updateSharedState st $ \sshared -> do let shared = fromStored sshared - Just cidentity = verifyIdentityF $ ssIdentity shared + Just cidentity = validateIdentityF $ ssIdentity shared identity <- mergeIdentity cidentity sshared' <- wrappedStore st $ shared { ssIdentity = [idData identity] } return (sshared', identity) -updateIdentity :: Storage -> IO () -updateIdentity st = updateSharedState_ st $ \sshared -> do +updateSharedIdentity :: Storage -> IO () +updateSharedIdentity st = updateSharedState_ st $ \sshared -> do let shared = fromStored sshared - Just identity = verifyIdentityF $ ssIdentity shared + Just identity = validateIdentityF $ ssIdentity shared public = idKeyIdentity identity T.putStr $ T.concat $ concat |