diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs index d41f4519..39b91b32 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs @@ -480,6 +480,15 @@ internalEntries = do _ -> do throwIO (BadFormException @C nil) + entry $ bindMatch "repeat" $ nil_ $ \case + [LitIntVal n, Lambda [] b] -> do + replicateM_ (fromIntegral n) (applyLambda [] b []) + + [LitIntVal n, e@(ListVal _)] -> do + replicateM_ (fromIntegral n) (eval e) + + z -> + throwIO (BadFormException @C nil) entry $ bindMatch "map" $ \syn -> do case syn of diff --git a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs b/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs index 727254a0..58e18674 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs @@ -48,62 +48,40 @@ lwwRefEntries = do _ -> throwIO (BadFormException @C nil) + entry $ bindMatch "hbs2:lwwref:list" $ \case + [] -> do + flip runContT pure do + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @PeerAPI @UNIX so + r <- callService @RpcPollList2 api (Just "lwwref", Nothing) + >>= orThrowUser "can't get lwwref list" + pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r - -- entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case - -- [StringLike puk, StringLike hash] -> do - -- flip runContT pure do - -- reflog <- orThrowUser "bad reflog key" (fromStringMay puk) - -- sto <- ContT withPeerStorage - -- hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash) - -- void $ hasBlock sto (fromHashRef hashref) `orDie` "no block" - -- let sref = AnnotatedHashRef Nothing hashref - -- rlu <- lift $ mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise - -- pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)] - - -- _ -> throwIO (BadFormException @C nil) + _ -> throwIO (BadFormException @C nil) - -- entry $ bindMatch "hbs2:reflog:tx:post" $ nil_ \case - -- [BlobLike blob] -> do - -- so <- detectRPC `orDie` "no rpc found" - -- withRPC2 @RefLogAPI so $ \caller -> do - -- wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob) - -- & orThrowUser "invalid tx" - -- void $ callService @RpcRefLogPost caller wtf + entry $ bindMatch "hbs2:lwwref:fetch" $ \case + [StringLike puk] -> do + flip runContT pure do + lww <- orThrowUser "bad lwwref key" (fromStringMay puk) + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @LWWRefAPI @UNIX so + void $ callService @RpcLWWRefFetch api lww + pure $ mkStr "okay" - -- _ -> throwIO (BadFormException @C nil) - - -- entry $ bindMatch "hbs2:reflog:tx:seqref:create" $ \case - -- [StringLike puk, LitIntVal sn, StringLike hash] -> do - -- flip runContT pure do - -- reflog <- orThrowUser "bad reflog key" (fromStringMay puk) - -- sto <- ContT withPeerStorage - -- hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash) - -- void $ hasBlock sto (fromHashRef hashref) `orDie` "no block" - -- let sref = SequentialRef sn (AnnotatedHashRef Nothing hashref) - -- rlu <- lift $ mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise - -- pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)] - - -- _ -> throwIO (BadFormException @C nil) - - -- entry $ bindMatch "hbs2:reflog:tx:create-raw" $ \case - -- [SymbolVal "stdin", StringLike rlo] -> do - -- reflog <- orThrowUser "bad reflog" (fromStringMay rlo) - - -- rlu <- mkRefLogUpdateFrom reflog ( liftIO BS.getContents ) - -- <&> serialise - - -- pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)] - - -- [LitStrVal s, StringLike rlo] -> do - -- reflog <- orThrowUser "bad reflog" (fromStringMay rlo) - - -- rlu <- mkRefLogUpdateFrom reflog ( pure (BS8.pack (Text.unpack s)) ) - -- <&> serialise - - -- pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)] - - -- _ -> throwIO (BadFormException @C nil) + _ -> throwIO (BadFormException @C nil) + entry $ bindMatch "hbs2:lwwref:get" $ \case + [StringLike puk] -> do + + flip runContT pure do + ref <- orThrowUser "bad lwwref key" (fromStringMay puk) + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @LWWRefAPI @UNIX so + what <- callService @RpcLWWRefGet api ref + >>= orThrowUser "can't get reflog" + pure $ mkStr (show $ pretty what) + + _ -> throwIO (BadFormException @C nil) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs index b0938a67..e9f724b3 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs @@ -99,77 +99,5 @@ 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) - - - entry $ bindMatch "hbs2:peer:lwwref:list" $ \case - [] -> do - flip runContT pure do - so <- detectRPC `orDie` "rpc not found" - api <- ContT $ withRPC2 @PeerAPI @UNIX so - r <- callService @RpcPollList2 api (Just "lwwref", Nothing) - >>= orThrowUser "can't get lwwref list" - pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r - - _ -> throwIO (BadFormException @C nil) - - - entry $ bindMatch "hbs2:peer:lwwref:fetch" $ \case - [StringLike puk] -> do - flip runContT pure do - lww <- orThrowUser "bad reflog key" (fromStringMay puk) - so <- detectRPC `orDie` "rpc not found" - api <- ContT $ withRPC2 @LWWRefAPI @UNIX so - void $ callService @RpcLWWRefFetch api lww - pure $ mkStr "okay" - - _ -> throwIO (BadFormException @C nil) - - - entry $ bindMatch "hbs2:peer:lwwref:get" $ \case - [StringLike puk] -> do - - flip runContT pure do - ref <- orThrowUser "bad reflog key" (fromStringMay puk) - so <- detectRPC `orDie` "rpc not found" - api <- ContT $ withRPC2 @LWWRefAPI @UNIX so - what <- callService @RpcLWWRefGet api ref - >>= orThrowUser "can't get reflog" - pure $ mkStr (show $ pretty what) - - _ -> 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 b5468340..573b580b 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs @@ -61,8 +61,6 @@ reflogEntries = do _ -> throwIO (BadFormException @C nil) - - entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case [StringLike puk, StringLike hash] -> do flip runContT pure do @@ -120,3 +118,39 @@ reflogEntries = do _ -> throwIO (BadFormException @C nil) + entry $ bindMatch "hbs2: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: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: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) + +