This commit is contained in:
Dmitry Zuikov 2024-07-29 09:29:31 +03:00
parent a17bdba8ce
commit bf8ade46aa
3 changed files with 46 additions and 2 deletions

View File

@ -464,11 +464,15 @@ internalEntries = do
entry $ bindMatch "map" $ \syn -> do entry $ bindMatch "map" $ \syn -> do
case syn of 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 mapM (apply @c fn . List.singleton) rs
<&> mkList <&> mkList
w -> do [Lambda decl body, ListVal args] -> do
mapM (applyLambda decl body . List.singleton) args
<&> mkList
_ -> do
throwIO (BadFormException @C nil) throwIO (BadFormException @C nil)
entry $ bindMatch "head" $ \case entry $ bindMatch "head" $ \case
@ -532,6 +536,7 @@ internalEntries = do
_ -> throwIO (BadFormException @c nil) _ -> throwIO (BadFormException @c nil)
entry $ bindValue "space" $ mkStr " "
entry $ bindMatch "sym" $ \case entry $ bindMatch "sym" $ \case
[StringLike s] -> pure (mkSym s) [StringLike s] -> pure (mkSym s)

View File

@ -4,11 +4,13 @@ import HBS2.CLI.Prelude
import HBS2.CLI.Run.Internal import HBS2.CLI.Run.Internal
import HBS2.Hash import HBS2.Hash
import HBS2.Base58
import HBS2.Data.Types.Refs import HBS2.Data.Types.Refs
import HBS2.Storage import HBS2.Storage
import HBS2.Peer.CLI.Detect import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.API.Peer import HBS2.Peer.RPC.API.Peer
import HBS2.Peer.RPC.API.RefLog
import HBS2.Net.Auth.Schema() import HBS2.Net.Auth.Schema()
import Data.List qualified as L import Data.List qualified as L
@ -16,6 +18,7 @@ import Data.Maybe
import Control.Monad.Trans.Cont import Control.Monad.Trans.Cont
import Data.Text qualified as Text import Data.Text qualified as Text
import Data.ByteString.Lazy.Char8 qualified as LBS8 import Data.ByteString.Lazy.Char8 qualified as LBS8
import Lens.Micro.Platform
{- HLINT ignore "Functor law" -} {- HLINT ignore "Functor law" -}
@ -98,4 +101,38 @@ peerEntries = do
readTVarIO r 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)

View File

@ -61,6 +61,8 @@ reflogEntries = do
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case
[StringLike puk, StringLike hash] -> do [StringLike puk, StringLike hash] -> do
flip runContT pure do flip runContT pure do