set policy for mailbox

.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))
     )
 )

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)
 

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 =>
 
 
 
-
-
-

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
+

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
 
 

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
 

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
+  , mbsMailboxPolicy        :: Maybe (SignedBox (SetPolicyPayload s) s)
-  , mbsMailboxPolicyHash    :: Maybe HashRef
-  }
-  deriving stock (Generic)
-
-data SetPolicyPayload s =
-  SetPolicyPayload
-  { sppMailboxKey    :: MailboxKey s
-  , sppPolicyVersion :: PolicyVersion
-  , sppPolicyRef     :: HashRef
   }
   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 "set-policy-payload-hash" (HashRef . hashObject . serialise <$> mbsMailboxPolicy)
-                  , element "policy-tree"    mbsMailboxPolicyHash
+                  , 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
+  sto  <- mailboxGetStorage @s adapter
-  now <- liftIO $ getPOSIXTime <&> round
+  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
+    MailboxStatus box -> deferred @p do
-      -- TODO: implement-MailboxStatus
+
-      --
+      flip runContT pure $ callCC \exit -> do
-      --  [ ]  if-do-gossip-setting-then
+
-      --  [ ]     gossip-MailboxStatus
+        let r = unboxSignedBox0 @(MailBoxStatusPayload s) box
-      --
+
-      --  [ ]  check-signed-box-or-drop
+        PeerData{..} <- ContT $ maybe1 se none
-      --  [ ]  if-client-has-mailbox-then
+
-      --  [ ]     get-mailbox-status
+        (who, content@MailBoxStatusPayload{..}) <- ContT $ maybe1 r none
-      --  [ ]     answer-MailboxStatus
+
-      --
+        unless ( who == _peerSignKey ) $ exit ()
-      none
+
+        -- 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

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

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))