save lww ref data to state

hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs

@@ -162,7 +162,7 @@ export key refs  = do
 
   subscribeLWWRef key
 
-  lww@LWWBlockData{..} <- waitOrInitLWWRef
+  (lww, LWWBlockData{..}) <- waitOrInitLWWRef
 
   let puk0 = fromLwwRefKey key
 

hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs

@@ -91,7 +91,11 @@ importRepoWait lwwKey = do
           fetchLWWRef lwwKey
           next (IWaitLWWBlock (pred w))
 
-        Just (LWWBlockData{..}) -> do
+        Just (LWWRef{..}, LWWBlockData{..}) -> do
+
+          withState do
+            insertLww lwwKey lwwSeq lwwRefLogPubKey
+
           void $ try @_ @SomeException (getRefLogMerkle lwwRefLogPubKey)
           subscribeRefLog lwwRefLogPubKey
           pause @'Seconds 0.25

hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/RefLog.hs

@@ -1,9 +1,13 @@
-module HBS2.Git.Client.RefLog where
+module HBS2.Git.Client.RefLog
+  ( module HBS2.Git.Client.RefLog
+  , module HBS2.Peer.Proto.RefLog
+  ) where
 
 import HBS2.Git.Client.Prelude
 import HBS2.Git.Client.App.Types
 import HBS2.Git.Data.RefLog
 import HBS2.Git.Data.LWWBlock
+import HBS2.Peer.Proto.RefLog
 
 data RefLogRequestTimeout = RefLogRequestTimeout
                             deriving (Show,Typeable)

hbs21-git/hbs2-git-client-lib/HBS2/Git/Client/State.hs

@@ -10,14 +10,16 @@ import HBS2.Git.Client.Prelude
 import HBS2.Git.Client.App.Types
 import HBS2.Git.Client.Config
 
+import HBS2.Peer.Proto.RefLog
+
 import HBS2.Git.Data.RefLog
+import HBS2.Git.Data.LWWBlock
 
 import DBPipe.SQLite
 import Data.Maybe
 import Data.List qualified as List
-
 import Text.InterpolatedString.Perl6 (qc)
-
+import Data.Word
 
 newtype Base58Field a = Base58Field { fromBase58Field :: a }
                         deriving stock (Eq,Ord,Generic)
@@ -28,6 +30,9 @@ instance Pretty (AsBase58 a) => ToField (Base58Field a) where
 instance IsString a => FromField (Base58Field a) where
   fromField = fmap (Base58Field . fromString) . fromField @String
 
+instance FromField (RefLogKey HBS2Basic) where
+  fromField = fmap fromString . fromField @String
+
 instance ToField HashRef where
   toField h = toField @String (show $ pretty h)
 
@@ -46,6 +51,8 @@ instance FromField GitRef where
 instance FromField GitHash where
   fromField = fmap fromString . fromField @String
 
+instance FromField (LWWRefKey HBS2Basic) where
+  fromField = fmap fromString . fromField @String
 
 createStateDir :: (GitPerks m, MonadReader GitEnv m)  => m ()
 createStateDir = do
@@ -74,6 +81,7 @@ evolveDB = withState do
   createBundleKeyTable
   createBundleObjectTable
   createNewGK0Table
+  createLwwTable
   commitAll
 
 createTxTable :: MonadIO m => DBPipeM m ()
@@ -156,6 +164,19 @@ create table if not exists newgk0
   )
   |]
 
+
+createLwwTable :: MonadIO m => DBPipeM m ()
+createLwwTable = do
+  ddl [qc|
+create table if not exists lww
+  ( hash      text not null
+  , seq       text not null
+  , reflog    text not null
+  , primary key (hash,seq,reflog)
+  )
+  |]
+
+
 existsTx :: MonadIO m => HashRef -> DBPipeM m Bool
 existsTx txHash = do
   select @(Only Bool) [qc|
@@ -346,3 +367,16 @@ limit 1
   |] (Only (Base58Field reflog)) <&> listToMaybe
 
 
+insertLww :: MonadIO m => LWWRefKey HBS2Basic -> Word64 -> RefLogId -> DBPipeM m ()
+insertLww lww snum reflog = do
+  insert [qc|
+INSERT INTO lww (hash, seq, reflog) VALUES (?, ?, ?)
+ON CONFLICT (hash,seq,reflog) DO NOTHING
+  |] (Base58Field lww, snum, Base58Field reflog)
+
+selectAllLww :: MonadIO m => DBPipeM m [(LWWRefKey HBS2Basic, Word64, RefLogId)]
+selectAllLww = do
+  select_  [qc|
+SELECT hash, seq, reflog FROM lww
+  |] <&> fmap (over _3 (fromRefLogKey @HBS2Basic))
+

hbs21-git/hbs2-git-client-lib/HBS2/Git/Data/LWWBlock.hs

@@ -65,6 +65,7 @@ data LWWBlockOpError =
 
 instance Exception LWWBlockOpError
 
+{- HLINT ignore "Functor law" -}
 
 readLWWBlock :: forall e s m . ( MonadIO m
                                , Signatures s
@@ -75,11 +76,11 @@ readLWWBlock :: forall e s m . ( MonadIO m
                                )
              => AnyStorage
              -> LWWRefKey s
-             -> m (Maybe (LWWBlockData e))
+             -> m (Maybe (LWWRef e, LWWBlockData e))
 
 readLWWBlock sto k = runMaybeT do
 
-  LWWRef{..} <- runExceptT (readLWWRef @e sto k)
+  w@LWWRef{..} <- runExceptT (readLWWRef @e sto k)
                   >>= toMPlus
                   >>= toMPlus
 
@@ -88,6 +89,7 @@ readLWWBlock sto k = runMaybeT do
     <&> deserialiseOrFail @(LWWBlock e)
     >>= toMPlus
     <&> lwwBlockData
+    <&> (w,)
 
 initLWWRef :: forall e s m . ( MonadIO m
                              , MonadError LWWBlockOpError m