{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

module Simplex.FileTransfer.Protocol
  ( FileParty (..),
    SFileParty (..),
    AFileParty (..),
    FilePartyI (..),
    FileCommand (..),
    FileCmd (..),
    FileInfo (..),
    XFTPFileId,
    FileResponse (..),
    xftpBlockSize,
    toFileParty,
    aFileParty,
    checkParty,
    xftpEncodeAuthTransmission,
    xftpEncodeTransmission,
    xftpDecodeTServer,
    xftpDecodeTClient,
  ) where

import qualified Data.Aeson.TH as J
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isNothing)
import Data.Type.Equality
import Data.Word (Word32)
import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, blockedFilesXFTPVersion, xftpClientHandshakeStub)
import Simplex.Messaging.Client (authTransmission)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers
import Simplex.Messaging.Protocol
  ( BasicAuth,
    CommandError (..),
    Protocol (..),
    ProtocolEncoding (..),
    ProtocolErrorType (..),
    ProtocolMsgTag (..),
    ProtocolType (..),
    RcvPublicAuthKey,
    RcvPublicDhKey,
    EntityId (..),
    RecipientId,
    SenderId,
    RawTransmission,
    SentRawTransmission,
    SignedTransmissionOrError,
    SndPublicAuthKey,
    Transmission,
    TransmissionForAuth (..),
    CorrId (..),
    encodeTransmission,
    encodeTransmissionForAuth,
    messageTagP,
    tDecodeServer,
    tDecodeClient,
    tEncodeBatch1,
    tParse,
  )
import Simplex.Messaging.Transport (THandleParams (..), TransportError (..), TransportPeer (..))
import Simplex.Messaging.Util ((<$?>))

xftpBlockSize :: Int
xftpBlockSize :: Int
xftpBlockSize = Int
16384

-- | File protocol clients
data FileParty = FRecipient | FSender
  deriving (FileParty -> FileParty -> Bool
(FileParty -> FileParty -> Bool)
-> (FileParty -> FileParty -> Bool) -> Eq FileParty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileParty -> FileParty -> Bool
== :: FileParty -> FileParty -> Bool
$c/= :: FileParty -> FileParty -> Bool
/= :: FileParty -> FileParty -> Bool
Eq, Int -> FileParty -> ShowS
[FileParty] -> ShowS
FileParty -> String
(Int -> FileParty -> ShowS)
-> (FileParty -> String)
-> ([FileParty] -> ShowS)
-> Show FileParty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileParty -> ShowS
showsPrec :: Int -> FileParty -> ShowS
$cshow :: FileParty -> String
show :: FileParty -> String
$cshowList :: [FileParty] -> ShowS
showList :: [FileParty] -> ShowS
Show)

data SFileParty :: FileParty -> Type where
  SFRecipient :: SFileParty FRecipient
  SFSender :: SFileParty FSender

instance TestEquality SFileParty where
  testEquality :: forall (a :: FileParty) (b :: FileParty).
SFileParty a -> SFileParty b -> Maybe (a :~: b)
testEquality SFileParty a
SFRecipient SFileParty b
SFRecipient = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SFileParty a
SFSender SFileParty b
SFSender = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SFileParty a
_ SFileParty b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

deriving instance Eq (SFileParty p)

deriving instance Show (SFileParty p)

data AFileParty = forall p. FilePartyI p => AFP (SFileParty p)

toFileParty :: SFileParty p -> FileParty
toFileParty :: forall (p :: FileParty). SFileParty p -> FileParty
toFileParty = \case
  SFileParty p
SFRecipient -> FileParty
FRecipient
  SFileParty p
SFSender -> FileParty
FSender

aFileParty :: FileParty -> AFileParty
aFileParty :: FileParty -> AFileParty
aFileParty = \case
  FileParty
FRecipient -> SFileParty 'FRecipient -> AFileParty
forall (p :: FileParty). FilePartyI p => SFileParty p -> AFileParty
AFP SFileParty 'FRecipient
SFRecipient
  FileParty
FSender -> SFileParty 'FSender -> AFileParty
forall (p :: FileParty). FilePartyI p => SFileParty p -> AFileParty
AFP SFileParty 'FSender
SFSender

class FilePartyI (p :: FileParty) where sFileParty :: SFileParty p

instance FilePartyI FRecipient where sFileParty :: SFileParty 'FRecipient
sFileParty = SFileParty 'FRecipient
SFRecipient

instance FilePartyI FSender where sFileParty :: SFileParty 'FSender
sFileParty = SFileParty 'FSender
SFSender

data FileCommandTag (p :: FileParty) where
  FNEW_ :: FileCommandTag FSender
  FADD_ :: FileCommandTag FSender
  FPUT_ :: FileCommandTag FSender
  FDEL_ :: FileCommandTag FSender
  FGET_ :: FileCommandTag FRecipient
  FACK_ :: FileCommandTag FRecipient
  PING_ :: FileCommandTag FRecipient

deriving instance Show (FileCommandTag p)

data FileCmdTag = forall p. FilePartyI p => FCT (SFileParty p) (FileCommandTag p)

instance FilePartyI p => Encoding (FileCommandTag p) where
  smpEncode :: FileCommandTag p -> ByteString
smpEncode = \case
    FileCommandTag p
FNEW_ -> ByteString
"FNEW"
    FileCommandTag p
FADD_ -> ByteString
"FADD"
    FileCommandTag p
FPUT_ -> ByteString
"FPUT"
    FileCommandTag p
FDEL_ -> ByteString
"FDEL"
    FileCommandTag p
FGET_ -> ByteString
"FGET"
    FileCommandTag p
FACK_ -> ByteString
"FACK"
    FileCommandTag p
PING_ -> ByteString
"PING"
  smpP :: Parser (FileCommandTag p)
smpP = Parser (FileCommandTag p)
forall t. ProtocolMsgTag t => Parser t
messageTagP

