This commit is contained in:
Dmitry Zuikov 2024-07-29 11:38:55 +03:00
parent 981a2d7272
commit 21724705eb
2 changed files with 49 additions and 0 deletions

View File

@ -5,6 +5,7 @@ import HBS2.CLI.Prelude
import HBS2.OrDie import HBS2.OrDie
import HBS2.Base58 import HBS2.Base58
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
@ -35,6 +36,7 @@ pattern StringLike e <- (stringLike -> Just e)
pattern StringLikeList :: forall {c} . [String] -> [Syntax c] pattern StringLikeList :: forall {c} . [String] -> [Syntax c]
pattern StringLikeList e <- (stringLikeList -> e) pattern StringLikeList e <- (stringLikeList -> e)
pattern BlobLike :: forall {c} . ByteString -> Syntax c pattern BlobLike :: forall {c} . ByteString -> Syntax c
pattern BlobLike s <- (blobLike -> Just s) pattern BlobLike s <- (blobLike -> Just s)

View File

@ -32,6 +32,12 @@ import Data.Text.Encoding qualified as TE
import Data.Text qualified as Text import Data.Text qualified as Text
import Control.Monad.Trans.Cont import Control.Monad.Trans.Cont
pattern HashLike:: forall {c} . HashRef -> Syntax c
pattern HashLike x <- (
\case
StringLike s -> fromStringMay @HashRef s
_ -> Nothing
-> Just x )
lwwRefEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m () lwwRefEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
lwwRefEntries = do lwwRefEntries = do
@ -85,3 +91,44 @@ lwwRefEntries = do
_ -> throwIO (BadFormException @C nil) _ -> throwIO (BadFormException @C nil)
entry $ bindMatch "hbs2:lwwref:update" $ \case
[StringLike puks, HashLike what] -> do
flip runContT pure do
puk <- orThrowUser "bad lwwref key" (fromStringMay @(PubKey 'Sign 'HBS2Basic) puks)
so <- detectRPC `orDie` "rpc not found"
api <- ContT $ withRPC2 @LWWRefAPI @UNIX so
(sk,pk) <- liftIO $ runKeymanClient do
creds <- loadCredentials puk
>>= orThrowUser "can't load credentials"
pure ( view peerSignSk creds, view peerSignPk creds )
error "YAY!"
-- what <- callService @RpcLWWRefGet api ref
-- >>= orThrowUser "can't get reflog"
-- pure $ mkStr (show $ pretty what)
_ -> throwIO (BadFormException @C nil)
-- (sk,pk) <- liftIO $ runKeymanClient do
-- creds <- loadCredentials puk >>= orThrowUser "can't load credentials"
-- pure ( view peerSignSk creds, view peerSignPk creds )
-- seq <- case seq' of
-- Just v -> pure v
-- Nothing -> do
-- let ref = LWWRefKey puk
-- callService @RpcLWWRefGet caller ref >>= \case
-- Left e -> err (viaShow e) >> exitFailure
-- Right Nothing -> err ("not found value for" <+> pretty ref) >> exitFailure
-- Right (Just r) -> pure $ succ (lwwSeq r)
-- let box = makeSignedBox pk sk (LWWRef seq val Nothing)
-- callService @RpcLWWRefUpdate caller box >>= \case
-- Left e -> err (viaShow e) >> exitFailure
-- Right r -> print $ pretty r