From d3d295d599628de98c94a7b5c715f7e070b6ac6e Mon Sep 17 00:00:00 2001 From: voidlizard Date: Sat, 12 Oct 2024 11:10:48 +0300 Subject: [PATCH] set policy for mailbox --- .fixme-new/config | 2 +- hbs2-core/lib/HBS2/Net/Proto.hs | 4 - hbs2-core/lib/HBS2/Prelude.hs | 6 +- hbs2-peer/app/CLI/Mailbox.hs | 66 +++++++++ hbs2-peer/app/MailboxProtoWorker.hs | 107 +++++++++++++- hbs2-peer/app/RPC2/Mailbox.hs | 6 + hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs | 130 ++++++++++++------ .../lib/HBS2/Peer/Proto/Mailbox/Types.hs | 4 +- hbs2-peer/lib/HBS2/Peer/RPC/API/Mailbox.hs | 6 +- 9 files changed, 275 insertions(+), 56 deletions(-) diff --git a/.fixme-new/config b/.fixme-new/config index 883e8505..0c993698 100644 --- a/.fixme-new/config +++ b/.fixme-new/config @@ -50,7 +50,7 @@ fixme-comments ";" "--" (align 8 $class) " " (align 12 $assigned) " " (align 20 (trim 20 $committer-name)) " " - (trim 50 ($fixme-title)) " " + (trim 40 ($fixme-title)) " " (nl)) ) ) diff --git a/hbs2-core/lib/HBS2/Net/Proto.hs b/hbs2-core/lib/HBS2/Net/Proto.hs index 4cee7cd3..66a6e463 100644 --- a/hbs2-core/lib/HBS2/Net/Proto.hs +++ b/hbs2-core/lib/HBS2/Net/Proto.hs @@ -6,9 +6,5 @@ module HBS2.Net.Proto import HBS2.Hash import HBS2.Net.Proto.Types - -dontHandle :: Applicative f => a -> f () -dontHandle = const $ pure () - type GetBlockSize h m = Hash h -> m (Maybe Integer) diff --git a/hbs2-core/lib/HBS2/Prelude.hs b/hbs2-core/lib/HBS2/Prelude.hs index e70a84bc..75fa8c4d 100644 --- a/hbs2-core/lib/HBS2/Prelude.hs +++ b/hbs2-core/lib/HBS2/Prelude.hs @@ -28,6 +28,7 @@ module HBS2.Prelude , HasErrorStatus(..), ErrorStatus(..), SomeError(..), WithSomeError(..), mayE, someE , ByFirst(..) , whenTrue, whenFalse + , dontHandle ) where import HBS2.Clock @@ -174,11 +175,10 @@ instance Eq a => Eq (ByFirst a b) where instance Hashable a => Hashable (ByFirst a b) where hashWithSalt s (ByFirst a _) = hashWithSalt s a +dontHandle :: Applicative f => a -> f () +dontHandle = const $ pure () -- asyncLinked :: forall m . MonadUnliftIO m => - - - diff --git a/hbs2-peer/app/CLI/Mailbox.hs b/hbs2-peer/app/CLI/Mailbox.hs index 8db84b5a..c74caa08 100644 --- a/hbs2-peer/app/CLI/Mailbox.hs +++ b/hbs2-peer/app/CLI/Mailbox.hs @@ -3,6 +3,7 @@ module CLI.Mailbox (pMailBox) where import HBS2.Prelude.Plated +import HBS2.Base58 import HBS2.Hash import HBS2.OrDie import HBS2.Merkle @@ -10,6 +11,7 @@ import HBS2.Data.Types.Refs import HBS2.Net.Proto.Service import HBS2.Net.Auth.Credentials import HBS2.Storage +import HBS2.Storage.Operations.ByteString import HBS2.Data.Types.SignedBox import HBS2.Peer.Proto.Mailbox import HBS2.Peer.Proto.Mailbox.Types @@ -28,6 +30,8 @@ import Codec.Serialise import Control.Monad.Trans.Cont import Control.Monad.Trans.Maybe import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Lazy.Char8 qualified as LBS8 +import Data.Either import Data.Coerce import Data.Config.Suckless.Script import Data.HashSet (HashSet) @@ -150,6 +154,59 @@ runMailboxCLI rpc s = do _ -> throwIO $ BadFormException @C nil + brief "set mailbox policy" $ + desc setPolicyDesc + -- $ examples setPolicyExamples + $ entry $ bindMatch "set-policy" $ nil_ $ \case + [ SignPubKeyLike m, LitIntVal v, StringLike fn ] -> lift do + + mstatus <- callRpcWaitMay @RpcMailboxGetStatus t api m + >>= orThrowUser "rpc call timeout" + >>= orThrowPassIO + + s <- liftIO $ readFile fn + <&> parseTop + >>= either (error . show) pure + + pv <- fromMaybe 0 <$> runMaybeT do + MailBoxStatusPayload{..} <- toMPlus mstatus + pbox <- toMPlus mbsMailboxPolicy + (who, SetPolicyPayload{..}) <- unboxSignedBox0 pbox & toMPlus + + guard ( m == who ) + + pure sppPolicyVersion + + -- TODO: validate-policy + + creds <- runKeymanClientRO (loadCredentials m) + >>= orThrowUser ("can't load credentials for" <+> pretty (AsBase58 m)) + + let normalized = show $ vcat (fmap pretty s) + + notice $ "policy" <> line <> pretty normalized + + notice $ "okay" <+> pretty pv <+> "->" <+> pretty v <+> pretty fn + + hash <- writeAsMerkle sto (LBS8.pack normalized) + + notice $ "stored policy as" <+> pretty hash + + let spp = SetPolicyPayload @HBS2Basic m (fromIntegral v) (HashRef hash) + + let box = makeSignedBox @HBS2Basic (view peerSignPk creds) (view peerSignSk creds) spp + + notice $ "signed policy payload done okay" + + r <- callRpcWaitMay @RpcMailboxSetPolicy t api (m,box) + >>= orThrowUser "rpc call timeout" + >>= orThrowPassIO + + liftIO $ print $ pretty r + + _ -> throwIO $ BadFormException @C nil + + brief "list mailboxes" $ entry $ bindMatch "list" $ nil_ $ const do @@ -283,3 +340,12 @@ SEE ALSO |] + +setPolicyDesc :: Doc a +setPolicyDesc = [qc| + set-policy (MAILBOX-KEY :: PUBKEY) (VERSION :: INT) FILENAME +|] + +setPolicyExamples :: ManExamples +setPolicyExamples = mempty + diff --git a/hbs2-peer/app/MailboxProtoWorker.hs b/hbs2-peer/app/MailboxProtoWorker.hs index 71425ae6..befea1b5 100644 --- a/hbs2-peer/app/MailboxProtoWorker.hs +++ b/hbs2-peer/app/MailboxProtoWorker.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# Language MultiWayIf #-} {-# Language AllowAmbiguousTypes #-} {-# Language UndecidableInstances #-} module MailboxProtoWorker ( mailboxProtoWorker @@ -20,6 +21,7 @@ import HBS2.Storage import HBS2.Storage.Operations.Missed import HBS2.Merkle import HBS2.Hash +import HBS2.Data.Types.SignedBox import HBS2.Peer.Proto import HBS2.Peer.Proto.Mailbox import HBS2.Peer.Proto.Mailbox.Entry @@ -35,22 +37,34 @@ import PeerConfig import PeerTypes import BlockDownload() -import DBPipe.SQLite +import DBPipe.SQLite as Q import Control.Concurrent.STM qualified as STM -- import Control.Concurrent.STM.TBQueue import Control.Monad.Trans.Cont import Control.Monad.Trans.Maybe +import Control.Monad.Trans.Except +import Control.Monad.Except (throwError) import Data.Coerce import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HM import Data.HashSet (HashSet) import Data.HashSet qualified as HS import Data.Maybe +import Codec.Serialise import Lens.Micro.Platform import Text.InterpolatedString.Perl6 (qc) import UnliftIO +newtype PolicyHash = PolicyHash HashRef + deriving newtype (Eq,Ord,Show,Hashable,Pretty) + +instance FromField PolicyHash where + fromField s = PolicyHash . fromString <$> fromField @String s + +instance ToField PolicyHash where + toField f = toField (show $ pretty f) + data MailboxProtoException = MailboxProtoWorkerTerminatedException | MailboxProtoCantAccessMailboxes FilePath @@ -116,9 +130,54 @@ instance ( s ~ Encryption e, e ~ L4Proto Right{} -> pure $ Right () Left{} -> pure $ Left (MailboxCreateFailed "database operation") + mailboxSetPolicy MailboxProtoWorker{..} sbox = do + -- check policy version + -- check policy has peers + -- write policy block + -- update reference to policy block + -- + -- test: write policy, check mailboxGetStatus + + debug $ red "mailboxSetPolicy" + + runExceptT do + + -- check policy signature + (who, spp) <- unboxSignedBox0 sbox + & orThrowError (MailboxAuthError "invalid signature") + + dbe <- readTVarIO mailboxDB + >>= orThrowError (MailboxSetPolicyFailed "database not ready") + + loaded <- loadPolicyPayloadFor dbe mpwStorage (MailboxRefKey @s who) + <&> fmap ( unboxSignedBox0 @(SetPolicyPayload s) @s . snd ) + <&> join + + what <- case loaded of + Nothing -> do + err $ red "mailboxSetPolicy FUCKED" + putBlock mpwStorage (serialise sbox) + >>= orThrowError (MailboxSetPolicyFailed "storage error") + <&> HashRef + + Just (k, spp0) | sppPolicyVersion spp > sppPolicyVersion spp0 || k /= who -> do + putBlock mpwStorage (serialise sbox) + >>= orThrowError (MailboxSetPolicyFailed "storage error") + <&> HashRef + + _ -> do + throwError (MailboxSetPolicyFailed "too old") + + liftIO $ withDB dbe $ Q.transactional do + insert [qc| insert into policy (mailbox,hash) values(?,?) + on conflict (mailbox) do update set hash = excluded.hash + |] (MailboxRefKey @s who, PolicyHash what) + + pure what + mailboxDelete MailboxProtoWorker{..} mbox = do - flip runContT pure $ callCC \exit -> do + flip runContT pure do mdbe <- readTVarIO mailboxDB @@ -163,6 +222,11 @@ instance ( s ~ Encryption e, e ~ L4Proto pure $ Right r + mailboxAcceptStatus MailboxProtoWorker{..} ref who MailBoxStatusPayload{..} = do + -- TODO: implement-policy-first + -- итак, мы не можем двигаться, пока не будет реализована policy. + pure $ Right () + mailboxGetStatus MailboxProtoWorker{..} ref = do -- TODO: support-policy-ASAP @@ -180,7 +244,30 @@ instance ( s ~ Encryption e, e ~ L4Proto v <- getRef mpwStorage ref <&> fmap HashRef - pure $ Right $ Just $ MailBoxStatusPayload @s now (coerce ref) t v mzero mzero + spp <- loadPolicyPayloadFor dbe mpwStorage ref + <&> fmap snd + + pure $ Right $ Just $ MailBoxStatusPayload @s now (coerce ref) t v spp + +loadPolicyPayloadFor :: forall s m . (ForMailbox s, MonadIO m) + => DBPipeEnv + -> AnyStorage + -> MailboxRefKey s + -> m (Maybe (HashRef, SignedBox (SetPolicyPayload s) s)) +loadPolicyPayloadFor dbe sto who = do + phash <- withDB dbe do + select @(Only PolicyHash) [qc|select hash from policy where mailbox = ?|] (Only who) + <&> fmap (coerce @_ @HashRef . fromOnly) + <&> headMay + + runMaybeT do + ha <- toMPlus phash + what <- getBlock sto (coerce ha) + >>= toMPlus + <&> deserialiseOrFail + >>= toMPlus + pure (ha, what) + getMailboxType_ :: (ForMailbox s, MonadIO m) => DBPipeEnv -> MailboxRefKey s -> m (Maybe MailboxType) getMailboxType_ d r = do @@ -316,7 +403,10 @@ mailboxProtoWorker readConf me@MailboxProtoWorker{..} = do -- NOTE: reliability -- в случае отказа сторейджа все эти сообщения будут потеряны -- однако, ввиду дублирования -- они рано или поздно будут - -- восстановлены с других реплик, если таковые имеются + -- восстановлены с других реплик, если таковые имеются. + -- + -- Кроме того, мы можем писать WAL. + -- newTx <- atomically do n <- readTVar inMessageMergeQueue <&> fromMaybe mempty . HM.lookup r @@ -363,7 +453,7 @@ mailboxStateEvolve readConf MailboxProtoWorker{..} = do atomically $ writeTVar mailboxDB (Just dbe) - withDB dbe do + withDB dbe $ Q.transactional do ddl [qc|create table if not exists mailbox ( recipient text not null , type text not null @@ -371,6 +461,13 @@ mailboxStateEvolve readConf MailboxProtoWorker{..} = do ) |] + ddl [qc|create table if not exists + policy ( mailbox text not null + , hash text not null + , primary key (mailbox) + ) + |] + pure dbe diff --git a/hbs2-peer/app/RPC2/Mailbox.hs b/hbs2-peer/app/RPC2/Mailbox.hs index 05dcb5cb..8c2b7311 100644 --- a/hbs2-peer/app/RPC2/Mailbox.hs +++ b/hbs2-peer/app/RPC2/Mailbox.hs @@ -47,6 +47,12 @@ instance (ForMailboxRPC m) => HandleMethod m RpcMailboxCreate where void $ mailboxCreate @HBS2Basic mbs t puk debug $ "rpc.RpcMailboxCreate" <+> pretty (AsBase58 puk) <+> pretty t +instance (ForMailboxRPC m) => HandleMethod m RpcMailboxSetPolicy where + + handleMethod (puk, sbox) = do + AnyMailboxService mbs <- getRpcContext @MailboxAPI @RPC2Context <&> rpcMailboxService + debug $ "rpc.RpcMailboxSetPolicy" <+> pretty (AsBase58 puk) + mailboxSetPolicy @HBS2Basic mbs sbox instance (ForMailboxRPC m) => HandleMethod m RpcMailboxGetStatus where diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs index af98506a..0204139b 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox.hs @@ -15,8 +15,12 @@ import HBS2.Data.Types.Refs import HBS2.Data.Types.SignedBox import HBS2.Storage import HBS2.Actors.Peer.Types +import HBS2.Data.Types.Peer import HBS2.Net.Auth.Credentials + +import HBS2.Net.Proto.Sessions +import HBS2.Peer.Proto.Peer import HBS2.Peer.Proto.Mailbox.Types import HBS2.Peer.Proto.Mailbox.Message import HBS2.Peer.Proto.Mailbox.Entry @@ -29,22 +33,21 @@ import Data.Maybe import Data.Word import Lens.Micro.Platform +data SetPolicyPayload s = + SetPolicyPayload + { sppMailboxKey :: MailboxKey s + , sppPolicyVersion :: PolicyVersion + , sppPolicyRef :: HashRef -- ^ merkle tree hash of policy description file + } + deriving stock (Generic) + data MailBoxStatusPayload s = MailBoxStatusPayload { mbsMailboxPayloadNonce :: Word64 , mbsMailboxKey :: MailboxKey s , mbsMailboxType :: MailboxType , mbsMailboxHash :: Maybe HashRef - , mbsMailboxPolicyVersion :: Maybe PolicyVersion - , mbsMailboxPolicyHash :: Maybe HashRef - } - deriving stock (Generic) - -data SetPolicyPayload s = - SetPolicyPayload - { sppMailboxKey :: MailboxKey s - , sppPolicyVersion :: PolicyVersion - , sppPolicyRef :: HashRef + , mbsMailboxPolicy :: Maybe (SignedBox (SetPolicyPayload s) s) } deriving stock (Generic) @@ -57,7 +60,7 @@ data DeleteMessagesPayload s = data MailBoxProtoMessage s e = SendMessage (Message s) -- already has signed box - | CheckMailbox (MailboxKey s) + | CheckMailbox (Maybe Word64) (MailboxKey s) | MailboxStatus (SignedBox (MailBoxStatusPayload s) s) -- signed by peer | SetPolicy (SignedBox (SetPolicyPayload s) s) | DeleteMessages (SignedBox (DeleteMessagesPayload s) s) @@ -94,6 +97,11 @@ class ForMailbox s => IsMailboxService s a where -> Recipient s -> m (Either MailboxServiceError ()) + mailboxSetPolicy :: forall m . MonadIO m + => a + -> SignedBox (SetPolicyPayload s) s + -> m (Either MailboxServiceError HashRef) + mailboxDelete :: forall m . MonadIO m => a -> Recipient s @@ -120,6 +128,12 @@ class ForMailbox s => IsMailboxService s a where -> MailboxRefKey s -> m (Either MailboxServiceError (Maybe (MailBoxStatusPayload s))) + mailboxAcceptStatus :: forall m . MonadIO m + => a + -> MailboxRefKey s + -> PubKey 'Sign s -- ^ peer's key + -> MailBoxStatusPayload s + -> m (Either MailboxServiceError ()) data AnyMailboxService s = forall a . (IsMailboxService s a) => AnyMailboxService { mailboxService :: a } @@ -129,11 +143,13 @@ data AnyMailboxAdapter s = instance ForMailbox s => IsMailboxService s (AnyMailboxService s) where mailboxCreate (AnyMailboxService a) = mailboxCreate @s a + mailboxSetPolicy (AnyMailboxService a) = mailboxSetPolicy @s a mailboxDelete (AnyMailboxService a) = mailboxDelete @s a mailboxSendMessage (AnyMailboxService a) = mailboxSendMessage @s a mailboxSendDelete (AnyMailboxService a) = mailboxSendDelete @s a mailboxListBasic (AnyMailboxService a) = mailboxListBasic @s a mailboxGetStatus (AnyMailboxService a) = mailboxGetStatus @s a + mailboxAcceptStatus (AnyMailboxService a) = mailboxAcceptStatus @s a instance IsMailboxProtoAdapter s (AnyMailboxAdapter s) where mailboxGetCredentials (AnyMailboxAdapter a) = mailboxGetCredentials @s a @@ -146,22 +162,35 @@ instance ForMailbox s => Pretty (MailBoxStatusPayload s) where where st = indent 2 $ brackets $ - vcat [ parens ("nonce" <+> pretty mbsMailboxPayloadNonce) + align $ vcat + [ parens ("nonce" <+> pretty mbsMailboxPayloadNonce) , parens ("key" <+> pretty (AsBase58 mbsMailboxKey)) , parens ("type" <+> pretty mbsMailboxType) , element "mailbox-tree" mbsMailboxHash - , element "policy-version" mbsMailboxPolicyVersion - , element "policy-tree" mbsMailboxPolicyHash + , element "set-policy-payload-hash" (HashRef . hashObject . serialise <$> mbsMailboxPolicy) + , maybe mempty pretty spp ] element el = maybe mempty ( \v -> parens (el <+> pretty v) ) + spp = mbsMailboxPolicy >>= unboxSignedBox0 <&> snd + + +instance ForMailbox s => Pretty (SetPolicyPayload s) where + pretty SetPolicyPayload{..} = parens ( "set-policy-payload" <> line <> indent 2 (brackets w) ) + where + w = align $ + vcat [ parens ( "version" <+> pretty sppPolicyVersion ) + , parens ( "ref" <+> pretty sppPolicyRef ) + ] + mailboxProto :: forall e s m p a . ( MonadIO m , Response e p m , HasDeferred p e m , HasGossip e p m , IsMailboxProtoAdapter s a , IsMailboxService s a + , Sessions e (KnownPeer e) m , p ~ MailBoxProto s e , s ~ Encryption e , ForMailbox s @@ -174,23 +203,13 @@ mailboxProto :: forall e s m p a . ( MonadIO m mailboxProto inner adapter mess = deferred @p do -- common stuff - sto <- mailboxGetStorage @s adapter - now <- liftIO $ getPOSIXTime <&> round + sto <- mailboxGetStorage @s adapter + now <- liftIO $ getPOSIXTime <&> round + that <- thatPeer @p + se <- find (KnownPeerKey that) id case mailBoxProtoPayload mess of SendMessage msg -> deferred @p do - -- TODO: implement-SendMessage - -- [ ] check-if-mailbox-exists - -- [ ] check-message-signature - -- [ ] if-already-processed-then-skip - -- [ ] store-message-hash-block-with-ttl - -- [ ] if-message-to-this-mailbox-then store-message - -- [ ] gossip-message - - -- проверяем, что еще не обрабатывали? - -- если обрабатывали -- то дропаем - -- что мы пишем в сторейдж? - -- кто потом это дропает? flip runContT pure $ callCC \exit -> do @@ -249,7 +268,7 @@ mailboxProto inner adapter mess = deferred @p do -- и так и известен в протоколе) -- - CheckMailbox k -> deferred @p do + CheckMailbox _ k -> deferred @p do creds <- mailboxGetCredentials @s adapter void $ runMaybeT do @@ -264,18 +283,47 @@ mailboxProto inner adapter mess = deferred @p do lift $ response @_ @p (MailBoxProtoV1 (MailboxStatus box)) - MailboxStatus{} -> do - -- TODO: implement-MailboxStatus - -- - -- [ ] if-do-gossip-setting-then - -- [ ] gossip-MailboxStatus - -- - -- [ ] check-signed-box-or-drop - -- [ ] if-client-has-mailbox-then - -- [ ] get-mailbox-status - -- [ ] answer-MailboxStatus - -- - none + MailboxStatus box -> deferred @p do + + flip runContT pure $ callCC \exit -> do + + let r = unboxSignedBox0 @(MailBoxStatusPayload s) box + + PeerData{..} <- ContT $ maybe1 se none + + (who, content@MailBoxStatusPayload{..}) <- ContT $ maybe1 r none + + unless ( who == _peerSignKey ) $ exit () + + -- FIXME: timeout-hardcode + -- может быть вообще не очень хорошо + -- авторизовываться по времени. + -- возможно, надо слать нонс в CheckMailbox + -- и тут его проверять + unless ( abs (now - mbsMailboxPayloadNonce) < 3 ) $ exit () + + -- NOTE: possible-poisoning-attack + -- левый пир генерирует merkle tree сообщений и посылает его. + -- чего он может добиться: добавить "валидных" сообщений, которых не было + -- в ящике изначально. (зашифрованных, подписанных). + -- + -- можно рассылать спам, ведь каждое спам-сообщение + -- будет валидно. + -- мы не можем подписывать что-либо подписью владельца ящика, + -- ведь мы не владеем его ключом. + -- + -- как бороться: в policy ограничивать число пиров, которые + -- могут отдавать статус и игнорировать статусы от прочих пиров. + -- + -- другой вариант -- каким-то образом публикуется подтверждение + -- от автора, что пир X владеет почтовым ящиком R. + -- + -- собственно, это и есть policy. + -- + -- а вот policy мы как раз можем публиковать с подписью автора, + -- он участвует в процессе обновления policy. + + void $ mailboxAcceptStatus adapter (MailboxRefKey mbsMailboxKey) who content SetPolicy{} -> do none diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Types.hs b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Types.hs index aeff2c2b..fb628d70 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Types.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/Mailbox/Types.hs @@ -30,7 +30,9 @@ import Data.Maybe import Control.Exception data MailboxServiceError = - MailboxCreateFailed String + MailboxCreateFailed String + | MailboxSetPolicyFailed String + | MailboxAuthError String deriving stock (Typeable,Show,Generic) instance Serialise MailboxServiceError diff --git a/hbs2-peer/lib/HBS2/Peer/RPC/API/Mailbox.hs b/hbs2-peer/lib/HBS2/Peer/RPC/API/Mailbox.hs index 6a7495e7..90cdaed3 100644 --- a/hbs2-peer/lib/HBS2/Peer/RPC/API/Mailbox.hs +++ b/hbs2-peer/lib/HBS2/Peer/RPC/API/Mailbox.hs @@ -16,6 +16,7 @@ import Codec.Serialise data RpcMailboxPoke data RpcMailboxCreate +data RpcMailboxSetPolicy data RpcMailboxDelete data RpcMailboxGetStatus data RpcMailboxList @@ -24,6 +25,7 @@ data RpcMailboxGet type MailboxAPI = '[ RpcMailboxPoke , RpcMailboxCreate + , RpcMailboxSetPolicy , RpcMailboxDelete , RpcMailboxGetStatus , RpcMailboxList @@ -46,10 +48,12 @@ type instance Output RpcMailboxPoke = () type instance Input RpcMailboxCreate = (PubKey 'Sign HBS2Basic, MailboxType) type instance Output RpcMailboxCreate = () +type instance Input RpcMailboxSetPolicy = (PubKey 'Sign HBS2Basic, SignedBox (SetPolicyPayload HBS2Basic) HBS2Basic) +type instance Output RpcMailboxSetPolicy = Either MailboxServiceError HashRef + type instance Input RpcMailboxDelete = (PubKey 'Sign HBS2Basic) type instance Output RpcMailboxDelete = () - type instance Input RpcMailboxGetStatus = (PubKey 'Sign HBS2Basic) type instance Output RpcMailboxGetStatus = Either MailboxServiceError (Maybe (MailBoxStatusPayload 'HBS2Basic))