mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
a17bdba8ce
commit
bf8ade46aa
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue