diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs index 39b91b32..6788a16d 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs @@ -5,6 +5,7 @@ import HBS2.CLI.Prelude import HBS2.OrDie import HBS2.Base58 +import HBS2.Data.Types.Refs import HBS2.Storage import HBS2.Peer.CLI.Detect 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 e <- (stringLikeList -> e) + pattern BlobLike :: forall {c} . ByteString -> Syntax c pattern BlobLike s <- (blobLike -> Just s) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs b/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs index 58e18674..5dd82d43 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs @@ -32,6 +32,12 @@ import Data.Text.Encoding qualified as TE import Data.Text qualified as Text 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 = do @@ -85,3 +91,44 @@ lwwRefEntries = do _ -> 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 + +