wip, dissecting tx

hbs2-cli/lib/Data/Config/Suckless/Script/Internal.hs

@@ -480,6 +480,19 @@ applyLambda decl body args = do
   atomically $ writeTVar tv d0
   pure e
 
+apply_ :: forall c m . ( IsContext c
+                      , MonadUnliftIO m
+                      , Exception (BadFormException c)
+                      )
+      => Syntax c
+      -> [Syntax c]
+      -> RunM c m (Syntax c)
+
+apply_ s args = case s of
+  ListVal [SymbolVal "builtin:lambda", SymbolVal n]  -> apply n args
+  SymbolVal   what  -> apply what args
+  Lambda d body     -> applyLambda d body args
+  e -> throwIO $ BadFormException @c s
 
 apply :: forall c m . ( IsContext c
                       , MonadUnliftIO m
@@ -562,6 +575,10 @@ eval syn = handle (handleForm syn) $ do
       ListVal (SymbolVal "begin" : what) -> do
         evalTop what
 
+      e@(ListVal (SymbolVal "blob" : what)) -> do
+        pure e
+        -- evalTop what
+
       lc@(ListVal (Lambda decl body : args))  -> do
         applyLambda decl body args
 

hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs

@@ -5,6 +5,7 @@ import HBS2.CLI.Run.Internal
 import HBS2.CLI.Run.Internal.KeyMan
 
 import HBS2.Data.Types.Refs
+import HBS2.Merkle
 import HBS2.Storage
 import HBS2.Peer.CLI.Detect
 import HBS2.Peer.RPC.Client.Unix
@@ -31,6 +32,8 @@ import Data.Text.Encoding qualified as TE
 import Data.Text qualified as Text
 import Control.Monad.Trans.Cont
 
+import Streaming.Prelude qualified as S
+
 getCredentialsForReflog :: MonadUnliftIO m => RefLogKey 'HBS2Basic -> m (PeerCredentials 'HBS2Basic)
 getCredentialsForReflog reflog = do
   runKeymanClient (loadCredentials reflog)
@@ -166,5 +169,54 @@ reflogEntries = do
     _ -> throwIO (BadFormException @C nil)
 
 
+  entry $ bindMatch "hbs2:reflog:tx:seqref:decode" $ \case
+    [ListVal [SymbolVal "blob", LitStrVal s]] -> do
+      let lbs =  Text.unpack s & BS8.pack & LBS.fromStrict
+
+      SequentialRef n (AnnotatedHashRef _ h) <-  deserialiseOrFail @SequentialRef lbs
+                                                   & orThrowUser "FUCKED"
+
+      pure $ mkForm "seqref" [mkInt n, mkStr (show $ pretty h)]
+
+    e -> throwIO $ BadFormException @c nil
+
+  entry $ bindMatch "hbs2:reflog:tx:list" $ \case
+     [e, SignPubKeyLike puk] -> do
+
+      flip runContT pure do
+
+        callCC \exit -> do
+
+          so <- detectRPC `orDie` "rpc not found"
+          api <- ContT $ withRPC2 @RefLogAPI  @UNIX so
+          sto <- ContT withPeerStorage
+
+          r <- callService @RpcRefLogGet api puk
+                 >>= orThrowUser "can't get reflog value"
+
+          rlh <- ContT $ maybe1 r (pure nil)
+
+          hashes <- S.toList_ do
+                      walkMerkle @[HashRef] (fromHashRef rlh) (getBlock sto) $ \case
+                        (Left _) -> lift $ exit nil
+                        (Right (hs :: [HashRef]))  -> S.each hs
+
+          rr <- forM hashes $ \ha -> do
+
+            tx <- getBlock sto (coerce ha)
+                     >>= orThrowUser "missed-block"
+                     <&> deserialiseOrFail @(RefLogUpdate L4Proto)
+                     >>= orThrowUser "invalid-tx"
+
+            let bs = view refLogUpdData tx
+            let bs8 = BS8.unpack bs
+
+            lift $ apply_ e [mkForm "blob" [mkStr bs8]]
+
+          pure $ mkList rr
+
+     _ -> throwIO (BadFormException @C nil)
+
+
 
 

hbs2-peer/lib/HBS2/Peer/Proto/RefLog.hs

@@ -157,6 +157,8 @@ verifyRefLogUpdate msg = do
   let sign = view refLogUpdSign msg
   pure $ verifySign @s pubk sign noncebs
 
+-- unpackRef
+
 data RefLogRequestI e m =
   RefLogRequestI
   { onRefLogRequest :: (Peer e, PubKey 'Sign (Encryption e)) -> m (Maybe (Hash HbSync))