instance Encoding FileCmdTag where
  smpEncode :: FileCmdTag -> ByteString
smpEncode (FCT SFileParty p
_ FileCommandTag p
t) = FileCommandTag p -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode FileCommandTag p
t
  smpP :: Parser FileCmdTag
smpP = Parser FileCmdTag
forall t. ProtocolMsgTag t => Parser t
messageTagP

instance ProtocolMsgTag FileCmdTag where
  decodeTag :: ByteString -> Maybe FileCmdTag
decodeTag = \case
    ByteString
"FNEW" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FSender -> FileCommandTag 'FSender -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FSender
SFSender FileCommandTag 'FSender
FNEW_
    ByteString
"FADD" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FSender -> FileCommandTag 'FSender -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FSender
SFSender FileCommandTag 'FSender
FADD_
    ByteString
"FPUT" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FSender -> FileCommandTag 'FSender -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FSender
SFSender FileCommandTag 'FSender
FPUT_
    ByteString
"FDEL" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FSender -> FileCommandTag 'FSender -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FSender
SFSender FileCommandTag 'FSender
FDEL_
    ByteString
"FGET" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FRecipient -> FileCommandTag 'FRecipient -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FRecipient
SFRecipient FileCommandTag 'FRecipient
FGET_
    ByteString
"FACK" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FRecipient -> FileCommandTag 'FRecipient -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FRecipient
SFRecipient FileCommandTag 'FRecipient
FACK_
    ByteString
"PING" -> FileCmdTag -> Maybe FileCmdTag
forall a. a -> Maybe a
Just (FileCmdTag -> Maybe FileCmdTag) -> FileCmdTag -> Maybe FileCmdTag
forall a b. (a -> b) -> a -> b
$ SFileParty 'FRecipient -> FileCommandTag 'FRecipient -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT SFileParty 'FRecipient
SFRecipient FileCommandTag 'FRecipient
PING_
    ByteString
_ -> Maybe FileCmdTag
forall a. Maybe a
Nothing

instance FilePartyI p => ProtocolMsgTag (FileCommandTag p) where
  decodeTag :: ByteString -> Maybe (FileCommandTag p)
