1 files changed, 26 insertions, 77 deletions

diff --git a/src/Erebos/State.hs b/src/Erebos/State.hs
index 3012064..076a8c0 100644
--- a/src/Erebos/State.hs
+++ b/src/Erebos/State.hs
@@ -1,13 +1,13 @@
 module Erebos.State (
     LocalState(..),
-    SharedState, SharedType(..),
+    SharedState(..), SharedType(..),
     SharedTypeID, mkSharedTypeID,
 
+    MonadStorage(..),
     MonadHead(..),
     updateLocalHead_,
 
-    loadLocalStateHead,
-
+    updateLocalState, updateLocalState_,
     updateSharedState, updateSharedState_,
     lookupSharedValue, makeSharedStateUpdate,
 
@@ -15,8 +15,6 @@ module Erebos.State (
     headLocalIdentity,
 
     mergeSharedIdentity,
-    updateSharedIdentity,
-    interactiveIdentityUpdate,
 ) where
 
 import Control.Monad.Except
@@ -24,23 +22,20 @@ import Control.Monad.Reader
 
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 qualified as BC
-import Data.Foldable
-import Data.Maybe
-import Data.Text qualified as T
-import Data.Text.IO qualified as T
 import Data.Typeable
-import Data.UUID (UUID)
-import Data.UUID qualified as U
-
-import System.IO
 
 import Erebos.Identity
+import Erebos.Object
 import Erebos.PubKey
-import Erebos.Storage
+import Erebos.Storable
+import Erebos.Storage.Head
 import Erebos.Storage.Merge
+import Erebos.UUID (UUID)
+import Erebos.UUID qualified as U
 
 data LocalState = LocalState
-    { lsIdentity :: Stored (Signed ExtendedIdentityData)
+    { lsPrev :: Maybe RefDigest
+    , lsIdentity :: Stored (Signed ExtendedIdentityData)
     , lsShared :: [Stored SharedState]
     , lsOther :: [ ( ByteString, RecItem ) ]
     }
@@ -62,11 +57,13 @@ class Mergeable a => SharedType a where
 
 instance Storable LocalState where
     store' LocalState {..} = storeRec $ do
+        mapM_ (storeRawWeak "PREV") lsPrev
         storeRef "id" lsIdentity
         mapM_ (storeRef "shared") lsShared
         storeRecItems lsOther
 
     load' = loadRec $ do
+        lsPrev <- loadMbRawWeak "PREV"
         lsIdentity <- loadRef "id"
         lsShared <- loadRefs "shared"
         lsOther <- filter ((`notElem` [ BC.pack "id", BC.pack "shared" ]) . fst) <$> loadRecItems
@@ -104,35 +101,6 @@ instance (HeadType a, MonadIO m) => MonadHead a (ReaderT (Head a) m) where
         snd <$> updateHead h f
 
 
-loadLocalStateHead :: MonadIO m => Storage -> m (Head LocalState)
-loadLocalStateHead st = loadHeads st >>= \case
-    (h:_) -> return h
-    [] -> liftIO $ do
-        putStr "Name: "
-        hFlush stdout
-        name <- T.getLine
-
-        putStr "Device: "
-        hFlush stdout
-        devName <- T.getLine
-
-        owner <- if
-            | T.null name -> return Nothing
-            | otherwise -> Just <$> createIdentity st (Just name) Nothing
-
-        identity <- createIdentity st (if T.null devName then Nothing else Just devName) owner
-
-        shared <- wrappedStore st $ SharedState
-            { ssPrev = []
-            , ssType = Just $ sharedTypeID @(Maybe ComposedIdentity) Proxy
-            , ssValue = [storedRef $ idExtData $ fromMaybe identity owner]
-            }
-        storeHead st $ LocalState
-            { lsIdentity = idExtData identity
-            , lsShared = [ shared ]
-            , lsOther = []
-            }
-
 localIdentity :: LocalState -> UnifiedIdentity
 localIdentity ls = maybe (error "failed to verify local identity")
     (updateOwners $ maybe [] idExtDataF $ lookupSharedValue $ lsShared ls)
@@ -142,6 +110,17 @@ headLocalIdentity :: Head LocalState -> UnifiedIdentity
 headLocalIdentity = localIdentity . headObject
 
 
+updateLocalState :: forall m b. MonadHead LocalState m => (Stored LocalState -> m ( Stored LocalState, b )) -> m b
+updateLocalState f = updateLocalHead $ \ls -> do
+    ( ls', x ) <- f ls
+    (, x) <$> if ls' == ls
+      then return ls'
+      else mstore (fromStored ls') { lsPrev = Just $ refDigest (storedRef ls) }
+
+updateLocalState_ :: forall m. MonadHead LocalState m => (Stored LocalState -> m (Stored LocalState)) -> m ()
+updateLocalState_ f = updateLocalState (fmap (,()) . f)
+
+
 updateSharedState_ :: forall a m. (SharedType a, MonadHead LocalState m) => (a -> m a) -> Stored LocalState -> m (Stored LocalState)
 updateSharedState_ f = fmap fst <$> updateSharedState (fmap (,()) . f)
 
@@ -170,39 +149,9 @@ makeSharedStateUpdate st val prev = liftIO $ wrappedStore st SharedState
     }
 
 
-mergeSharedIdentity :: (MonadHead LocalState m, MonadError String m) => m UnifiedIdentity
-mergeSharedIdentity = updateLocalHead $ updateSharedState $ \case
+mergeSharedIdentity :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => m UnifiedIdentity
+mergeSharedIdentity = updateLocalState $ updateSharedState $ \case
     Just cidentity -> do
         identity <- mergeIdentity cidentity
         return (Just $ toComposedIdentity identity, identity)
-    Nothing -> throwError "no existing shared identity"
-
-updateSharedIdentity :: (MonadHead LocalState m, MonadError String m) => m ()
-updateSharedIdentity = updateLocalHead_ $ updateSharedState_ $ \case
-    Just identity -> do
-        Just . toComposedIdentity <$> interactiveIdentityUpdate identity
-    Nothing -> throwError "no existing shared identity"
-
-interactiveIdentityUpdate :: (Foldable f, MonadStorage m, MonadIO m, MonadError String m) => Identity f -> m UnifiedIdentity
-interactiveIdentityUpdate identity = do
-    let public = idKeyIdentity identity
-
-    name <- liftIO $ do
-        T.putStr $ T.concat $ concat
-            [ [ T.pack "Name" ]
-            , case idName identity of
-                   Just name -> [T.pack " [", name, T.pack "]"]
-                   Nothing -> []
-            , [ T.pack ": " ]
-            ]
-        hFlush stdout
-        T.getLine
-
-    if  | T.null name -> mergeIdentity identity
-        | otherwise -> do
-            secret <- loadKey public
-            maybe (throwError "created invalid identity") return . validateIdentity =<<
-                mstore =<< sign secret =<< mstore (emptyIdentityData public)
-                { iddPrev = toList $ idDataF identity
-                , iddName = Just name
-                }
+    Nothing -> throwOtherError "no existing shared identity"