From bf8ade46aae454669314ec1ad136e6937e7fd748 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Mon, 29 Jul 2024 09:29:31 +0300 Subject: [PATCH] wip --- hbs2-cli/lib/HBS2/CLI/Run/Internal.hs | 9 +++++-- hbs2-cli/lib/HBS2/CLI/Run/Peer.hs | 37 +++++++++++++++++++++++++++ hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs | 2 ++ 3 files changed, 46 insertions(+), 2 deletions(-) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs index 8d972f89..888f3ed6 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs @@ -464,11 +464,15 @@ internalEntries = do entry $ bindMatch "map" $ \syn -> do case syn of - [ListVal (SymbolVal "lambda" : SymbolVal fn : _), ListVal rs] -> do + [ListVal (SymbolVal "builtin:lambda" : SymbolVal fn : _), ListVal rs] -> do mapM (apply @c fn . List.singleton) rs <&> mkList - w -> do + [Lambda decl body, ListVal args] -> do + mapM (applyLambda decl body . List.singleton) args + <&> mkList + + _ -> do throwIO (BadFormException @C nil) entry $ bindMatch "head" $ \case @@ -532,6 +536,7 @@ internalEntries = do _ -> throwIO (BadFormException @c nil) + entry $ bindValue "space" $ mkStr " " entry $ bindMatch "sym" $ \case [StringLike s] -> pure (mkSym s) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs index f23d11ac..7bac7aee 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs @@ -4,11 +4,13 @@ import HBS2.CLI.Prelude import HBS2.CLI.Run.Internal import HBS2.Hash +import HBS2.Base58 import HBS2.Data.Types.Refs import HBS2.Storage import HBS2.Peer.CLI.Detect import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.API.Peer +import HBS2.Peer.RPC.API.RefLog import HBS2.Net.Auth.Schema() import Data.List qualified as L @@ -16,6 +18,7 @@ import Data.Maybe import Control.Monad.Trans.Cont import Data.Text qualified as Text import Data.ByteString.Lazy.Char8 qualified as LBS8 +import Lens.Micro.Platform {- HLINT ignore "Functor law" -} @@ -98,4 +101,38 @@ peerEntries = do readTVarIO r + entry $ bindMatch "hbs2:peer:reflog:get" $ \case + [StringLike puk] -> do + flip runContT pure do + reflog <- orThrowUser "bad reflog key" (fromStringMay puk) + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @RefLogAPI @UNIX so + what <- callService @RpcRefLogGet api reflog + >>= orThrowUser "can't get reflog" + pure $ mkStr (show $ pretty what) + + _ -> throwIO (BadFormException @C nil) + + + entry $ bindMatch "hbs2:peer:reflog:fetch" $ \case + [StringLike puk] -> do + flip runContT pure do + reflog <- orThrowUser "bad reflog key" (fromStringMay puk) + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @RefLogAPI @UNIX so + void $ callService @RpcRefLogFetch api reflog + pure $ mkStr "okay" + + _ -> throwIO (BadFormException @C nil) + + entry $ bindMatch "hbs2:peer:reflog:list" $ \case + [] -> do + flip runContT pure do + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @PeerAPI @UNIX so + r <- callService @RpcPollList2 api (Just "reflog", Nothing) + >>= orThrowUser "can't get reflog list" + pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r + + _ -> throwIO (BadFormException @C nil) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs index d5ac4a8a..b5468340 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs @@ -61,6 +61,8 @@ reflogEntries = do _ -> throwIO (BadFormException @C nil) + + entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case [StringLike puk, StringLike hash] -> do flip runContT pure do