smp server: batch commands (#1559)

* protocol: refactor types and encoding

* clean

* smp server: batch commands (#1560)

* smp server: batch commands verification into one DB transaction

* ghc 8.10.7

* flatten transmission tuples

* diff

* only use batch logic if there is more than one transmission

* func

* reset NTF service when adding notifier

* version

* Revert "smp server: use separate database pool for reading queues and creating service records (#1561)"

This reverts commit 3df2425162.

* version

* Revert "version"

This reverts commit d80a6b74c5.

src/Simplex/Messaging/Protocol.hs

@@ -66,8 +66,9 @@ module Simplex.Messaging.Protocol
     EncDataBytes (..),
     Party (..),
     Cmd (..),
-    DirectParty,
-    SubscriberParty,
+    QueueParty,
+    BatchParty,
+    ServiceParty,
     ASubscriberParty (..),
     BrokerMsg (..),
     SParty (..),
@@ -80,12 +81,13 @@ module Simplex.Messaging.Protocol
     BrokerErrorType (..),
     BlockingInfo (..),
     BlockingReason (..),
+    RawTransmission,
     Transmission,
     TAuthorizations,
     TransmissionAuth (..),
     SignedTransmission,
+    SignedTransmissionOrError,
     SentRawTransmission,
-    SignedRawTransmission,
     ClientMsgEnvelope (..),
     PubHeader (..),
     ClientMessage (..),
@@ -153,8 +155,11 @@ module Simplex.Messaging.Protocol
     currentSMPClientVersion,
     senderCanSecure,
     queueReqMode,
-    subscriberParty,
-    subscriberServiceRole,
+    queueParty,
+    batchParty,
+    serviceParty,
+    partyClientRole,
+    partyServiceRole,
     userProtocol,
     rcvMessageMeta,
     noMsgFlags,
@@ -186,9 +191,11 @@ module Simplex.Messaging.Protocol
     TransportBatch (..),
     tPut,
     tPutLog,
-    tGet,
+    tGetServer,
+    tGetClient,
     tParse,
-    tDecodeParseValidate,
+    tDecodeServer,
+    tDecodeClient,
     tEncode,
     tEncodeBatch1,
     batchTransmissions,
@@ -208,7 +215,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as J
 import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Bifunctor (first)
+import Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -303,22 +310,40 @@ e2eEncMessageLength :: Int
 e2eEncMessageLength = 16000 -- 15988 .. 16005
 
 -- | SMP protocol clients
-data Party = Recipient | Sender | Notifier | LinkClient | ProxiedClient | ProxyService
+data Party
+  = Creator
+  | Recipient
+  | RecipientService
+  | Sender
+  | IdleClient
+  | Notifier
+  | NotifierService
+  | LinkClient
+  | ProxiedClient
+  | ProxyService
   deriving (Show)
 
 -- | Singleton types for SMP protocol clients
 data SParty :: Party -> Type where
+  SCreator :: SParty Creator
   SRecipient :: SParty Recipient
+  SRecipientService :: SParty RecipientService
   SSender :: SParty Sender
+  SIdleClient :: SParty IdleClient
   SNotifier :: SParty Notifier
+  SNotifierService :: SParty NotifierService
   SSenderLink :: SParty LinkClient
   SProxiedClient :: SParty ProxiedClient
   SProxyService :: SParty ProxyService
 
 instance TestEquality SParty where
+  testEquality SCreator SCreator = Just Refl
   testEquality SRecipient SRecipient = Just Refl
+  testEquality SRecipientService SRecipientService = Just Refl
   testEquality SSender SSender = Just Refl
+  testEquality SIdleClient SIdleClient = Just Refl
   testEquality SNotifier SNotifier = Just Refl
+  testEquality SNotifierService SNotifierService = Just Refl
   testEquality SSenderLink SSenderLink = Just Refl
   testEquality SProxiedClient SProxiedClient = Just Refl
   testEquality SProxyService SProxyService = Just Refl
@@ -328,34 +353,72 @@ deriving instance Show (SParty p)
 
 class PartyI (p :: Party) where sParty :: SParty p
 
+instance PartyI Creator where sParty = SCreator
+
 instance PartyI Recipient where sParty = SRecipient
 
+instance PartyI RecipientService where sParty = SRecipientService
+
 instance PartyI Sender where sParty = SSender
 
+instance PartyI IdleClient where sParty = SIdleClient
+
 instance PartyI Notifier where sParty = SNotifier
 
+instance PartyI NotifierService where sParty = SNotifierService
+
 instance PartyI LinkClient where sParty = SSenderLink
 
 instance PartyI ProxiedClient where sParty = SProxiedClient
 
 instance PartyI ProxyService where sParty = SProxyService
 
-type family DirectParty (p :: Party) :: Constraint where
-  DirectParty Recipient = ()
-  DirectParty Sender = ()
-  DirectParty Notifier = ()
-  DirectParty LinkClient = ()
-  DirectParty ProxyService = ()
-  DirectParty p =
-    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not direct"))
+-- command parties that can read queues
+type family QueueParty (p :: Party) :: Constraint where
+  QueueParty Recipient = ()
+  QueueParty Sender = ()
+  QueueParty Notifier = ()
+  QueueParty LinkClient = ()
+  QueueParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not QueueParty"))
 
-type family SubscriberParty (p :: Party) :: Constraint where
-  SubscriberParty Recipient = ()
-  SubscriberParty Notifier = ()
-  SubscriberParty p =
-    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not subscriber"))
+queueParty :: SParty p -> Maybe (Dict (PartyI p, QueueParty p))
+queueParty = \case
+  SRecipient -> Just Dict
+  SSender -> Just Dict
+  SSenderLink -> Just Dict
+  SNotifier -> Just Dict
+  _ -> Nothing
+{-# INLINE queueParty #-}
 
-data ASubscriberParty = forall p. (PartyI p, SubscriberParty p) => ASP (SParty p)
+type family BatchParty (p :: Party) :: Constraint where
+  BatchParty Recipient = ()
+  BatchParty Notifier = ()
+  BatchParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not BatchParty"))
+
+batchParty :: SParty p -> Maybe (Dict (PartyI p, BatchParty p))
+batchParty = \case
+  SRecipient -> Just Dict
+  SNotifier -> Just Dict
+  _ -> Nothing
+{-# INLINE batchParty #-}
+
+-- command parties that can subscribe to individual queues
+type family ServiceParty (p :: Party) :: Constraint where
+  ServiceParty RecipientService = ()
+  ServiceParty NotifierService = ()
+  ServiceParty p =
+    (Int ~ Bool, TypeError (Type.Text "Party " :<>: ShowType p :<>: Type.Text " is not ServiceParty"))
+
+serviceParty :: SParty p -> Maybe (Dict (PartyI p, ServiceParty p))
+serviceParty = \case
+  SRecipientService -> Just Dict
+  SNotifierService -> Just Dict
+  _ -> Nothing
+{-# INLINE serviceParty #-}
+
+data ASubscriberParty = forall p. (PartyI p, ServiceParty p) => ASP (SParty p)
 
 deriving instance Show ASubscriberParty
 
@@ -364,30 +427,37 @@ instance Eq ASubscriberParty where
 
 instance Encoding ASubscriberParty where
   smpEncode = \case
-    ASP SRecipient -> "R"
-    ASP SNotifier -> "N"
+    ASP SRecipientService -> "R"
+    ASP SNotifierService -> "N"
   smpP =
     A.anyChar >>= \case
-      'R' -> pure $ ASP SRecipient
-      'N' -> pure $ ASP SNotifier
+      'R' -> pure $ ASP SRecipientService
+      'N' -> pure $ ASP SNotifierService
       _ -> fail "bad ASubscriberParty"
 
 instance StrEncoding ASubscriberParty where
   strEncode = smpEncode
   strP = smpP
 
-subscriberParty :: SParty p -> Maybe (Dict (PartyI p, SubscriberParty p))
-subscriberParty = \case
-  SRecipient -> Just Dict
-  SNotifier -> Just Dict
-  _ -> Nothing
-{-# INLINE subscriberParty #-}
+partyClientRole :: SParty p -> Maybe SMPServiceRole
+partyClientRole = \case
+  SCreator -> Just SRMessaging
+  SRecipient -> Just SRMessaging
+  SRecipientService -> Just SRMessaging
+  SSender -> Just SRMessaging
+  SIdleClient -> Nothing
+  SNotifier -> Just SRNotifier
+  SNotifierService -> Just SRNotifier
+  SSenderLink -> Just SRMessaging
+  SProxiedClient -> Just SRMessaging
+  SProxyService -> Just SRProxy
+{-# INLINE partyClientRole #-}
 
-subscriberServiceRole :: SubscriberParty p => SParty p -> SMPServiceRole
-subscriberServiceRole = \case
-  SRecipient -> SRMessaging
-  SNotifier -> SRNotifier
-{-# INLINE subscriberServiceRole #-}
+partyServiceRole :: ServiceParty p => SParty p -> SMPServiceRole
+partyServiceRole = \case
+  SRecipientService -> SRMessaging
+  SNotifierService -> SRNotifier
+{-# INLINE partyServiceRole #-}
 
 -- | Type for client command of any participant.
 data Cmd = forall p. PartyI p => Cmd (SParty p) (Command p)
@@ -398,7 +468,9 @@ deriving instance Show Cmd
 type Transmission c = (CorrId, EntityId, c)
 
 -- | signed parsed transmission, with original raw bytes and parsing error.
-type SignedTransmission e c = (Maybe TAuthorizations, Signed, Transmission (Either e c))
+type SignedTransmission c = (Maybe TAuthorizations, Signed, Transmission c)
+
+type SignedTransmissionOrError e c = Either (Transmission e) (SignedTransmission c)
 
 type Signed = ByteString
 
@@ -439,9 +511,6 @@ decodeTAuthBytes s serviceSig
   | B.length s == C.cbAuthenticatorSize = Right $ Just (TAAuthenticator (C.CbAuthenticator s), serviceSig)
   | otherwise = (\sig -> Just (TASignature sig, serviceSig)) <$> C.decodeSignature s
 
--- | unparsed sent SMP transmission with signature, without session ID.
-type SignedRawTransmission = (Maybe TAuthorizations, CorrId, EntityId, ByteString)
-
 -- | unparsed sent SMP transmission with signature.
 type SentRawTransmission = (Maybe TAuthorizations, ByteString)
 
@@ -466,10 +535,10 @@ data Command (p :: Party) where
   -- v6 of SMP servers only support signature algorithm for command authorization.
   -- v7 of SMP servers additionally support additional layer of authenticated encryption.
   -- RcvPublicAuthKey is defined as C.APublicKey - it can be either signature or DH public keys.
-  NEW :: NewQueueReq -> Command Recipient
+  NEW :: NewQueueReq -> Command Creator
   SUB :: Command Recipient
   -- | subscribe all associated queues. Service ID must be used as entity ID, and service session key must sign the command.
-  SUBS :: Command Recipient
+  SUBS :: Command RecipientService
   KEY :: SndPublicAuthKey -> Command Recipient
   RKEY :: NonEmpty RcvPublicAuthKey -> Command Recipient
   LSET :: LinkId -> QueueLinkData -> Command Recipient
@@ -486,14 +555,14 @@ data Command (p :: Party) where
   -- SEND v1 has to be supported for encoding/decoding
   -- SEND :: MsgBody -> Command Sender
   SEND :: MsgFlags -> MsgBody -> Command Sender
-  PING :: Command Sender
+  PING :: Command IdleClient
   -- Client accessing short links
   LKEY :: SndPublicAuthKey -> Command LinkClient
   LGET :: Command LinkClient
   -- SMP notification subscriber commands
   NSUB :: Command Notifier
   -- | subscribe all associated queues. Service ID must be used as entity ID, and service session key must sign the command.
-  NSUBS :: Command Notifier
+  NSUBS :: Command NotifierService
   PRXY :: SMPServer -> Maybe BasicAuth -> Command ProxiedClient -- request a relay server connection by URI
   -- Transmission to proxy:
   -- - entity ID: ID of the session with relay returned in PKEY (response to PRXY)
@@ -827,9 +896,9 @@ noMsgFlags = MsgFlags {notification = False}
 -- * SMP command tags
 
 data CommandTag (p :: Party) where
-  NEW_ :: CommandTag Recipient
+  NEW_ :: CommandTag Creator
   SUB_ :: CommandTag Recipient
-  SUBS_ :: CommandTag Recipient
+  SUBS_ :: CommandTag RecipientService
   KEY_ :: CommandTag Recipient
   RKEY_ :: CommandTag Recipient
   LSET_ :: CommandTag Recipient
@@ -843,14 +912,14 @@ data CommandTag (p :: Party) where
   QUE_ :: CommandTag Recipient
   SKEY_ :: CommandTag Sender
   SEND_ :: CommandTag Sender
-  PING_ :: CommandTag Sender
+  PING_ :: CommandTag IdleClient
   LKEY_ :: CommandTag LinkClient
   LGET_ :: CommandTag LinkClient
   PRXY_ :: CommandTag ProxiedClient
   PFWD_ :: CommandTag ProxiedClient
   RFWD_ :: CommandTag ProxyService
   NSUB_ :: CommandTag Notifier
-  NSUBS_ :: CommandTag Notifier
+  NSUBS_ :: CommandTag NotifierService
 
 data CmdTag = forall p. PartyI p => CT (SParty p) (CommandTag p)
 
@@ -916,9 +985,9 @@ instance PartyI p => Encoding (CommandTag p) where
 
 instance ProtocolMsgTag CmdTag where
   decodeTag = \case
-    "NEW" -> Just $ CT SRecipient NEW_
+    "NEW" -> Just $ CT SCreator NEW_
     "SUB" -> Just $ CT SRecipient SUB_
-    "SUBS" -> Just $ CT SRecipient SUBS_
+    "SUBS" -> Just $ CT SRecipientService SUBS_
     "KEY" -> Just $ CT SRecipient KEY_
     "RKEY" -> Just $ CT SRecipient RKEY_
     "LSET" -> Just $ CT SRecipient LSET_
@@ -932,14 +1001,14 @@ instance ProtocolMsgTag CmdTag where
     "QUE" -> Just $ CT SRecipient QUE_
     "SKEY" -> Just $ CT SSender SKEY_
     "SEND" -> Just $ CT SSender SEND_
-    "PING" -> Just $ CT SSender PING_
+    "PING" -> Just $ CT SIdleClient PING_
     "LKEY" -> Just $ CT SSenderLink LKEY_
     "LGET" -> Just $ CT SSenderLink LGET_
     "PRXY" -> Just $ CT SProxiedClient PRXY_
     "PFWD" -> Just $ CT SProxiedClient PFWD_
     "RFWD" -> Just $ CT SProxyService RFWD_
     "NSUB" -> Just $ CT SNotifier NSUB_
-    "NSUBS" -> Just $ CT SNotifier NSUBS_
+    "NSUBS" -> Just $ CT SNotifierService NSUBS_
     _ -> Nothing
 
 instance Encoding CmdTag where
@@ -1564,7 +1633,7 @@ instance Protocol SMPVersion ErrorType BrokerMsg where
     Cmd _ NSUB -> True
     _ -> False
   {-# INLINE useServiceAuth #-}
-  protocolPing = Cmd SSender PING
+  protocolPing = Cmd SIdleClient PING
   {-# INLINE protocolPing #-}
   protocolError = \case
     ERR e -> Just e
@@ -1576,7 +1645,7 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding v err msg | msg -> err, msg -
   encodeProtocol :: Version v -> msg -> ByteString
   protocolP :: Version v -> Tag msg -> Parser msg
   fromProtocolError :: ProtocolErrorType -> err
-  checkCredentials :: SignedRawTransmission -> msg -> Either err msg
+  checkCredentials :: Maybe TAuthorizations -> EntityId -> msg -> Either err msg
 
 instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   type Tag (Command p) = CommandTag p
@@ -1620,7 +1689,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials auth (EntityId entId) cmd = case cmd of
     -- NEW must have signature but NOT queue ID
     NEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -1663,14 +1732,14 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
   {-# INLINE encodeProtocol #-}
 
   protocolP v = \case
-    CT SRecipient tag ->
-      Cmd SRecipient <$> case tag of
-        NEW_
-          | v >= shortLinksSMPVersion -> NEW <$> new smpP smpP
-          | v >= sndAuthKeySMPVersion -> NEW <$> new smpP (qReq <$> smpP)
-          | otherwise -> NEW <$> new auth (pure Nothing)
+    CT SCreator NEW_ -> Cmd SCreator <$> newCmd
+      where
+        newCmd
+          | v >= shortLinksSMPVersion = new smpP smpP
+          | v >= sndAuthKeySMPVersion = new smpP (qReq <$> smpP)
+          | otherwise = new auth (pure Nothing)
           where
-            new p1 p2 = do
+            new p1 p2 = NEW <$> do
               rcvAuthKey <- _smpP
               rcvDhKey <- smpP
               auth_ <- p1
@@ -1681,8 +1750,9 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
               pure NewQueueReq {rcvAuthKey, rcvDhKey, auth_, subMode, queueReqData} -- ntfCreds
             auth = optional (A.char 'A' *> smpP)
             qReq sndSecure = Just $ if sndSecure then QRMessaging Nothing else QRContact Nothing
+    CT SRecipient tag ->
+      Cmd SRecipient <$> case tag of
         SUB_ -> pure SUB
-        SUBS_ -> pure SUBS
         KEY_ -> KEY <$> _smpP
         RKEY_ -> RKEY <$> _smpP
         LSET_ -> LSET <$> _smpP <*> smpP
@@ -1694,11 +1764,12 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
         OFF_ -> pure OFF
         DEL_ -> pure DEL
         QUE_ -> pure QUE
+    CT SRecipientService SUBS_ -> pure $ Cmd SRecipientService SUBS
     CT SSender tag ->
       Cmd SSender <$> case tag of
         SKEY_ -> SKEY <$> _smpP
         SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
-        PING_ -> pure PING
+    CT SIdleClient PING_ -> pure $ Cmd SIdleClient PING
     CT SProxyService RFWD_ ->
       Cmd SProxyService . RFWD . EncFwdTransmission . unTail <$> _smpP
     CT SSenderLink tag ->
@@ -1709,15 +1780,13 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
       Cmd SProxiedClient <$> case tag of
         PFWD_ -> PFWD <$> _smpP <*> smpP <*> (EncTransmission . unTail <$> smpP)
         PRXY_ -> PRXY <$> _smpP <*> smpP
-    CT SNotifier tag ->
-      pure $ Cmd SNotifier $ case tag of
-        NSUB_ -> NSUB
-        NSUBS_ -> NSUBS
+    CT SNotifier NSUB_ -> pure $ Cmd SNotifier NSUB
+    CT SNotifierService NSUBS_ -> pure $ Cmd SNotifierService NSUBS
 
   fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials t (Cmd p c) = Cmd p <$> checkCredentials t c
+  checkCredentials tAuth entId (Cmd p c) = Cmd p <$> checkCredentials tAuth entId c
   {-# INLINE checkCredentials #-}
 
 instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
@@ -1804,7 +1873,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
+  checkCredentials _ (EntityId entId) cmd = case cmd of
     -- IDS response should not have queue ID
     IDS _ -> Right cmd
     -- ERR response does not always have queue ID
@@ -2077,26 +2146,51 @@ tParse thParams@THandleParams {batch} s
 eitherList :: (a -> NonEmpty (Either e b)) -> Either e a -> NonEmpty (Either e b)
 eitherList = either (\e -> [Left e])
 
--- | Receive client and server transmissions (determined by `cmd` type).
-tGet :: forall v err cmd c p. (ProtocolEncoding v err cmd, Transport c) => THandle v c p -> IO (NonEmpty (SignedTransmission err cmd))
-tGet th@THandle {params} = L.map (tDecodeParseValidate params) <$> tGetParse th
+-- | Receive server transmissions
+tGetServer :: (ProtocolEncoding v err cmd, Transport c) => THandle v c 'TServer -> IO (NonEmpty (SignedTransmissionOrError err cmd))
+tGetServer = tGet tDecodeServer
+{-# INLINE tGetServer #-}
 
-tDecodeParseValidate :: forall v p err cmd. ProtocolEncoding v err cmd => THandleParams v p -> Either TransportError RawTransmission -> SignedTransmission err cmd
-tDecodeParseValidate THandleParams {sessionId, thVersion = v, implySessId} = \case
+-- | Receive client transmissions
+tGetClient :: (ProtocolEncoding v err cmd, Transport c) => THandle v c 'TClient -> IO (NonEmpty (Transmission (Either err cmd)))
+tGetClient = tGet tDecodeClient
+{-# INLINE tGetClient #-}
+
+tGet ::
+  Transport c =>
+  (THandleParams v p -> Either TransportError RawTransmission -> r) ->
+  THandle v c p ->
+  IO (NonEmpty r)
+tGet tDecode th@THandle {params} = L.map (tDecode params) <$> tGetParse th
+{-# INLINE tGet #-}
+
+tDecodeServer :: forall v err cmd. ProtocolEncoding v err cmd => THandleParams v 'TServer -> Either TransportError RawTransmission -> SignedTransmissionOrError err cmd
+tDecodeServer THandleParams {sessionId, thVersion = v, implySessId} = \case
   Right RawTransmission {authenticator, serviceSig, authorized, sessId, corrId, entityId, command}
-    | implySessId || sessId == sessionId ->
-        let decodedTransmission = (,corrId,entityId,command) <$> decodeTAuthBytes authenticator serviceSig
-         in either (const $ tError corrId) (tParseValidate authorized) decodedTransmission
-    | otherwise -> (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PESession))
-  Left _ -> tError ""
+    | implySessId || sessId == sessionId -> case decodeTAuthBytes authenticator serviceSig of
+        Right tAuth -> bimap t ((tAuth,authorized,) . t) cmdOrErr
+          where
+            cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials tAuth entityId
+            t :: a -> (CorrId, EntityId, a)
+            t = (corrId,entityId,)
+        Left _ -> tError corrId PEBlock
+    | otherwise -> tError corrId PESession
+  Left _ -> tError "" PEBlock
   where
-    tError :: CorrId -> SignedTransmission err cmd
-    tError corrId = (Nothing, "", (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd PEBlock))
+    tError :: CorrId -> ProtocolErrorType -> SignedTransmissionOrError err cmd
+    tError corrId err = Left (corrId, NoEntity, fromProtocolError @v @err @cmd err)
 
-    tParseValidate :: ByteString -> SignedRawTransmission -> SignedTransmission err cmd
-    tParseValidate signed t@(sig, corrId, entityId, command) =
-      let cmd = parseProtocol @v @err @cmd v command >>= checkCredentials t
-       in (sig, signed, (corrId, entityId, cmd))
+tDecodeClient :: forall v err cmd. ProtocolEncoding v err cmd => THandleParams v 'TClient -> Either TransportError RawTransmission -> Transmission (Either err cmd)
+tDecodeClient THandleParams {sessionId, thVersion = v, implySessId} = \case
+  Right RawTransmission {sessId, corrId, entityId, command}
+    | implySessId || sessId == sessionId -> (corrId, entityId, cmdOrErr)
+    | otherwise -> tError corrId PESession
+    where
+      cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials Nothing entityId
+  Left _ -> tError "" PEBlock
+  where
+    tError :: CorrId -> ProtocolErrorType -> Transmission (Either err cmd)
+    tError corrId err = (corrId, NoEntity, Left $ fromProtocolError @v @err @cmd err)
 
 $(J.deriveJSON defaultJSON ''MsgFlags)