diff --git a/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs b/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs index bb2d7b23..fdc428d4 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs @@ -5,13 +5,27 @@ import HBS2.CLI.Run.Internal import HBS2.CLI.Run.Internal.KeyMan import HBS2.Data.Types.Refs -import HBS2.Storage import HBS2.Peer.CLI.Detect import HBS2.Peer.RPC.Client.Unix import HBS2.Peer.RPC.API.Peer import HBS2.Peer.RPC.API.RefChan -import HBS2.Peer.Proto.LWWRef +import HBS2.Storage.Operations.ByteString + +-- import HBS2.Net.Proto +-- import HBS2.Net.Auth.Credentials +-- import HBS2.Base58 +-- import HBS2.Defaults +-- import HBS2.Events +-- import HBS2.Peer.Proto.Peer +-- import HBS2.Net.Proto.Sessions +-- import HBS2.Data.Types.Refs +-- import HBS2.Data.Types.SignedBox +-- import HBS2.Storage + + +import HBS2.Peer.Proto.RefChan +import Data.Either import HBS2.Base58 import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Schema() @@ -20,7 +34,11 @@ import HBS2.Data.Types.SignedBox import HBS2.KeyMan.Keys.Direct import HBS2.KeyMan.App.Types +import Data.HashMap.Strict qualified as HM +import Data.HashSet qualified as HS +import Data.Coerce import Control.Monad.Trans.Cont +import Control.Monad.Except import Text.InterpolatedString.Perl6 (qc) @@ -46,6 +64,149 @@ refchanEntries = do >>= orThrowUser "can't get refchan list" pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r + _ -> throwIO (BadFormException @c nil) + + + brief "reads refchan head block" + $ args [arg "symbol" "parsed|_", arg "string" "PUBKEY"] + $ returns "" "string" + $ examples [qc| + +(hbs2:refchan:head:get :parsed ExTZuEy2qVBRshWdSwfxeKcMmQLbK2f5NxRwhvXda9qd) +(version 2) +(quorum 1) +(wait 10) +(peer "5tZfGUoQ79EzFUvyyY5Wh1LzN2oaqhrn9kPnfk6ByHpf" 1) +(peer "35gKUG1mwBTr3tQpjWwR2kBYEnDmHxesoJL5Lj7tMjq3" 1) +(peer "5GnroAC8FXNRL8rcgJj6RTu9mt1AbuNd5MZVnDBcCKzb" 1) +(author "Gu5FxngYYwpRfCUS9DJBGyH3tvtjXFbcZ7CbxmJPWEGH") +(author "ExTZuEy2qVBRshWdSwfxeKcMmQLbK2f5NxRwhvXda9qd") +(reader "5UXrEhYECJ2kEQZZPEf4TisfWsLNdh2nGYQQz8X9ioMv") +(reader "CcRDzezX1XQdPxRMuMKzJkfHFB4yG7vGJeTYvScKkbP8") +; (head-extensions: (count: 0) (size 0)) + + +(hbs2:refchan:head:get :whatever ExTZuEy2qVBRshWdSwfxeKcMmQLbK2f5NxRwhvXda9qd) +HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr + + |] + $ entry $ bindMatch "hbs2:refchan:head:get" $ \case + [StringLike what, SignPubKeyLike puk] -> do + + flip runContT pure do + + callCC $ \exit -> do + + so <- detectRPC `orDie` "rpc not found" + api <- ContT $ withRPC2 @RefChanAPI @UNIX so + sto <- ContT $ withPeerStorage + + w <- callService @RpcRefChanHeadGet api puk + >>= orThrowUser "can't get refchan head" + + hx <- ContT $ maybe1 w (pure nil) + + case what of + "parsed" -> do + + lbs <- runExceptT (readFromMerkle sto (SimpleKey (coerce hx))) + >>= orThrowUser "can't decode refchan head " + + (_, hdblk) <- unboxSignedBox @(RefChanHeadBlock L4Proto) @'HBS2Basic lbs + & orThrowUser "can't unbox signed box" + + exit $ mkStr (show $ pretty hdblk) + + _ -> exit $ mkStr (show $ pretty $ AsBase58 hx) + + pure nil + + + _ -> throwIO (BadFormException @c nil) + + brief "prints refchan head example" + $ returns "nil" mempty + $ entry $ bindMatch "hbs2:refchan:head:example" $ nil_ $ \case + [] -> flip runContT pure do + + let rch0 = refChanHeadDefault @L4Proto + + so <- detectRPC + >>= orThrowUser "hbs2-peer not found" + + api <- ContT $ withRPC2 @PeerAPI @UNIX so + + pips <- callService @RpcPeers api () + <&> either (const mempty) (HM.fromList . fmap ((,1) . fst) . take 3) + + + creds <- replicateM 3 (newCredentialsEnc @HBS2Basic 1) + + let authors = fmap (view peerSignPk) creds + & HS.fromList + + let readers = foldMap (view peerKeyring) creds + & fmap (view krPk) + & take 3 + & HS.fromList + + let rch = ( set refChanHeadPeers pips + . set refChanHeadAuthors authors + . set refChanHeadReaders readers + . set refChanHeadNotifiers authors + ) rch0 + + liftIO $ print $ + ";" <+> "this is an example of refchan head block config" + <> line + <> ";" <+> "edit it before applying" <> line + <> ";" <+> "set up the actual keys / credentials you need" <> line + <> line <> line + <> ";" <+> "(version INT) is the head block version" <> line + <> ";" <+> "the refchan head block will be set only" <>line + <> ";" <+> "if it's version if greater than the already existed one" <> line + <> line + + <> ";" <+> "(quorum INT) is a number of accept messages issued by peers" <> line + <> ";" <+> "to include propose message to the refchan" <> line + <> line + + <> ";" <+> "(wait INT) is an quorum wait time in seconds" <> line + <> line + + <> ";" <+> "(peer PUBKEY WEIGHT) sets the peer allowed for posting propose/accept messages" <> line + <> ";" <+> "PUBKEY is a SIGNATURE public key as base58 string" <> line + <> ";" <+> "only messages from that peers will be accepted" <> line + <> ";" <+> "WEIGHT is not used yet but reserved for the future" <> line + <> ";" <+> "this parameter is optional but there is should be some peers or" <> line + <> ";" <+> "all messages will be sent to nowhere" <> line + <> line + + <> ";" <+> "(author PUBKEY) adds 'author' i.e. key that is allowed to sign the propose message" <> line + <> ";" <+> "PUBKEY is a SIGNATURE public key as base58 string" <> line + <> ";" <+> "only the propose messages signed by one of thise keys will be accepted" <> line + <> line + + <> ";" <+> "(notifier PUBKEY) adds 'notifier' i.e. key that is allowed to sign the notify message" <> line + <> ";" <+> "PUBKEY is a SIGNATURE public key as base58 string" <> line + <> ";" <+> "only the propose messages signed by one of thise keys will be accepted" <> line + <> ";" <+> "notify messages are not written to the refchan merkle tree" <> line + <> ";" <+> "and they useful for implementing any sort of ephemeral messaging" <> line + <> ";" <+> "those clauses are OPTIONAL and may be omitted" <> line + <> line + + <> ";" <+> "(reader PUBKEY) adds 'author' i.e. key that is allowed to decrypt messages" <> line + <> ";" <+> "PUBKEY is a ENCRYPTION public key as base58 string" <> line + <> ";" <+> "NOTE: messages in a refchan are not encrypted by default" <> line + <> ";" <+> " it's totally up to an application for this refchan" <> line + <> ";" <+> " therefore this clause is just used for setting reader keys to" <> line + <> ";" <+> " implement any ACL/encrypting mechanism" <> line + <> ";" <+> " i.e. groupkey may be inherited from the RefChanHead block" <> line + <> ";" <+> " to encrypt data posted to a refchan" <> line + <> ";" <+> "those clauses are OPTIONAL and may be omitted" <> line + <> line + + <> pretty rch + _ -> throwIO (BadFormException @C nil) - diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs index d994f5ba..42dbcaaa 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs @@ -175,6 +175,10 @@ refChanHeadReaders = lens g s s x _ = x +refChanHeadDefault :: ForRefChans e => RefChanHeadBlock e +refChanHeadDefault = + RefChanHeadBlock2 1 1 10 mempty mempty mempty mempty mempty + refChanHeadNotifiers :: ForRefChans e => Lens (RefChanHeadBlock e) (RefChanHeadBlock e)