decodeTag ByteString
s = ByteString -> Maybe FileCmdTag
forall t. ProtocolMsgTag t => ByteString -> Maybe t
decodeTag ByteString
s Maybe FileCmdTag
-> (FileCmdTag -> Maybe (FileCommandTag p))
-> Maybe (FileCommandTag p)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(FCT SFileParty p
_ FileCommandTag p
t) -> FileCommandTag p -> Maybe (FileCommandTag p)
forall (t :: FileParty -> *) (p :: FileParty) (p' :: FileParty).
(FilePartyI p, FilePartyI p') =>
t p' -> Maybe (t p)
checkParty' FileCommandTag p
t)

instance Protocol XFTPVersion XFTPErrorType FileResponse where
  type ProtoCommand FileResponse = FileCmd
  type ProtoType FileResponse = 'PXFTP
  protocolClientHandshake :: forall (c :: TransportPeer -> *).
Transport c =>
c 'TClient
-> Maybe KeyPairX25519
-> KeyHash
-> VersionRange XFTPVersion
-> Bool
-> Maybe (ServiceCredentials, KeyPairEd25519)
-> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
protocolClientHandshake = c 'TClient
-> Maybe KeyPairX25519
-> KeyHash
-> VersionRange XFTPVersion
-> Bool
-> Maybe (ServiceCredentials, KeyPairEd25519)
-> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
forall (c :: TransportPeer -> *).
c 'TClient
-> Maybe KeyPairX25519
-> KeyHash
-> VersionRange XFTPVersion
-> Bool
-> Maybe (ServiceCredentials, KeyPairEd25519)
-> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
xftpClientHandshakeStub
  {-# INLINE protocolClientHandshake #-}
  useServiceAuth :: ProtoCommand FileResponse -> Bool
useServiceAuth ProtoCommand FileResponse
_ = Bool
False
  {-# INLINE useServiceAuth #-}
  protocolPing :: ProtoCommand FileResponse
protocolPing = SFileParty 'FRecipient -> FileCommand 'FRecipient -> FileCmd
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommand p -> FileCmd
FileCmd SFileParty 'FRecipient
SFRecipient FileCommand 'FRecipient
PING
  {-# INLINE protocolPing #-}
  protocolError :: FileResponse -> Maybe XFTPErrorType
protocolError = \case
    FRErr XFTPErrorType
e -> XFTPErrorType -> Maybe XFTPErrorType
forall a. a -> Maybe a
Just XFTPErrorType
e
    FileResponse
_ -> Maybe XFTPErrorType
forall a. Maybe a
Nothing
  {-# INLINE protocolError #-}

data FileCommand (p :: FileParty) where
  FNEW :: FileInfo -> NonEmpty RcvPublicAuthKey -> Maybe BasicAuth -> FileCommand FSender
  FADD :: NonEmpty RcvPublicAuthKey -> FileCommand FSender
  FPUT :: FileCommand FSender
  FDEL :: FileCommand FSender
  FGET :: RcvPublicDhKey -> FileCommand FRecipient
  FACK :: FileCommand FRecipient
  PING :: FileCommand FRecipient

deriving instance Show (FileCommand p)

data FileCmd = forall p. FilePartyI p => FileCmd (SFileParty p) (FileCommand p)

deriving instance Show FileCmd

data FileInfo = FileInfo
  { FileInfo -> RcvPublicAuthKey
sndKey :: SndPublicAuthKey,
    FileInfo -> Word32
size :: Word32,
    FileInfo -> ByteString
digest :: ByteString
  }
  deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileInfo -> ShowS
showsPrec :: Int -> FileInfo -> ShowS
$cshow :: FileInfo -> String
show :: FileInfo -> String
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show)

type XFTPFileId = EntityId

instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand p) where
  type Tag (FileCommand p) = FileCommandTag p
  encodeProtocol :: Version XFTPVersion -> FileCommand p -> ByteString
encodeProtocol Version XFTPVersion
_v = \case
    FNEW FileInfo
file NonEmpty RcvPublicAuthKey
rKeys Maybe BasicAuth
auth_ -> (FileCommandTag 'FSender, Char, FileInfo,
 NonEmpty RcvPublicAuthKey, Maybe BasicAuth)
-> ByteString
forall a. Encoding a => a -> ByteString
e (FileCommandTag 'FSender
FNEW_, Char
' ', FileInfo
file, NonEmpty RcvPublicAuthKey
rKeys, Maybe BasicAuth
auth_)
    FADD NonEmpty RcvPublicAuthKey
rKeys -> (FileCommandTag 'FSender, Char, NonEmpty RcvPublicAuthKey)
-> ByteString
forall a. Encoding a => a -> ByteString
e (FileCommandTag 'FSender
FADD_, Char
' ', NonEmpty RcvPublicAuthKey
rKeys)
    FileCommand p
FPUT -> FileCommandTag 'FSender -> ByteString
forall a. Encoding a => a -> ByteString
e FileCommandTag 'FSender
FPUT_
    FileCommand p
FDEL -> FileCommandTag 'FSender -> ByteString
forall a. Encoding a => a -> ByteString
e FileCommandTag 'FSender
FDEL_
    FGET RcvPublicDhKey
rKey -> (FileCommandTag 'FRecipient, Char, RcvPublicDhKey) -> ByteString
forall a. Encoding a => a -> ByteString
e (FileCommandTag 'FRecipient
FGET_, Char
' ', RcvPublicDhKey
rKey)
    FileCommand p
FACK -> FileCommandTag 'FRecipient -> ByteString
forall a. Encoding a => a -> ByteString
e FileCommandTag 'FRecipient
FACK_
    FileCommand p
PING -> FileCommandTag 'FRecipient -> ByteString
forall a. Encoding a => a -> ByteString
e FileCommandTag 'FRecipient
PING_
    where
      e :: Encoding a => a -> ByteString
      e :: forall a. Encoding a => a -> ByteString
e = a -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode

  protocolP :: Version XFTPVersion
-> Tag (FileCommand p) -> Parser (FileCommand p)
protocolP Version XFTPVersion
v Tag (FileCommand p)
tag = (\(FileCmd SFileParty p
_ FileCommand p
c) -> FileCommand p -> Either String (FileCommand p)
forall (t :: FileParty -> *) (p :: FileParty) (p' :: FileParty).
(FilePartyI p, FilePartyI p') =>
t p' -> Either String (t p)
checkParty FileCommand p
c) (FileCmd -> Either String (FileCommand p))
-> Parser ByteString FileCmd -> Parser (FileCommand p)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Version XFTPVersion -> Tag FileCmd -> Parser ByteString FileCmd
forall v err msg.
ProtocolEncoding v err msg =>
Version v -> Tag msg -> Parser msg
protocolP Version XFTPVersion
v (SFileParty p -> FileCommandTag p -> FileCmdTag
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommandTag p -> FileCmdTag
FCT (forall (p :: FileParty). FilePartyI p => SFileParty p
sFileParty @p) Tag (FileCommand p)
FileCommandTag p
tag)

  fromProtocolError :: ProtocolErrorType -> XFTPErrorType
fromProtocolError = forall v err msg.
ProtocolEncoding v err msg =>
ProtocolErrorType -> err
fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
  {-# INLINE fromProtocolError #-}

  checkCredentials :: Maybe TAuthorizations
-> EntityId
-> FileCommand p
-> Either XFTPErrorType (FileCommand p)
checkCredentials Maybe TAuthorizations
auth (EntityId ByteString
fileId) FileCommand p
cmd = case FileCommand p
cmd of
    -- FNEW must not have signature and chunk ID
    FNEW {}
      | Maybe TAuthorizations -> Bool
forall a. Maybe a -> Bool
isNothing Maybe TAuthorizations
auth -> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. a -> Either a b
Left (XFTPErrorType -> Either XFTPErrorType (FileCommand p))
-> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. (a -> b) -> a -> b
$ CommandError -> XFTPErrorType
CMD CommandError
NO_AUTH
      | Bool -> Bool
not (ByteString -> Bool
B.null ByteString
fileId) -> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. a -> Either a b
Left (XFTPErrorType -> Either XFTPErrorType (FileCommand p))
-> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. (a -> b) -> a -> b
$ CommandError -> XFTPErrorType
CMD CommandError
HAS_AUTH
      | Bool
otherwise -> FileCommand p -> Either XFTPErrorType (FileCommand p)
forall a b. b -> Either a b
Right FileCommand p
cmd
    FileCommand p
PING
      | Maybe TAuthorizations -> Bool
forall a. Maybe a -> Bool
isNothing Maybe TAuthorizations
auth Bool -> Bool -> Bool
&& ByteString -> Bool
B.null ByteString
fileId -> FileCommand p -> Either XFTPErrorType (FileCommand p)
forall a b. b -> Either a b
Right FileCommand p
cmd
      | Bool
otherwise -> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. a -> Either a b
Left (XFTPErrorType -> Either XFTPErrorType (FileCommand p))
-> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. (a -> b) -> a -> b
$ CommandError -> XFTPErrorType
CMD CommandError
HAS_AUTH
    -- other client commands must have both signature and queue ID
    FileCommand p
_
      | Maybe TAuthorizations -> Bool
forall a. Maybe a -> Bool
isNothing Maybe TAuthorizations
auth Bool -> Bool -> Bool
|| ByteString -> Bool
B.null ByteString
fileId -> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. a -> Either a b
Left (XFTPErrorType -> Either XFTPErrorType (FileCommand p))
-> XFTPErrorType -> Either XFTPErrorType (FileCommand p)
forall a b. (a -> b) -> a -> b
$ CommandError -> XFTPErrorType
CMD CommandError
NO_AUTH
      | Bool
otherwise -> FileCommand p -> Either XFTPErrorType (FileCommand p)
forall a b. b -> Either a b
Right FileCommand p
cmd

instance ProtocolEncoding XFTPVersion XFTPErrorType FileCmd where
  type Tag FileCmd = FileCmdTag
  encodeProtocol :: Version XFTPVersion -> FileCmd -> ByteString
encodeProtocol Version XFTPVersion
_v (FileCmd SFileParty p
_ FileCommand p
c) = Version XFTPVersion -> FileCommand p -> ByteString
forall v err msg.
ProtocolEncoding v err msg =>
Version v -> msg -> ByteString
encodeProtocol Version XFTPVersion
_v FileCommand p
c

  protocolP :: Version XFTPVersion -> Tag FileCmd -> Parser ByteString FileCmd
protocolP Version XFTPVersion
_v = \case
    FCT SFileParty p
SFSender FileCommandTag p
tag ->
      SFileParty 'FSender -> FileCommand 'FSender -> FileCmd
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommand p -> FileCmd
FileCmd SFileParty 'FSender
SFSender (FileCommand 'FSender -> FileCmd)
-> Parser ByteString (FileCommand 'FSender)
-> Parser ByteString FileCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case FileCommandTag p
tag of
        FileCommandTag p
FNEW_ -> FileInfo
-> NonEmpty RcvPublicAuthKey
-> Maybe BasicAuth
-> FileCommand 'FSender
FNEW (FileInfo
 -> NonEmpty RcvPublicAuthKey
 -> Maybe BasicAuth
 -> FileCommand 'FSender)
-> Parser ByteString FileInfo
-> Parser
     ByteString
     (NonEmpty RcvPublicAuthKey
      -> Maybe BasicAuth -> FileCommand 'FSender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FileInfo
forall a. Encoding a => Parser a
_smpP Parser
  ByteString
  (NonEmpty RcvPublicAuthKey
   -> Maybe BasicAuth -> FileCommand 'FSender)
-> Parser ByteString (NonEmpty RcvPublicAuthKey)
-> Parser ByteString (Maybe BasicAuth -> FileCommand 'FSender)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty RcvPublicAuthKey)
forall a. Encoding a => Parser a
smpP Parser ByteString (Maybe BasicAuth -> FileCommand 'FSender)
-> Parser ByteString (Maybe BasicAuth)
-> Parser ByteString (FileCommand 'FSender)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe BasicAuth)
forall a. Encoding a => Parser a
smpP
        FileCommandTag p
FADD_ -> NonEmpty RcvPublicAuthKey -> FileCommand 'FSender
FADD (NonEmpty RcvPublicAuthKey -> FileCommand 'FSender)
-> Parser ByteString (NonEmpty RcvPublicAuthKey)
-> Parser ByteString (FileCommand 'FSender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty RcvPublicAuthKey)
forall a. Encoding a => Parser a
_smpP
        FileCommandTag p
FPUT_ -> FileCommand 'FSender -> Parser ByteString (FileCommand 'FSender)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileCommand 'FSender
FPUT
        FileCommandTag p
FDEL_ -> FileCommand 'FSender -> Parser ByteString (FileCommand 'FSender)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileCommand 'FSender
FDEL
    FCT SFileParty p
SFRecipient FileCommandTag p
tag ->
      SFileParty 'FRecipient -> FileCommand 'FRecipient -> FileCmd
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommand p -> FileCmd
FileCmd SFileParty 'FRecipient
SFRecipient (FileCommand 'FRecipient -> FileCmd)
-> Parser ByteString (FileCommand 'FRecipient)
-> Parser ByteString FileCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case FileCommandTag p
tag of
        FileCommandTag p
FGET_ -> RcvPublicDhKey -> FileCommand 'FRecipient
FGET (RcvPublicDhKey -> FileCommand 'FRecipient)
-> Parser ByteString RcvPublicDhKey
-> Parser ByteString (FileCommand 'FRecipient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RcvPublicDhKey
forall a. Encoding a => Parser a
_smpP
        FileCommandTag p
FACK_ -> FileCommand 'FRecipient
-> Parser ByteString (FileCommand 'FRecipient)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileCommand 'FRecipient
FACK
        FileCommandTag p
PING_ -> FileCommand 'FRecipient
-> Parser ByteString (FileCommand 'FRecipient)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileCommand 'FRecipient
PING

  fromProtocolError :: ProtocolErrorType -> XFTPErrorType
fromProtocolError = forall v err msg.
ProtocolEncoding v err msg =>
ProtocolErrorType -> err
fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
  {-# INLINE fromProtocolError #-}

  checkCredentials :: Maybe TAuthorizations
-> EntityId -> FileCmd -> Either XFTPErrorType FileCmd
checkCredentials Maybe TAuthorizations
tAuth EntityId
entId (FileCmd SFileParty p
p FileCommand p
c) = SFileParty p -> FileCommand p -> FileCmd
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommand p -> FileCmd
FileCmd SFileParty p
p (FileCommand p -> FileCmd)
-> Either XFTPErrorType (FileCommand p)
-> Either XFTPErrorType FileCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TAuthorizations
-> EntityId
-> FileCommand p
-> Either XFTPErrorType (FileCommand p)
forall v err msg.
ProtocolEncoding v err msg =>
Maybe TAuthorizations -> EntityId -> msg -> Either err msg
checkCredentials Maybe TAuthorizations
tAuth EntityId
entId FileCommand p
c
  {-# INLINE checkCredentials #-}

instance Encoding FileInfo where
  smpEncode :: FileInfo -> ByteString
smpEncode FileInfo {RcvPublicAuthKey
sndKey :: FileInfo -> RcvPublicAuthKey
sndKey :: RcvPublicAuthKey
sndKey, Word32
size :: FileInfo -> Word32
size :: Word32
size, ByteString
digest :: FileInfo -> ByteString
digest :: ByteString
digest} = (RcvPublicAuthKey, Word32, ByteString) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (RcvPublicAuthKey
sndKey, Word32
size, ByteString
digest)
  smpP :: Parser ByteString FileInfo
smpP = RcvPublicAuthKey -> Word32 -> ByteString -> FileInfo
FileInfo (RcvPublicAuthKey -> Word32 -> ByteString -> FileInfo)
-> Parser ByteString RcvPublicAuthKey
-> Parser ByteString (Word32 -> ByteString -> FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RcvPublicAuthKey
forall a. Encoding a => Parser a
smpP Parser ByteString (Word32 -> ByteString -> FileInfo)
-> Parser ByteString Word32
-> Parser ByteString (ByteString -> FileInfo)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Word32
forall a. Encoding a => Parser a
smpP Parser ByteString (ByteString -> FileInfo)
-> Parser ByteString ByteString -> Parser ByteString FileInfo
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
forall a. Encoding a => Parser a
smpP

instance StrEncoding FileInfo where
  strEncode :: FileInfo -> ByteString
strEncode FileInfo {RcvPublicAuthKey
sndKey :: FileInfo -> RcvPublicAuthKey
sndKey :: RcvPublicAuthKey
sndKey, Word32
size :: FileInfo -> Word32
size :: Word32
size, ByteString
digest :: FileInfo -> ByteString
digest :: ByteString
digest} = (RcvPublicAuthKey, Word32, ByteString) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (RcvPublicAuthKey
sndKey, Word32
size, ByteString
digest)
  strP :: Parser ByteString FileInfo
strP = RcvPublicAuthKey -> Word32 -> ByteString -> FileInfo
FileInfo (RcvPublicAuthKey -> Word32 -> ByteString -> FileInfo)
-> Parser ByteString RcvPublicAuthKey
-> Parser ByteString (Word32 -> ByteString -> FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RcvPublicAuthKey
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (Word32 -> ByteString -> FileInfo)
-> Parser ByteString Word32
-> Parser ByteString (ByteString -> FileInfo)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Word32
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (ByteString -> FileInfo)
-> Parser ByteString ByteString -> Parser ByteString FileInfo
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

data FileResponseTag
  = FRSndIds_
  | FRRcvIds_
  | FRFile_
  | FROk_
  | FRErr_
  | FRPong_
  deriving (Int -> FileResponseTag -> ShowS
[FileResponseTag] -> ShowS
FileResponseTag -> String
(Int -> FileResponseTag -> ShowS)
-> (FileResponseTag -> String)
-> ([FileResponseTag] -> ShowS)
-> Show FileResponseTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileResponseTag -> ShowS
showsPrec :: Int -> FileResponseTag -> ShowS
$cshow :: FileResponseTag -> String
show :: FileResponseTag -> String
$cshowList :: [FileResponseTag] -> ShowS
showList :: [FileResponseTag] -> ShowS
Show)

instance Encoding FileResponseTag where
  smpEncode :: FileResponseTag -> ByteString
smpEncode = \case
    FileResponseTag
FRSndIds_ -> ByteString
"SIDS"
    FileResponseTag
FRRcvIds_ -> ByteString
"RIDS"
    FileResponseTag
FRFile_ -> ByteString
"FILE"
    FileResponseTag
FROk_ -> ByteString
"OK"
    FileResponseTag
FRErr_ -> ByteString
"ERR"
    FileResponseTag
FRPong_ -> ByteString
"PONG"
  smpP :: Parser FileResponseTag
smpP = Parser FileResponseTag
forall t. ProtocolMsgTag t => Parser t
messageTagP

instance ProtocolMsgTag FileResponseTag where
  decodeTag :: ByteString -> Maybe FileResponseTag
decodeTag = \case
    ByteString
"SIDS" -> FileResponseTag -> Maybe FileResponseTag
forall a. a -> Maybe a
Just FileResponseTag
FRSndIds_
    ByteString
"RIDS" -> FileResponseTag -> Maybe FileResponseTag
forall a. a -> Maybe a
Just FileResponseTag
FRRcvIds_
    ByteString
"FILE" -> FileResponseTag -> Maybe FileResponseTag
forall a. a -> Maybe a
Just FileResponseTag
FRFile_
    ByteString
"OK" -> FileResponseTag -> Maybe FileResponseTag
forall a. a -> Maybe a
Just FileResponseTag
FROk_
    ByteString
"ERR" -> FileResponseTag -> Maybe FileResponseTag
forall a. a -> Maybe a
Just FileResponseTag
FRErr_
    ByteString
"PONG" -> FileResponseTag -> Maybe FileResponseTag
forall a. a -> Maybe a
Just FileResponseTag
FRPong_
    ByteString
_ -> Maybe FileResponseTag
forall a. Maybe a
Nothing

data FileResponse
  = FRSndIds SenderId (NonEmpty RecipientId)
  | FRRcvIds (NonEmpty RecipientId)
  | FRFile RcvPublicDhKey C.CbNonce
  | FROk
  | FRErr XFTPErrorType
  | FRPong
  deriving (Int -> FileResponse -> ShowS
[FileResponse] -> ShowS
FileResponse -> String
(Int -> FileResponse -> ShowS)
-> (FileResponse -> String)
-> ([FileResponse] -> ShowS)
-> Show FileResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileResponse -> ShowS
showsPrec :: Int -> FileResponse -> ShowS
$cshow :: FileResponse -> String
show :: FileResponse -> String
$cshowList :: [FileResponse] -> ShowS
showList :: [FileResponse] -> ShowS
Show)

instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
  type Tag FileResponse = FileResponseTag
  encodeProtocol :: Version XFTPVersion -> FileResponse -> ByteString
encodeProtocol Version XFTPVersion
v = \case
    FRSndIds EntityId
fId NonEmpty EntityId
rIds -> (FileResponseTag, Char, EntityId, NonEmpty EntityId) -> ByteString
forall a. Encoding a => a -> ByteString
e (FileResponseTag
FRSndIds_, Char
' ', EntityId
fId, NonEmpty EntityId
rIds)
    FRRcvIds NonEmpty EntityId
rIds -> (FileResponseTag, Char, NonEmpty EntityId) -> ByteString
forall a. Encoding a => a -> ByteString
e (FileResponseTag
FRRcvIds_, Char
' ', NonEmpty EntityId
rIds)
    FRFile RcvPublicDhKey
rDhKey CbNonce
nonce -> (FileResponseTag, Char, RcvPublicDhKey, CbNonce) -> ByteString
forall a. Encoding a => a -> ByteString
e (FileResponseTag
FRFile_, Char
' ', RcvPublicDhKey
rDhKey, CbNonce
nonce)
    FileResponse
FROk -> FileResponseTag -> ByteString
forall a. Encoding a => a -> ByteString
e FileResponseTag
FROk_
    FRErr XFTPErrorType
err -> case XFTPErrorType
err of
      BLOCKED BlockingInfo
_ | Version XFTPVersion
v Version XFTPVersion -> Version XFTPVersion -> Bool
forall a. Ord a => a -> a -> Bool
< Version XFTPVersion
blockedFilesXFTPVersion -> (FileResponseTag, Char, XFTPErrorType) -> ByteString
forall a. Encoding a => a -> ByteString
e (FileResponseTag
FRErr_, Char
' ', XFTPErrorType
AUTH)
      XFTPErrorType
_ -> (FileResponseTag, Char, XFTPErrorType) -> ByteString
forall a. Encoding a => a -> ByteString
e (FileResponseTag
FRErr_, Char
' ', XFTPErrorType
err)
    FileResponse
FRPong -> FileResponseTag -> ByteString
forall a. Encoding a => a -> ByteString
e FileResponseTag
FRPong_
    where
      e :: Encoding a => a -> ByteString
      e :: forall a. Encoding a => a -> ByteString
e = a -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode

  protocolP :: Version XFTPVersion -> Tag FileResponse -> Parser FileResponse
protocolP Version XFTPVersion
_v = \case
    Tag FileResponse
FileResponseTag
FRSndIds_ -> EntityId -> NonEmpty EntityId -> FileResponse
FRSndIds (EntityId -> NonEmpty EntityId -> FileResponse)
-> Parser ByteString EntityId
-> Parser ByteString (NonEmpty EntityId -> FileResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString EntityId
forall a. Encoding a => Parser a
_smpP Parser ByteString (NonEmpty EntityId -> FileResponse)
-> Parser ByteString (NonEmpty EntityId) -> Parser FileResponse
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty EntityId)
forall a. Encoding a => Parser a
smpP
    Tag FileResponse
FileResponseTag
FRRcvIds_ -> NonEmpty EntityId -> FileResponse
FRRcvIds (NonEmpty EntityId -> FileResponse)
-> Parser ByteString (NonEmpty EntityId) -> Parser FileResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty EntityId)
forall a. Encoding a => Parser a
_smpP
    Tag FileResponse
FileResponseTag
FRFile_ -> RcvPublicDhKey -> CbNonce -> FileResponse
FRFile (RcvPublicDhKey -> CbNonce -> FileResponse)
-> Parser ByteString RcvPublicDhKey
-> Parser ByteString (CbNonce -> FileResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RcvPublicDhKey
forall a. Encoding a => Parser a
_smpP Parser ByteString (CbNonce -> FileResponse)
-> Parser ByteString CbNonce -> Parser FileResponse
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CbNonce
forall a. Encoding a => Parser a
smpP
    Tag FileResponse
FileResponseTag
FROk_ -> FileResponse -> Parser FileResponse
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileResponse
FROk
    Tag FileResponse
FileResponseTag
FRErr_ -> XFTPErrorType -> FileResponse
FRErr (XFTPErrorType -> FileResponse)
-> Parser ByteString XFTPErrorType -> Parser FileResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString XFTPErrorType
forall a. Encoding a => Parser a
_smpP
    Tag FileResponse
FileResponseTag
FRPong_ -> FileResponse -> Parser FileResponse
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileResponse
FRPong

  fromProtocolError :: ProtocolErrorType -> XFTPErrorType
fromProtocolError = \case
    ProtocolErrorType
PECmdSyntax -> CommandError -> XFTPErrorType
CMD CommandError
SYNTAX
    ProtocolErrorType
PECmdUnknown -> CommandError -> XFTPErrorType
CMD CommandError
UNKNOWN
    ProtocolErrorType
PESession -> XFTPErrorType
SESSION
    ProtocolErrorType
PEBlock -> XFTPErrorType
BLOCK
  {-# INLINE fromProtocolError #-}

  checkCredentials :: Maybe TAuthorizations
-> EntityId -> FileResponse -> Either XFTPErrorType FileResponse
checkCredentials Maybe TAuthorizations
_ (EntityId ByteString
entId) FileResponse
cmd = case FileResponse
cmd of
    FRSndIds {} -> Either XFTPErrorType FileResponse
noEntity
    -- ERR response does not always have entity ID
    FRErr XFTPErrorType
_ -> FileResponse -> Either XFTPErrorType FileResponse
forall a b. b -> Either a b
Right FileResponse
cmd
    -- PONG response must not have queue ID
    FileResponse
FRPong -> Either XFTPErrorType FileResponse
noEntity
    -- other server responses must have entity ID
    FileResponse
_
      | ByteString -> Bool
B.null ByteString
entId -> XFTPErrorType -> Either XFTPErrorType FileResponse
forall a b. a -> Either a b
Left (XFTPErrorType -> Either XFTPErrorType FileResponse)
-> XFTPErrorType -> Either XFTPErrorType FileResponse
forall a b. (a -> b) -> a -> b
$ CommandError -> XFTPErrorType
CMD CommandError
NO_ENTITY
      | Bool
otherwise -> FileResponse -> Either XFTPErrorType FileResponse
forall a b. b -> Either a b
Right FileResponse
cmd
    where
      noEntity :: Either XFTPErrorType FileResponse
noEntity
        | ByteString -> Bool
B.null ByteString
entId = FileResponse -> Either XFTPErrorType FileResponse
forall a b. b -> Either a b
Right FileResponse
cmd
        | Bool
otherwise = XFTPErrorType -> Either XFTPErrorType FileResponse
forall a b. a -> Either a b
Left (XFTPErrorType -> Either XFTPErrorType FileResponse)
-> XFTPErrorType -> Either XFTPErrorType FileResponse
forall a b. (a -> b) -> a -> b
$ CommandError -> XFTPErrorType
CMD CommandError
HAS_AUTH

checkParty :: forall t p p'. (FilePartyI p, FilePartyI p') => t p' -> Either String (t p)
checkParty :: forall (t :: FileParty -> *) (p :: FileParty) (p' :: FileParty).
(FilePartyI p, FilePartyI p') =>
t p' -> Either String (t p)
checkParty t p'
c = case SFileParty p -> SFileParty p' -> Maybe (p :~: p')
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: FileParty) (b :: FileParty).
SFileParty a -> SFileParty b -> Maybe (a :~: b)
testEquality (forall (p :: FileParty). FilePartyI p => SFileParty p
sFileParty @p) (forall (p :: FileParty). FilePartyI p => SFileParty p
sFileParty @p') of
  Just p :~: p'
Refl -> t p -> Either String (t p)
forall a b. b -> Either a b
Right t p
t p'
c
  Maybe (p :~: p')
Nothing -> String -> Either String (t p)
forall a b. a -> Either a b
Left String
"incorrect XFTP party"

checkParty' :: forall t p p'. (FilePartyI p, FilePartyI p') => t p' -> Maybe (t p)
checkParty' :: forall (t :: FileParty -> *) (p :: FileParty) (p' :: FileParty).
(FilePartyI p, FilePartyI p') =>
t p' -> Maybe (t p)
checkParty' t p'
c = case SFileParty p -> SFileParty p' -> Maybe (p :~: p')
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: FileParty) (b :: FileParty).
SFileParty a -> SFileParty b -> Maybe (a :~: b)
testEquality (forall (p :: FileParty). FilePartyI p => SFileParty p
sFileParty @p) (forall (p :: FileParty). FilePartyI p => SFileParty p
sFileParty @p') of
  Just p :~: p'
Refl -> t p -> Maybe (t p)
forall a. a -> Maybe a
Just t p
t p'
c
  Maybe (p :~: p')
_ -> Maybe (t p)
forall a. Maybe a
Nothing

xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
xftpEncodeAuthTransmission :: forall c.
ProtocolEncoding XFTPVersion XFTPErrorType c =>
THandleParams XFTPVersion 'TClient
-> APrivateAuthKey
-> Transmission c
-> Either TransportError ByteString
xftpEncodeAuthTransmission thParams :: THandleParams XFTPVersion 'TClient
thParams@THandleParams {Maybe (THandleAuth 'TClient)
thAuth :: Maybe (THandleAuth 'TClient)
$sel:thAuth:THandleParams :: forall v (p :: TransportPeer).
THandleParams v p -> Maybe (THandleAuth p)
thAuth} APrivateAuthKey
pKey t :: Transmission c
t@(CorrId
corrId, EntityId
_, c
_) = do
  let TransmissionForAuth {ByteString
tForAuth :: ByteString
$sel:tForAuth:TransmissionForAuth :: TransmissionForAuth -> ByteString
tForAuth, ByteString
tToSend :: ByteString
$sel:tToSend:TransmissionForAuth :: TransmissionForAuth -> ByteString
tToSend} = THandleParams XFTPVersion 'TClient
-> Transmission c -> TransmissionForAuth
forall v e c (p :: TransportPeer).
ProtocolEncoding v e c =>
THandleParams v p -> Transmission c -> TransmissionForAuth
encodeTransmissionForAuth THandleParams XFTPVersion 'TClient
thParams Transmission c
t
  SentRawTransmission -> Either TransportError ByteString
xftpEncodeBatch1 (SentRawTransmission -> Either TransportError ByteString)
-> (Maybe TAuthorizations -> SentRawTransmission)
-> Maybe TAuthorizations
-> Either TransportError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,ByteString
tToSend) (Maybe TAuthorizations -> Either TransportError ByteString)
-> Either TransportError (Maybe TAuthorizations)
-> Either TransportError ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (THandleAuth 'TClient)
-> Bool
-> Maybe APrivateAuthKey
-> CbNonce
-> ByteString
-> Either TransportError (Maybe TAuthorizations)
authTransmission Maybe (THandleAuth 'TClient)
thAuth Bool
False (APrivateAuthKey -> Maybe APrivateAuthKey
forall a. a -> Maybe a
Just APrivateAuthKey
pKey) (ByteString -> CbNonce
C.cbNonce (ByteString -> CbNonce) -> ByteString -> CbNonce
forall a b. (a -> b) -> a -> b
$ CorrId -> ByteString
bs CorrId
corrId) ByteString
tForAuth

xftpEncodeTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
xftpEncodeTransmission :: forall c (p :: TransportPeer).
ProtocolEncoding XFTPVersion XFTPErrorType c =>
THandleParams XFTPVersion p
-> Transmission c -> Either TransportError ByteString
xftpEncodeTransmission THandleParams XFTPVersion p
thParams Transmission c
t = SentRawTransmission -> Either TransportError ByteString
xftpEncodeBatch1 (Maybe TAuthorizations
forall a. Maybe a
Nothing, THandleParams XFTPVersion p -> Transmission c -> ByteString
forall v e c (p :: TransportPeer).
ProtocolEncoding v e c =>
THandleParams v p -> Transmission c -> ByteString
encodeTransmission THandleParams XFTPVersion p
thParams Transmission c
t)

-- this function uses batch syntax but puts only one transmission in the batch
xftpEncodeBatch1 :: SentRawTransmission -> Either TransportError ByteString
xftpEncodeBatch1 :: SentRawTransmission -> Either TransportError ByteString
xftpEncodeBatch1 SentRawTransmission
t = (CryptoError -> TransportError)
-> Either CryptoError ByteString
-> Either TransportError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TransportError -> CryptoError -> TransportError
forall a b. a -> b -> a
const TransportError
TELargeMsg) (Either CryptoError ByteString -> Either TransportError ByteString)
-> Either CryptoError ByteString
-> Either TransportError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Either CryptoError ByteString
C.pad (Bool -> SentRawTransmission -> ByteString
tEncodeBatch1 Bool
False SentRawTransmission
t) Int
xftpBlockSize

xftpDecodeTServer :: THandleParams XFTPVersion 'TServer -> ByteString -> Either XFTPErrorType (SignedTransmissionOrError XFTPErrorType FileCmd)
xftpDecodeTServer :: THandleParams XFTPVersion 'TServer
-> ByteString
-> Either
     XFTPErrorType (SignedTransmissionOrError XFTPErrorType FileCmd)
xftpDecodeTServer = (THandleParams XFTPVersion 'TServer
 -> Either TransportError RawTransmission
 -> SignedTransmissionOrError XFTPErrorType FileCmd)
-> THandleParams XFTPVersion 'TServer
-> ByteString
-> Either
     XFTPErrorType (SignedTransmissionOrError XFTPErrorType FileCmd)
forall (p :: TransportPeer) r.
(THandleParams XFTPVersion p
 -> Either TransportError RawTransmission -> r)
-> THandleParams XFTPVersion p
-> ByteString
-> Either XFTPErrorType r
xftpDecodeTransmission THandleParams XFTPVersion 'TServer
-> Either TransportError RawTransmission
-> SignedTransmissionOrError XFTPErrorType FileCmd
forall v err cmd.
ProtocolEncoding v err cmd =>
THandleParams v 'TServer
-> Either TransportError RawTransmission
-> SignedTransmissionOrError err cmd
tDecodeServer
{-# INLINE xftpDecodeTServer #-}

xftpDecodeTClient :: THandleParams XFTPVersion 'TClient -> ByteString -> Either XFTPErrorType (Transmission (Either XFTPErrorType FileResponse))
xftpDecodeTClient :: THandleParams XFTPVersion 'TClient
-> ByteString
-> Either
     XFTPErrorType (Transmission (Either XFTPErrorType FileResponse))
xftpDecodeTClient = (THandleParams XFTPVersion 'TClient
 -> Either TransportError RawTransmission
 -> Transmission (Either XFTPErrorType FileResponse))
-> THandleParams XFTPVersion 'TClient
-> ByteString
-> Either
     XFTPErrorType (Transmission (Either XFTPErrorType FileResponse))
forall (p :: TransportPeer) r.
(THandleParams XFTPVersion p
 -> Either TransportError RawTransmission -> r)
-> THandleParams XFTPVersion p
-> ByteString
-> Either XFTPErrorType r
xftpDecodeTransmission THandleParams XFTPVersion 'TClient
-> Either TransportError RawTransmission
-> Transmission (Either XFTPErrorType FileResponse)
forall v err cmd.
ProtocolEncoding v err cmd =>
THandleParams v 'TClient
-> Either TransportError RawTransmission
-> Transmission (Either err cmd)
tDecodeClient
{-# INLINE xftpDecodeTClient #-}

xftpDecodeTransmission ::
  (THandleParams XFTPVersion p -> Either TransportError RawTransmission -> r) ->
  THandleParams XFTPVersion p ->
  ByteString ->
  Either XFTPErrorType r
xftpDecodeTransmission :: forall (p :: TransportPeer) r.
(THandleParams XFTPVersion p
 -> Either TransportError RawTransmission -> r)
-> THandleParams XFTPVersion p
-> ByteString
-> Either XFTPErrorType r
xftpDecodeTransmission THandleParams XFTPVersion p
-> Either TransportError RawTransmission -> r
tDecode THandleParams XFTPVersion p
thParams ByteString
t = do
  ByteString
t' <- (CryptoError -> XFTPErrorType)
-> Either CryptoError ByteString -> Either XFTPErrorType ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (XFTPErrorType -> CryptoError -> XFTPErrorType
forall a b. a -> b -> a
const XFTPErrorType
BLOCK) (Either CryptoError ByteString -> Either XFTPErrorType ByteString)
-> Either CryptoError ByteString -> Either XFTPErrorType ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either CryptoError ByteString
C.unPad ByteString
t
  case THandleParams XFTPVersion p
-> ByteString -> NonEmpty (Either TransportError RawTransmission)
forall v (p :: TransportPeer).
THandleParams v p
-> ByteString -> NonEmpty (Either TransportError RawTransmission)
tParse THandleParams XFTPVersion p
thParams ByteString
t' of
    Either TransportError RawTransmission
t'' :| [] -> r -> Either XFTPErrorType r
forall a b. b -> Either a b
Right (r -> Either XFTPErrorType r) -> r -> Either XFTPErrorType r
forall a b. (a -> b) -> a -> b
$ THandleParams XFTPVersion p
-> Either TransportError RawTransmission -> r
tDecode THandleParams XFTPVersion p
thParams Either TransportError RawTransmission
t''
    NonEmpty (Either TransportError RawTransmission)
_ -> XFTPErrorType -> Either XFTPErrorType r
forall a b. a -> Either a b
Left XFTPErrorType
BLOCK

$(J.deriveJSON (enumJSON $ dropPrefix "F") ''FileParty)