mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
7f13629498
commit
981a2d7272
|
@ -480,6 +480,15 @@ internalEntries = do
|
||||||
_ -> do
|
_ -> do
|
||||||
throwIO (BadFormException @C nil)
|
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
|
entry $ bindMatch "map" $ \syn -> do
|
||||||
case syn of
|
case syn of
|
||||||
|
|
|
@ -48,62 +48,40 @@ lwwRefEntries = do
|
||||||
|
|
||||||
_ -> throwIO (BadFormException @C nil)
|
_ -> 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
|
_ -> throwIO (BadFormException @C nil)
|
||||||
-- [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)
|
|
||||||
|
|
||||||
|
|
||||||
-- entry $ bindMatch "hbs2:reflog:tx:post" $ nil_ \case
|
entry $ bindMatch "hbs2:lwwref:fetch" $ \case
|
||||||
-- [BlobLike blob] -> do
|
[StringLike puk] -> do
|
||||||
-- so <- detectRPC `orDie` "no rpc found"
|
flip runContT pure do
|
||||||
-- withRPC2 @RefLogAPI so $ \caller -> do
|
lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
|
||||||
-- wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob)
|
so <- detectRPC `orDie` "rpc not found"
|
||||||
-- & orThrowUser "invalid tx"
|
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
|
||||||
-- void $ callService @RpcRefLogPost caller wtf
|
void $ callService @RpcLWWRefFetch api lww
|
||||||
|
pure $ mkStr "okay"
|
||||||
|
|
||||||
-- _ -> throwIO (BadFormException @C nil)
|
_ -> 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)
|
|
||||||
|
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
|
|
@ -99,77 +99,5 @@ 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)
|
|
||||||
|
|
||||||
|
|
||||||
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)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -61,8 +61,6 @@ 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
|
||||||
|
@ -120,3 +118,39 @@ reflogEntries = do
|
||||||
_ -> throwIO (BadFormException @C nil)
|
_ -> 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)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue