{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Simplex.FileTransfer.Client
  ( XFTPClient (..),
    XFTPClientConfig (..),
    XFTPChunkSpec (..),
    XFTPClientError,
    defaultXFTPClientConfig,
    getXFTPClient,
    closeXFTPClient,
    xftpClientServer,
    xftpTransportHost,
    createXFTPChunk,
    addXFTPRecipients,
    uploadXFTPChunk,
    downloadXFTPChunk,
    deleteXFTPChunk,
    ackXFTPChunk,
    pingXFTP,
    singleChunkSize,
    prepareChunkSizes,
    prepareChunkSpecs,
    getChunkDigest,
  ) where

import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans.Except
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (first)
import Data.ByteString.Builder (Builder, byteString)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as LB
import Data.Int (Int64)
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (listToMaybe)
import Data.Time.Clock (UTCTime)
import Data.Word (Word32)
import qualified Data.X509 as X
import qualified Data.X509.Validation as XV
import qualified Network.HTTP.Types as N
import qualified Network.HTTP2.Client as H
import Network.Socket (HostName)
import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Protocol
import Simplex.FileTransfer.Transport
import Simplex.Messaging.Client
  ( NetworkConfig (..),
    NetworkRequestMode (..),
    ProtocolClientError (..),
    TransportSession,
    chooseTransportHost,
    clientSocksCredentials,
    defaultNetworkConfig,
    netTimeoutInt,
    transportClientConfig,
    unexpectedResponse,
    useWebPort,
  )
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Lazy as LC
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol
  ( BasicAuth,
    NetworkError (..),
    Protocol (..),
    ProtocolServer (..),
    RecipientId,
    SenderId,
    toNetworkError,
    pattern NoEntity,
  )
import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost)
import Simplex.Messaging.Transport.HTTP2
import Simplex.Messaging.Transport.HTTP2.Client
import Simplex.Messaging.Transport.HTTP2.File
import Simplex.Messaging.Util (liftEitherWith, liftError', tshow, whenM)
import Simplex.Messaging.Version
import UnliftIO
import UnliftIO.Directory

data XFTPClient = XFTPClient
  { XFTPClient -> HTTP2Client
http2Client :: HTTP2Client,
    XFTPClient -> TransportSession FileResponse
transportSession :: TransportSession FileResponse,
    XFTPClient -> THandleParams XFTPVersion 'TClient
thParams :: THandleParams XFTPVersion 'TClient,
    XFTPClient -> XFTPClientConfig
config :: XFTPClientConfig
  }

data XFTPClientConfig = XFTPClientConfig
  { XFTPClientConfig -> NetworkConfig
xftpNetworkConfig :: NetworkConfig,
    XFTPClientConfig -> VersionRangeXFTP
serverVRange :: VersionRangeXFTP,
    XFTPClientConfig -> Maybe [SessionId]
clientALPN :: Maybe [ALPN]
  }

data XFTPChunkBody = XFTPChunkBody
  { XFTPChunkBody -> Int
chunkSize :: Int,
    XFTPChunkBody -> Int -> IO SessionId
chunkPart :: Int -> IO ByteString,
    XFTPChunkBody -> HTTP2Body
http2Body :: HTTP2Body
  }

data XFTPChunkSpec = XFTPChunkSpec
  { XFTPChunkSpec -> String
filePath :: FilePath,
    XFTPChunkSpec -> Int64
chunkOffset :: Int64,
    XFTPChunkSpec -> Word32
chunkSize :: Word32
  }
  deriving (XFTPChunkSpec -> XFTPChunkSpec -> Bool
(XFTPChunkSpec -> XFTPChunkSpec -> Bool)
-> (XFTPChunkSpec -> XFTPChunkSpec -> Bool) -> Eq XFTPChunkSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XFTPChunkSpec -> XFTPChunkSpec -> Bool
== :: XFTPChunkSpec -> XFTPChunkSpec -> Bool
$c/= :: XFTPChunkSpec -> XFTPChunkSpec -> Bool
/= :: XFTPChunkSpec -> XFTPChunkSpec -> Bool
Eq, Int -> XFTPChunkSpec -> ShowS
[XFTPChunkSpec] -> ShowS
XFTPChunkSpec -> String
(Int -> XFTPChunkSpec -> ShowS)
-> (XFTPChunkSpec -> String)
-> ([XFTPChunkSpec] -> ShowS)
-> Show XFTPChunkSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XFTPChunkSpec -> ShowS
showsPrec :: Int -> XFTPChunkSpec -> ShowS
$cshow :: XFTPChunkSpec -> String
show :: XFTPChunkSpec -> String
$cshowList :: [XFTPChunkSpec] -> ShowS
showList :: [XFTPChunkSpec] -> ShowS
Show)

type XFTPClientError = ProtocolClientError XFTPErrorType

defaultXFTPClientConfig :: XFTPClientConfig
defaultXFTPClientConfig :: XFTPClientConfig
defaultXFTPClientConfig =
  XFTPClientConfig
    { $sel:xftpNetworkConfig:XFTPClientConfig :: NetworkConfig
xftpNetworkConfig = NetworkConfig
defaultNetworkConfig,
      $sel:serverVRange:XFTPClientConfig :: VersionRangeXFTP
serverVRange = VersionRangeXFTP
supportedFileServerVRange,
      $sel:clientALPN:XFTPClientConfig :: Maybe [SessionId]
clientALPN = [SessionId] -> Maybe [SessionId]
forall a. a -> Maybe a
Just [SessionId]
alpnSupportedXFTPhandshakes
    }

getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> [HostName] -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
getXFTPClient :: TransportSession FileResponse
-> XFTPClientConfig
-> [String]
-> UTCTime
-> (XFTPClient -> IO ())
-> IO (Either XFTPClientError XFTPClient)
getXFTPClient transportSession :: TransportSession FileResponse
transportSession@(Int64
_, ProtoServer FileResponse
srv, Maybe SessionId
_) config :: XFTPClientConfig
config@XFTPClientConfig {Maybe [SessionId]
$sel:clientALPN:XFTPClientConfig :: XFTPClientConfig -> Maybe [SessionId]
clientALPN :: Maybe [SessionId]
clientALPN, NetworkConfig
$sel:xftpNetworkConfig:XFTPClientConfig :: XFTPClientConfig -> NetworkConfig
xftpNetworkConfig :: NetworkConfig
xftpNetworkConfig, VersionRangeXFTP
$sel:serverVRange:XFTPClientConfig :: XFTPClientConfig -> VersionRangeXFTP
serverVRange :: VersionRangeXFTP
serverVRange} [String]
presetDomains UTCTime
proxySessTs XFTPClient -> IO ()
disconnected = ExceptT XFTPClientError IO XFTPClient
-> IO (Either XFTPClientError XFTPClient)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT XFTPClientError IO XFTPClient
 -> IO (Either XFTPClientError XFTPClient))
-> ExceptT XFTPClientError IO XFTPClient
-> IO (Either XFTPClientError XFTPClient)
forall a b. (a -> b) -> a -> b
$ do
  let socksCreds :: Maybe SocksCredentials
socksCreds = NetworkConfig
-> UTCTime
-> TransportSession FileResponse
-> Maybe SocksCredentials
forall msg.
ProtocolTypeI (ProtoType msg) =>
NetworkConfig
-> UTCTime -> TransportSession msg -> Maybe SocksCredentials
clientSocksCredentials NetworkConfig
xftpNetworkConfig UTCTime
proxySessTs TransportSession FileResponse
transportSession
      ProtocolServer SProtocolType (ProtoType FileResponse)
_ NonEmpty TransportHost
host String
port KeyHash
keyHash = ProtoServer FileResponse
srv
      useALPN :: Maybe [SessionId]
useALPN = if NetworkConfig -> [String] -> ProtocolServer 'PXFTP -> Bool
forall (p :: ProtocolType).
NetworkConfig -> [String] -> ProtocolServer p -> Bool
useWebPort NetworkConfig
xftpNetworkConfig [String]
presetDomains ProtoServer FileResponse
ProtocolServer 'PXFTP
srv then [SessionId] -> Maybe [SessionId]
forall a. a -> Maybe a
Just [SessionId
httpALPN11] else Maybe [SessionId]
clientALPN
  TransportHost
useHost <- Either XFTPClientError TransportHost
-> ExceptT XFTPClientError IO TransportHost
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either XFTPClientError TransportHost
 -> ExceptT XFTPClientError IO TransportHost)
-> Either XFTPClientError TransportHost
-> ExceptT XFTPClientError IO TransportHost
forall a b. (a -> b) -> a -> b
$ NetworkConfig
-> NonEmpty TransportHost -> Either XFTPClientError TransportHost
forall err.
NetworkConfig
-> NonEmpty TransportHost
-> Either (ProtocolClientError err) TransportHost
chooseTransportHost NetworkConfig
xftpNetworkConfig NonEmpty TransportHost
host
  let tcConfig :: TransportClientConfig
tcConfig = NetworkConfig
-> NetworkRequestMode
-> TransportHost
-> Bool
-> Maybe [SessionId]
-> TransportClientConfig
transportClientConfig NetworkConfig
xftpNetworkConfig NetworkRequestMode
NRMBackground TransportHost
useHost Bool
False Maybe [SessionId]
useALPN
      http2Config :: HTTP2ClientConfig
http2Config = TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfig
xftpHTTP2Config TransportClientConfig
tcConfig XFTPClientConfig
config
  TVar (Maybe XFTPClient)
clientVar <- Maybe XFTPClient
-> ExceptT XFTPClientError IO (TVar (Maybe XFTPClient))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Maybe XFTPClient
forall a. Maybe a
Nothing
  let usePort :: String
usePort = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
port then String
"443" else String
port
      clientDisconnected :: IO ()
clientDisconnected = TVar (Maybe XFTPClient) -> IO (Maybe XFTPClient)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe XFTPClient)
clientVar IO (Maybe XFTPClient) -> (Maybe XFTPClient -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (XFTPClient -> IO ()) -> Maybe XFTPClient -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XFTPClient -> IO ()
disconnected
  HTTP2Client
http2Client <- (HTTP2ClientError -> XFTPClientError)
-> IO (Either HTTP2ClientError HTTP2Client)
-> ExceptT XFTPClientError IO HTTP2Client
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> IO (Either e a) -> ExceptT e' m a
liftError' HTTP2ClientError -> XFTPClientError
xftpClientError (IO (Either HTTP2ClientError HTTP2Client)
 -> ExceptT XFTPClientError IO HTTP2Client)
-> IO (Either HTTP2ClientError HTTP2Client)
-> ExceptT XFTPClientError IO HTTP2Client
forall a b. (a -> b) -> a -> b
$ Maybe SocksCredentials
-> TransportHost
-> String
-> Maybe KeyHash
-> Maybe CertificateStore
-> HTTP2ClientConfig
-> IO ()
-> IO (Either HTTP2ClientError HTTP2Client)
getVerifiedHTTP2Client Maybe SocksCredentials
socksCreds TransportHost
useHost String
usePort (KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just KeyHash
keyHash) Maybe CertificateStore
forall a. Maybe a
Nothing HTTP2ClientConfig
http2Config IO ()
clientDisconnected
  let HTTP2Client {SessionId
sessionId :: SessionId
$sel:sessionId:HTTP2Client :: HTTP2Client -> SessionId
sessionId, Maybe SessionId
sessionALPN :: Maybe SessionId
$sel:sessionALPN:HTTP2Client :: HTTP2Client -> Maybe SessionId
sessionALPN} = HTTP2Client
http2Client
      v :: Version XFTPVersion
v = Word16 -> Version XFTPVersion
VersionXFTP Word16
1
      thServerVRange :: VersionRangeXFTP
thServerVRange = Version XFTPVersion -> VersionRangeXFTP
forall v. Version v -> VersionRange v
versionToRange Version XFTPVersion
v
      thParams0 :: THandleParams XFTPVersion p
thParams0 = THandleParams {SessionId
sessionId :: SessionId
$sel:sessionId:THandleParams :: SessionId
sessionId, $sel:blockSize:THandleParams :: Int
blockSize = Int
xftpBlockSize, $sel:thVersion:THandleParams :: Version XFTPVersion
thVersion = Version XFTPVersion
v, VersionRangeXFTP
thServerVRange :: VersionRangeXFTP
$sel:thServerVRange:THandleParams :: VersionRangeXFTP
thServerVRange, $sel:thAuth:THandleParams :: Maybe (THandleAuth p)
thAuth = Maybe (THandleAuth p)
forall a. Maybe a
Nothing, $sel:implySessId:THandleParams :: Bool
implySessId = Bool
False, $sel:encryptBlock:THandleParams :: Maybe TSbChainKeys
encryptBlock = Maybe TSbChainKeys
forall a. Maybe a
Nothing, $sel:batch:THandleParams :: Bool
batch = Bool
True, $sel:serviceAuth:THandleParams :: Bool
serviceAuth = Bool
False}
  Text -> ExceptT XFTPClientError IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logDebug (Text -> ExceptT XFTPClientError IO ())
-> Text -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Client negotiated handshake protocol: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe SessionId -> Text
forall a. Show a => a -> Text
tshow Maybe SessionId
sessionALPN
  thParams :: THandleParams XFTPVersion 'TClient
thParams@THandleParams {Version XFTPVersion
$sel:thVersion:THandleParams :: forall v (p :: TransportPeer). THandleParams v p -> Version v
thVersion :: Version XFTPVersion
thVersion} <- case Maybe SessionId
sessionALPN of
    Just SessionId
alpn
      | SessionId
alpn SessionId -> SessionId -> Bool
forall a. Eq a => a -> a -> Bool
== SessionId
xftpALPNv1 Bool -> Bool -> Bool
|| SessionId
alpn SessionId -> SessionId -> Bool
forall a. Eq a => a -> a -> Bool
== SessionId
httpALPN11 ->
          VersionRangeXFTP
-> KeyHash
-> HTTP2Client
-> THandleParams XFTPVersion 'TClient
-> ExceptT XFTPClientError IO (THandleParams XFTPVersion 'TClient)
xftpClientHandshakeV1 VersionRangeXFTP
serverVRange KeyHash
keyHash HTTP2Client
http2Client THandleParams XFTPVersion 'TClient
forall {p :: TransportPeer}. THandleParams XFTPVersion p
thParams0
    Maybe SessionId
_ -> THandleParams XFTPVersion 'TClient
-> ExceptT XFTPClientError IO (THandleParams XFTPVersion 'TClient)
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure THandleParams XFTPVersion 'TClient
forall {p :: TransportPeer}. THandleParams XFTPVersion p
thParams0
  Text -> ExceptT XFTPClientError IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logDebug (Text -> ExceptT XFTPClientError IO ())
-> Text -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Client negotiated protocol: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version XFTPVersion -> Text
forall a. Show a => a -> Text
tshow Version XFTPVersion
thVersion
  let c :: XFTPClient
c = XFTPClient {HTTP2Client
$sel:http2Client:XFTPClient :: HTTP2Client
http2Client :: HTTP2Client
http2Client, THandleParams XFTPVersion 'TClient
$sel:thParams:XFTPClient :: THandleParams XFTPVersion 'TClient
thParams :: THandleParams XFTPVersion 'TClient
thParams, TransportSession FileResponse
$sel:transportSession:XFTPClient :: TransportSession FileResponse
transportSession :: TransportSession FileResponse
transportSession, XFTPClientConfig
$sel:config:XFTPClient :: XFTPClientConfig
config :: XFTPClientConfig
config}
  STM () -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT XFTPClientError IO ())
-> STM () -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe XFTPClient) -> Maybe XFTPClient -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe XFTPClient)
clientVar (Maybe XFTPClient -> STM ()) -> Maybe XFTPClient -> STM ()
forall a b. (a -> b) -> a -> b
$ XFTPClient -> Maybe XFTPClient
forall a. a -> Maybe a
Just XFTPClient
c
  XFTPClient -> ExceptT XFTPClientError IO XFTPClient
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure XFTPClient
c

xftpClientHandshakeV1 :: VersionRangeXFTP -> C.KeyHash -> HTTP2Client -> THandleParamsXFTP 'TClient -> ExceptT XFTPClientError IO (THandleParamsXFTP 'TClient)
xftpClientHandshakeV1 :: VersionRangeXFTP
-> KeyHash
-> HTTP2Client
-> THandleParams XFTPVersion 'TClient
-> ExceptT XFTPClientError IO (THandleParams XFTPVersion 'TClient)
xftpClientHandshakeV1 VersionRangeXFTP
serverVRange keyHash :: KeyHash
keyHash@(C.KeyHash SessionId
kh) c :: HTTP2Client
c@HTTP2Client {SessionId
$sel:sessionId:HTTP2Client :: HTTP2Client -> SessionId
sessionId :: SessionId
sessionId, Maybe APublicVerifyKey
serverKey :: Maybe APublicVerifyKey
$sel:serverKey:HTTP2Client :: HTTP2Client -> Maybe APublicVerifyKey
serverKey} THandleParams XFTPVersion 'TClient
thParams0 = do
  shs :: XFTPServerHandshake
shs@XFTPServerHandshake {$sel:authPubKey:XFTPServerHandshake :: XFTPServerHandshake -> CertChainPubKey
authPubKey = CertChainPubKey
ck} <- ExceptT XFTPClientError IO XFTPServerHandshake
getServerHandshake
  (VersionRangeXFTP
vr, PublicKeyX25519
sk) <- XFTPServerHandshake
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
processServerHandshake XFTPServerHandshake
shs
  let v :: Version XFTPVersion
v = VersionRangeXFTP -> Version XFTPVersion
forall v. VersionRange v -> Version v
maxVersion VersionRangeXFTP
vr
  XFTPClientHandshake -> ExceptT XFTPClientError IO ()
sendClientHandshake XFTPClientHandshake {$sel:xftpVersion:XFTPClientHandshake :: Version XFTPVersion
xftpVersion = Version XFTPVersion
v, KeyHash
keyHash :: KeyHash
$sel:keyHash:XFTPClientHandshake :: KeyHash
keyHash}
  let thAuth :: Maybe (THandleAuth 'TClient)
thAuth = THandleAuth 'TClient -> Maybe (THandleAuth 'TClient)
forall a. a -> Maybe a
Just THAuthClient {$sel:peerServerPubKey:THAuthClient :: PublicKeyX25519
peerServerPubKey = PublicKeyX25519
sk, $sel:peerServerCertKey:THAuthClient :: CertChainPubKey
peerServerCertKey = CertChainPubKey
ck, $sel:clientService:THAuthClient :: Maybe THClientService
clientService = Maybe THClientService
forall a. Maybe a
Nothing, $sel:sessSecret:THAuthClient :: Maybe DhSecretX25519
sessSecret = Maybe DhSecretX25519
forall a. Maybe a
Nothing}
  THandleParams XFTPVersion 'TClient
-> ExceptT XFTPClientError IO (THandleParams XFTPVersion 'TClient)
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure THandleParams XFTPVersion 'TClient
thParams0 {thAuth, thVersion = v, thServerVRange = vr}
  where
    getServerHandshake :: ExceptT XFTPClientError IO XFTPServerHandshake
    getServerHandshake :: ExceptT XFTPClientError IO XFTPServerHandshake
getServerHandshake = do
      let helloReq :: Request
helloReq = SessionId -> SessionId -> RequestHeaders -> Request
H.requestNoBody SessionId
"POST" SessionId
"/" []
      HTTP2Response {$sel:respBody:HTTP2Response :: HTTP2Response -> HTTP2Body
respBody = HTTP2Body {bodyHead :: HTTP2Body -> SessionId
bodyHead = SessionId
shsBody}} <-
        (HTTP2ClientError -> XFTPClientError)
-> IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT XFTPClientError IO HTTP2Response
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> IO (Either e a) -> ExceptT e' m a
liftError' HTTP2ClientError -> XFTPClientError
xftpClientError (IO (Either HTTP2ClientError HTTP2Response)
 -> ExceptT XFTPClientError IO HTTP2Response)
-> IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT XFTPClientError IO HTTP2Response
forall a b. (a -> b) -> a -> b
$ HTTP2Client
-> Request
-> Maybe Int
-> IO (Either HTTP2ClientError HTTP2Response)
sendRequest HTTP2Client
c Request
helloReq Maybe Int
forall a. Maybe a
Nothing
      TransportError
-> Either String XFTPServerHandshake
-> ExceptT XFTPClientError IO XFTPServerHandshake
forall {m :: * -> *} {e} {a} {err}.
MonadIO m =>
TransportError
-> Either e a -> ExceptT (ProtocolClientError err) m a
liftTransportErr (HandshakeError -> TransportError
TEHandshake HandshakeError
PARSE) (Either String XFTPServerHandshake
 -> ExceptT XFTPClientError IO XFTPServerHandshake)
-> (SessionId -> Either String XFTPServerHandshake)
-> SessionId
-> ExceptT XFTPClientError IO XFTPServerHandshake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId -> Either String XFTPServerHandshake
forall a. Encoding a => SessionId -> Either String a
smpDecode (SessionId -> ExceptT XFTPClientError IO XFTPServerHandshake)
-> ExceptT XFTPClientError IO SessionId
-> ExceptT XFTPClientError IO XFTPServerHandshake
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TransportError
-> Either CryptoError SessionId
-> ExceptT XFTPClientError IO SessionId
forall {m :: * -> *} {e} {a} {err}.
MonadIO m =>
TransportError
-> Either e a -> ExceptT (ProtocolClientError err) m a
liftTransportErr TransportError
TEBadBlock (SessionId -> Either CryptoError SessionId
C.unPad SessionId
shsBody)
    processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionRangeXFTP, C.PublicKeyX25519)
    processServerHandshake :: XFTPServerHandshake
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
processServerHandshake XFTPServerHandshake {VersionRangeXFTP
xftpVersionRange :: VersionRangeXFTP
$sel:xftpVersionRange:XFTPServerHandshake :: XFTPServerHandshake -> VersionRangeXFTP
xftpVersionRange, $sel:sessionId:XFTPServerHandshake :: XFTPServerHandshake -> SessionId
sessionId = SessionId
serverSessId, $sel:authPubKey:XFTPServerHandshake :: XFTPServerHandshake -> CertChainPubKey
authPubKey = CertChainPubKey
serverAuth} = do
      Bool
-> ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SessionId
sessionId SessionId -> SessionId -> Bool
forall a. Eq a => a -> a -> Bool
== SessionId
serverSessId) (ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ TransportError -> XFTPClientError
forall err. TransportError -> ProtocolClientError err
PCETransportError TransportError
TEBadSession
      case VersionRangeXFTP
xftpVersionRange VersionRangeXFTP
-> VersionRangeXFTP -> Maybe (Compatible VersionRangeXFTP)
forall v a.
VersionRangeI v a =>
a -> VersionRange v -> Maybe (Compatible a)
`compatibleVRange` VersionRangeXFTP
serverVRange of
        Maybe (Compatible VersionRangeXFTP)
Nothing -> XFTPClientError
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError
 -> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519))
-> XFTPClientError
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
forall a b. (a -> b) -> a -> b
$ TransportError -> XFTPClientError
forall err. TransportError -> ProtocolClientError err
PCETransportError TransportError
TEVersion
        Just (Compatible VersionRangeXFTP
vr) ->
          (PublicKeyX25519 -> (VersionRangeXFTP, PublicKeyX25519))
-> ExceptT XFTPClientError IO PublicKeyX25519
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
forall a b.
(a -> b)
-> ExceptT XFTPClientError IO a -> ExceptT XFTPClientError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VersionRangeXFTP
vr,) (ExceptT XFTPClientError IO PublicKeyX25519
 -> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519))
-> (Either String PublicKeyX25519
    -> ExceptT XFTPClientError IO PublicKeyX25519)
-> Either String PublicKeyX25519
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError
-> Either String PublicKeyX25519
-> ExceptT XFTPClientError IO PublicKeyX25519
forall {m :: * -> *} {e} {a} {err}.
MonadIO m =>
TransportError
-> Either e a -> ExceptT (ProtocolClientError err) m a
liftTransportErr (HandshakeError -> TransportError
TEHandshake HandshakeError
BAD_AUTH) (Either String PublicKeyX25519
 -> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519))
-> Either String PublicKeyX25519
-> ExceptT XFTPClientError IO (VersionRangeXFTP, PublicKeyX25519)
forall a b. (a -> b) -> a -> b
$ do
            let CertChainPubKey (X.CertificateChain [SignedExact Certificate]
cert) SignedExact PubKey
exact = CertChainPubKey
serverAuth
            case [SignedExact Certificate]
cert of
              [SignedExact Certificate
_leaf, SignedExact Certificate
ca] | SessionId -> Fingerprint
XV.Fingerprint SessionId
kh Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== SignedExact Certificate -> HashALG -> Fingerprint
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> HashALG -> Fingerprint
XV.getFingerprint SignedExact Certificate
ca HashALG
X.HashSHA256 -> () -> Either String ()
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              [SignedExact Certificate]
_ -> String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"bad certificate"
            PubKey
pubKey <- Either String PubKey
-> (APublicVerifyKey -> Either String PubKey)
-> Maybe APublicVerifyKey
-> Either String PubKey
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String PubKey
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"bad server key type") (APublicVerifyKey -> SignedExact PubKey -> Either String PubKey
forall o.
(ASN1Object o, Eq o, Show o) =>
APublicVerifyKey -> SignedExact o -> Either String o
`C.verifyX509` SignedExact PubKey
exact) Maybe APublicVerifyKey
serverKey
            PubKey -> Either String PublicKeyX25519
forall k. CryptoPublicKey k => PubKey -> Either String k
C.x509ToPublic' PubKey
pubKey
    sendClientHandshake :: XFTPClientHandshake -> ExceptT XFTPClientError IO ()
    sendClientHandshake :: XFTPClientHandshake -> ExceptT XFTPClientError IO ()
sendClientHandshake XFTPClientHandshake
chs = do
      SessionId
chs' <- TransportError
-> Either CryptoError SessionId
-> ExceptT XFTPClientError IO SessionId
forall {m :: * -> *} {e} {a} {err}.
MonadIO m =>
TransportError
-> Either e a -> ExceptT (ProtocolClientError err) m a
liftTransportErr TransportError
TELargeMsg (Either CryptoError SessionId
 -> ExceptT XFTPClientError IO SessionId)
-> Either CryptoError SessionId
-> ExceptT XFTPClientError IO SessionId
forall a b. (a -> b) -> a -> b
$ SessionId -> Int -> Either CryptoError SessionId
C.pad (XFTPClientHandshake -> SessionId
forall a. Encoding a => a -> SessionId
smpEncode XFTPClientHandshake
chs) Int
xftpBlockSize
      let chsReq :: Request
chsReq = SessionId -> SessionId -> RequestHeaders -> Builder -> Request
H.requestBuilder SessionId
"POST" SessionId
"/" [] (Builder -> Request) -> Builder -> Request
forall a b. (a -> b) -> a -> b
$ SessionId -> Builder
byteString SessionId
chs'
      HTTP2Response {$sel:respBody:HTTP2Response :: HTTP2Response -> HTTP2Body
respBody = HTTP2Body {SessionId
bodyHead :: HTTP2Body -> SessionId
bodyHead :: SessionId
bodyHead}} <- (HTTP2ClientError -> XFTPClientError)
-> IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT XFTPClientError IO HTTP2Response
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> IO (Either e a) -> ExceptT e' m a
liftError' HTTP2ClientError -> XFTPClientError
xftpClientError (IO (Either HTTP2ClientError HTTP2Response)
 -> ExceptT XFTPClientError IO HTTP2Response)
-> IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT XFTPClientError IO HTTP2Response
forall a b. (a -> b) -> a -> b
$ HTTP2Client
-> Request
-> Maybe Int
-> IO (Either HTTP2ClientError HTTP2Response)
sendRequest HTTP2Client
c Request
chsReq Maybe Int
forall a. Maybe a
Nothing
      Bool
-> ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SessionId -> Bool
B.null SessionId
bodyHead) (ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ TransportError -> XFTPClientError
forall err. TransportError -> ProtocolClientError err
PCETransportError TransportError
TEBadBlock
    liftTransportErr :: TransportError
-> Either e a -> ExceptT (ProtocolClientError err) m a
liftTransportErr TransportError
e = (e -> ProtocolClientError err)
-> Either e a -> ExceptT (ProtocolClientError err) m a
forall (m :: * -> *) e e' a.
MonadIO m =>
(e -> e') -> Either e a -> ExceptT e' m a
liftEitherWith (ProtocolClientError err -> e -> ProtocolClientError err
forall a b. a -> b -> a
const (ProtocolClientError err -> e -> ProtocolClientError err)
-> ProtocolClientError err -> e -> ProtocolClientError err
forall a b. (a -> b) -> a -> b
$ TransportError -> ProtocolClientError err
forall err. TransportError -> ProtocolClientError err
PCETransportError TransportError
e)

closeXFTPClient :: XFTPClient -> IO ()
closeXFTPClient :: XFTPClient -> IO ()
closeXFTPClient XFTPClient {HTTP2Client
$sel:http2Client:XFTPClient :: XFTPClient -> HTTP2Client
http2Client :: HTTP2Client
http2Client} = HTTP2Client -> IO ()
closeHTTP2Client HTTP2Client
http2Client

xftpClientServer :: XFTPClient -> String
xftpClientServer :: XFTPClient -> String
xftpClientServer = SessionId -> String
B.unpack (SessionId -> String)
-> (XFTPClient -> SessionId) -> XFTPClient -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolServer 'PXFTP -> SessionId
forall a. StrEncoding a => a -> SessionId
strEncode (ProtocolServer 'PXFTP -> SessionId)
-> (XFTPClient -> ProtocolServer 'PXFTP) -> XFTPClient -> SessionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, ProtocolServer 'PXFTP, Maybe SessionId)
-> ProtocolServer 'PXFTP
forall {a} {b} {c}. (a, b, c) -> b
snd3 ((Int64, ProtocolServer 'PXFTP, Maybe SessionId)
 -> ProtocolServer 'PXFTP)
-> (XFTPClient -> (Int64, ProtocolServer 'PXFTP, Maybe SessionId))
-> XFTPClient
-> ProtocolServer 'PXFTP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFTPClient -> TransportSession FileResponse
XFTPClient -> (Int64, ProtocolServer 'PXFTP, Maybe SessionId)
transportSession
  where
    snd3 :: (a, b, c) -> b
snd3 (a
_, b
s, c
_) = b
s

xftpTransportHost :: XFTPClient -> TransportHost
xftpTransportHost :: XFTPClient -> TransportHost
xftpTransportHost XFTPClient {$sel:http2Client:XFTPClient :: XFTPClient -> HTTP2Client
http2Client = HTTP2Client {$sel:client_:HTTP2Client :: HTTP2Client -> HClient
client_ = HClient {TransportHost
host :: TransportHost
$sel:host:HClient :: HClient -> TransportHost
host}}} = TransportHost
host

xftpHTTP2Config :: TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfig
xftpHTTP2Config :: TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfig
xftpHTTP2Config TransportClientConfig
transportConfig XFTPClientConfig {$sel:xftpNetworkConfig:XFTPClientConfig :: XFTPClientConfig -> NetworkConfig
xftpNetworkConfig = NetworkConfig {NetworkTimeout
tcpConnectTimeout :: NetworkTimeout
$sel:tcpConnectTimeout:NetworkConfig :: NetworkConfig -> NetworkTimeout
tcpConnectTimeout}} =
  HTTP2ClientConfig
defaultHTTP2ClientConfig
    { bodyHeadSize = xftpBlockSize,
      suportedTLSParams = defaultSupportedParams,
      connTimeout = netTimeoutInt tcpConnectTimeout NRMBackground,
      transportConfig
    }

xftpClientError :: HTTP2ClientError -> XFTPClientError
xftpClientError :: HTTP2ClientError -> XFTPClientError
xftpClientError = \case
  HTTP2ClientError
HCResponseTimeout -> XFTPClientError
forall err. ProtocolClientError err
PCEResponseTimeout
  HCNetworkError NetworkError
e -> NetworkError -> XFTPClientError
forall err. NetworkError -> ProtocolClientError err
PCENetworkError NetworkError
e
  HCIOError IOException
e -> IOException -> XFTPClientError
forall err. IOException -> ProtocolClientError err
PCEIOError IOException
e

sendXFTPCommand :: forall p. FilePartyI p => XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> FileCommand p -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand :: forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand c :: XFTPClient
c@XFTPClient {THandleParams XFTPVersion 'TClient
$sel:thParams:XFTPClient :: XFTPClient -> THandleParams XFTPVersion 'TClient
thParams :: THandleParams XFTPVersion 'TClient
thParams} APrivateAuthKey
pKey XFTPFileId
fId FileCommand p
cmd Maybe XFTPChunkSpec
chunkSpec_ = do
  -- TODO random corrId
  let corrIdUsedAsNonce :: CorrId
corrIdUsedAsNonce = CorrId
""
  SessionId
t <-
    Either XFTPClientError SessionId
-> ExceptT XFTPClientError IO SessionId
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either XFTPClientError SessionId
 -> ExceptT XFTPClientError IO SessionId)
-> (Either TransportError SessionId
    -> Either XFTPClientError SessionId)
-> Either TransportError SessionId
-> ExceptT XFTPClientError IO SessionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransportError -> XFTPClientError)
-> Either TransportError SessionId
-> Either XFTPClientError SessionId
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 -> XFTPClientError
forall err. TransportError -> ProtocolClientError err
PCETransportError (Either TransportError SessionId
 -> ExceptT XFTPClientError IO SessionId)
-> Either TransportError SessionId
-> ExceptT XFTPClientError IO SessionId
forall a b. (a -> b) -> a -> b
$
      THandleParams XFTPVersion 'TClient
-> APrivateAuthKey
-> Transmission FileCmd
-> Either TransportError SessionId
forall c.
ProtocolEncoding XFTPVersion XFTPErrorType c =>
THandleParams XFTPVersion 'TClient
-> APrivateAuthKey
-> Transmission c
-> Either TransportError SessionId
xftpEncodeAuthTransmission THandleParams XFTPVersion 'TClient
thParams APrivateAuthKey
pKey (CorrId
corrIdUsedAsNonce, XFTPFileId
fId, SFileParty p -> FileCommand p -> FileCmd
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommand p -> FileCmd
FileCmd (forall (p :: FileParty). FilePartyI p => SFileParty p
sFileParty @p) FileCommand p
cmd)
  XFTPClient
-> SessionId
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPTransmission XFTPClient
c SessionId
t Maybe XFTPChunkSpec
chunkSpec_

sendXFTPTransmission :: XFTPClient -> ByteString -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPTransmission :: XFTPClient
-> SessionId
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPTransmission XFTPClient {XFTPClientConfig
$sel:config:XFTPClient :: XFTPClient -> XFTPClientConfig
config :: XFTPClientConfig
config, THandleParams XFTPVersion 'TClient
$sel:thParams:XFTPClient :: XFTPClient -> THandleParams XFTPVersion 'TClient
thParams :: THandleParams XFTPVersion 'TClient
thParams, HTTP2Client
$sel:http2Client:XFTPClient :: XFTPClient -> HTTP2Client
http2Client :: HTTP2Client
http2Client} SessionId
t Maybe XFTPChunkSpec
chunkSpec_ = do
  let req :: Request
req = SessionId
-> SessionId
-> RequestHeaders
-> ((Builder -> IO ()) -> IO () -> IO ())
-> Request
H.requestStreaming SessionId
N.methodPost SessionId
"/" [] (Builder -> IO ()) -> IO () -> IO ()
streamBody
      reqTimeout :: Int
reqTimeout = XFTPClientConfig -> Maybe Word32 -> Int
xftpReqTimeout XFTPClientConfig
config (Maybe Word32 -> Int) -> Maybe Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (\XFTPChunkSpec {Word32
$sel:chunkSize:XFTPChunkSpec :: XFTPChunkSpec -> Word32
chunkSize :: Word32
chunkSize} -> Word32
chunkSize) (XFTPChunkSpec -> Word32) -> Maybe XFTPChunkSpec -> Maybe Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe XFTPChunkSpec
chunkSpec_
  HTTP2Response {$sel:respBody:HTTP2Response :: HTTP2Response -> HTTP2Body
respBody = body :: HTTP2Body
body@HTTP2Body {SessionId
bodyHead :: HTTP2Body -> SessionId
bodyHead :: SessionId
bodyHead}} <- (HTTP2ClientError -> XFTPClientError)
-> ExceptT HTTP2ClientError IO HTTP2Response
-> ExceptT XFTPClientError IO HTTP2Response
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HTTP2ClientError -> XFTPClientError
xftpClientError (ExceptT HTTP2ClientError IO HTTP2Response
 -> ExceptT XFTPClientError IO HTTP2Response)
-> (IO (Either HTTP2ClientError HTTP2Response)
    -> ExceptT HTTP2ClientError IO HTTP2Response)
-> IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT XFTPClientError IO HTTP2Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT HTTP2ClientError IO HTTP2Response
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either HTTP2ClientError HTTP2Response)
 -> ExceptT XFTPClientError IO HTTP2Response)
-> IO (Either HTTP2ClientError HTTP2Response)
-> ExceptT XFTPClientError IO HTTP2Response
forall a b. (a -> b) -> a -> b
$ HTTP2Client
-> Request
-> Maybe Int
-> IO (Either HTTP2ClientError HTTP2Response)
sendRequest HTTP2Client
http2Client Request
req (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
reqTimeout)
  Bool
-> ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SessionId -> Int
B.length SessionId
bodyHead Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
xftpBlockSize) (ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO () -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> XFTPClientError
forall err. err -> ProtocolClientError err
PCEResponseError XFTPErrorType
BLOCK
  -- TODO validate that the file ID is the same as in the request?
  (CorrId
_, XFTPFileId
_fId, Either XFTPErrorType FileResponse
respOrErr) <- Either
  XFTPClientError
  (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
-> ExceptT
     XFTPClientError
     IO
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either
   XFTPClientError
   (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
 -> ExceptT
      XFTPClientError
      IO
      (CorrId, XFTPFileId, Either XFTPErrorType FileResponse))
-> Either
     XFTPClientError
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
-> ExceptT
     XFTPClientError
     IO
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
forall a b. (a -> b) -> a -> b
$ (XFTPErrorType -> XFTPClientError)
-> Either
     XFTPErrorType
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
-> Either
     XFTPClientError
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
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 -> XFTPClientError
forall err. err -> ProtocolClientError err
PCEResponseError (Either
   XFTPErrorType
   (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
 -> Either
      XFTPClientError
      (CorrId, XFTPFileId, Either XFTPErrorType FileResponse))
-> Either
     XFTPErrorType
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
-> Either
     XFTPClientError
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
forall a b. (a -> b) -> a -> b
$ THandleParams XFTPVersion 'TClient
-> SessionId
-> Either
     XFTPErrorType
     (CorrId, XFTPFileId, Either XFTPErrorType FileResponse)
xftpDecodeTClient THandleParams XFTPVersion 'TClient
thParams SessionId
bodyHead
  case Either XFTPErrorType FileResponse
respOrErr of
    Right FileResponse
r -> case FileResponse -> Maybe XFTPErrorType
forall v err msg. Protocol v err msg => msg -> Maybe err
protocolError FileResponse
r of
      Just XFTPErrorType
e -> XFTPClientError
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError
 -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body))
-> XFTPClientError
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> XFTPClientError
forall err. err -> ProtocolClientError err
PCEProtocolError XFTPErrorType
e
      Maybe XFTPErrorType
_ -> (FileResponse, HTTP2Body)
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileResponse
r, HTTP2Body
body)
    Left XFTPErrorType
e -> XFTPClientError
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError
 -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body))
-> XFTPClientError
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> XFTPClientError
forall err. err -> ProtocolClientError err
PCEResponseError XFTPErrorType
e
  where
    streamBody :: (Builder -> IO ()) -> IO () -> IO ()
    streamBody :: (Builder -> IO ()) -> IO () -> IO ()
streamBody Builder -> IO ()
send IO ()
done = do
      Builder -> IO ()
send (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ SessionId -> Builder
byteString SessionId
t
      Maybe XFTPChunkSpec -> (XFTPChunkSpec -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe XFTPChunkSpec
chunkSpec_ ((XFTPChunkSpec -> IO ()) -> IO ())
-> (XFTPChunkSpec -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XFTPChunkSpec {String
$sel:filePath:XFTPChunkSpec :: XFTPChunkSpec -> String
filePath :: String
filePath, Int64
$sel:chunkOffset:XFTPChunkSpec :: XFTPChunkSpec -> Int64
chunkOffset :: Int64
chunkOffset, Word32
$sel:chunkSize:XFTPChunkSpec :: XFTPChunkSpec -> Word32
chunkSize :: Word32
chunkSize} ->
        String -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withFile String
filePath IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
          Handle -> SeekMode -> Integer -> IO ()
forall (m :: * -> *).
MonadIO m =>
Handle -> SeekMode -> Integer -> m ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
chunkOffset
          Handle -> (Builder -> IO ()) -> Word32 -> IO ()
hSendFile Handle
h Builder -> IO ()
send Word32
chunkSize
      IO ()
done

createXFTPChunk ::
  XFTPClient ->
  C.APrivateAuthKey ->
  FileInfo ->
  NonEmpty C.APublicAuthKey ->
  Maybe BasicAuth ->
  ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
createXFTPChunk :: XFTPClient
-> APrivateAuthKey
-> FileInfo
-> NonEmpty APublicAuthKey
-> Maybe BasicAuth
-> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId)
createXFTPChunk XFTPClient
c APrivateAuthKey
spKey FileInfo
file NonEmpty APublicAuthKey
rcps Maybe BasicAuth
auth_ =
  XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand 'FSender
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand XFTPClient
c APrivateAuthKey
spKey XFTPFileId
NoEntity (FileInfo
-> NonEmpty APublicAuthKey
-> Maybe BasicAuth
-> FileCommand 'FSender
FNEW FileInfo
file NonEmpty APublicAuthKey
rcps Maybe BasicAuth
auth_) Maybe XFTPChunkSpec
forall a. Maybe a
Nothing ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-> ((FileResponse, HTTP2Body)
    -> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId))
-> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId)
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (FRSndIds XFTPFileId
sId NonEmpty XFTPFileId
rIds, HTTP2Body
body) -> HTTP2Body
-> (XFTPFileId, NonEmpty XFTPFileId)
-> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId)
forall a. HTTP2Body -> a -> ExceptT XFTPClientError IO a
noFile HTTP2Body
body (XFTPFileId
sId, NonEmpty XFTPFileId
rIds)
    (FileResponse
r, HTTP2Body
_) -> XFTPClientError
-> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError
 -> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId))
-> XFTPClientError
-> ExceptT XFTPClientError IO (XFTPFileId, NonEmpty XFTPFileId)
forall a b. (a -> b) -> a -> b
$ FileResponse -> XFTPClientError
forall r err. Show r => r -> ProtocolClientError err
unexpectedResponse FileResponse
r

addXFTPRecipients :: XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> NonEmpty C.APublicAuthKey -> ExceptT XFTPClientError IO (NonEmpty RecipientId)
addXFTPRecipients :: XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> NonEmpty APublicAuthKey
-> ExceptT XFTPClientError IO (NonEmpty XFTPFileId)
addXFTPRecipients XFTPClient
c APrivateAuthKey
spKey XFTPFileId
fId NonEmpty APublicAuthKey
rcps =
  XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand 'FSender
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand XFTPClient
c APrivateAuthKey
spKey XFTPFileId
fId (NonEmpty APublicAuthKey -> FileCommand 'FSender
FADD NonEmpty APublicAuthKey
rcps) Maybe XFTPChunkSpec
forall a. Maybe a
Nothing ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-> ((FileResponse, HTTP2Body)
    -> ExceptT XFTPClientError IO (NonEmpty XFTPFileId))
-> ExceptT XFTPClientError IO (NonEmpty XFTPFileId)
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (FRRcvIds NonEmpty XFTPFileId
rIds, HTTP2Body
body) -> HTTP2Body
-> NonEmpty XFTPFileId
-> ExceptT XFTPClientError IO (NonEmpty XFTPFileId)
forall a. HTTP2Body -> a -> ExceptT XFTPClientError IO a
noFile HTTP2Body
body NonEmpty XFTPFileId
rIds
    (FileResponse
r, HTTP2Body
_) -> XFTPClientError -> ExceptT XFTPClientError IO (NonEmpty XFTPFileId)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError
 -> ExceptT XFTPClientError IO (NonEmpty XFTPFileId))
-> XFTPClientError
-> ExceptT XFTPClientError IO (NonEmpty XFTPFileId)
forall a b. (a -> b) -> a -> b
$ FileResponse -> XFTPClientError
forall r err. Show r => r -> ProtocolClientError err
unexpectedResponse FileResponse
r

uploadXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> XFTPChunkSpec -> ExceptT XFTPClientError IO ()
uploadXFTPChunk :: XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> XFTPChunkSpec
-> ExceptT XFTPClientError IO ()
uploadXFTPChunk XFTPClient
c APrivateAuthKey
spKey XFTPFileId
fId XFTPChunkSpec
chunkSpec =
  XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand 'FSender
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand XFTPClient
c APrivateAuthKey
spKey XFTPFileId
fId FileCommand 'FSender
FPUT (XFTPChunkSpec -> Maybe XFTPChunkSpec
forall a. a -> Maybe a
Just XFTPChunkSpec
chunkSpec) ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-> ((FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO ()
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ()
okResponse

downloadXFTPChunk :: TVar ChaChaDRG -> XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
downloadXFTPChunk :: TVar ChaChaDRG
-> XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> XFTPRcvChunkSpec
-> ExceptT XFTPClientError IO ()
downloadXFTPChunk TVar ChaChaDRG
g c :: XFTPClient
c@XFTPClient {XFTPClientConfig
$sel:config:XFTPClient :: XFTPClient -> XFTPClientConfig
config :: XFTPClientConfig
config} APrivateAuthKey
rpKey XFTPFileId
fId chunkSpec :: XFTPRcvChunkSpec
chunkSpec@XFTPRcvChunkSpec {String
filePath :: String
$sel:filePath:XFTPRcvChunkSpec :: XFTPRcvChunkSpec -> String
filePath, Word32
chunkSize :: Word32
$sel:chunkSize:XFTPRcvChunkSpec :: XFTPRcvChunkSpec -> Word32
chunkSize} = do
  (PublicKeyX25519
rDhKey, PrivateKey 'X25519
rpDhKey) <- STM (PublicKeyX25519, PrivateKey 'X25519)
-> ExceptT XFTPClientError IO (PublicKeyX25519, PrivateKey 'X25519)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (PublicKeyX25519, PrivateKey 'X25519)
 -> ExceptT
      XFTPClientError IO (PublicKeyX25519, PrivateKey 'X25519))
-> STM (PublicKeyX25519, PrivateKey 'X25519)
-> ExceptT XFTPClientError IO (PublicKeyX25519, PrivateKey 'X25519)
forall a b. (a -> b) -> a -> b
$ TVar ChaChaDRG -> STM (KeyPair 'X25519)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
C.generateKeyPair TVar ChaChaDRG
g
  XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand 'FRecipient
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand XFTPClient
c APrivateAuthKey
rpKey XFTPFileId
fId (PublicKeyX25519 -> FileCommand 'FRecipient
FGET PublicKeyX25519
rDhKey) Maybe XFTPChunkSpec
forall a. Maybe a
Nothing ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-> ((FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO ()
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (FRFile PublicKeyX25519
sDhKey CbNonce
cbNonce, HTTP2Body {bodyHead :: HTTP2Body -> SessionId
bodyHead = SessionId
_bg, bodySize :: HTTP2Body -> Int
bodySize = Int
_bs, Maybe (Int -> IO SessionId)
bodyPart :: Maybe (Int -> IO SessionId)
bodyPart :: HTTP2Body -> Maybe (Int -> IO SessionId)
bodyPart}) -> case Maybe (Int -> IO SessionId)
bodyPart of
      -- TODO atm bodySize is set to 0, so chunkSize will be incorrect - validate once set
      Just Int -> IO SessionId
chunkPart -> do
        let dhSecret :: DhSecretX25519
dhSecret = PublicKeyX25519 -> PrivateKey 'X25519 -> DhSecretX25519
forall (a :: Algorithm).
DhAlgorithm a =>
PublicKey a -> PrivateKey a -> DhSecret a
C.dh' PublicKeyX25519
sDhKey PrivateKey 'X25519
rpDhKey
        SbState
cbState <- Either XFTPClientError SbState
-> ExceptT XFTPClientError IO SbState
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either XFTPClientError SbState
 -> ExceptT XFTPClientError IO SbState)
-> (Either CryptoError SbState -> Either XFTPClientError SbState)
-> Either CryptoError SbState
-> ExceptT XFTPClientError IO SbState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CryptoError -> XFTPClientError)
-> Either CryptoError SbState -> Either XFTPClientError SbState
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 CryptoError -> XFTPClientError
forall err. CryptoError -> ProtocolClientError err
PCECryptoError (Either CryptoError SbState -> ExceptT XFTPClientError IO SbState)
-> Either CryptoError SbState -> ExceptT XFTPClientError IO SbState
forall a b. (a -> b) -> a -> b
$ DhSecretX25519 -> CbNonce -> Either CryptoError SbState
LC.cbInit DhSecretX25519
dhSecret CbNonce
cbNonce
        let t :: Int
t = XFTPClientConfig -> Word32 -> Int
chunkTimeout XFTPClientConfig
config Word32
chunkSize
        IO (Either XFTPClientError (Maybe ()))
-> ExceptT XFTPClientError IO (Maybe ())
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Maybe (Either XFTPClientError ())
-> Either XFTPClientError (Maybe ())
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence (Maybe (Either XFTPClientError ())
 -> Either XFTPClientError (Maybe ()))
-> IO (Maybe (Either XFTPClientError ()))
-> IO (Either XFTPClientError (Maybe ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
t Int
-> IO (Either XFTPClientError ())
-> IO (Maybe (Either XFTPClientError ()))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
`timeout` (SbState -> IO (Either XFTPClientError ())
download SbState
cbState IO (Either XFTPClientError ())
-> [Handler IO (Either XFTPClientError ())]
-> IO (Either XFTPClientError ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [Handler IO (Either XFTPClientError ())]
forall {err} {b}. [Handler IO (Either (ProtocolClientError err) b)]
errors))) ExceptT XFTPClientError IO (Maybe ())
-> (Maybe () -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO ()
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT XFTPClientError IO ()
-> (() -> ExceptT XFTPClientError IO ())
-> Maybe ()
-> ExceptT XFTPClientError IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE XFTPClientError
forall err. ProtocolClientError err
PCEResponseTimeout) () -> ExceptT XFTPClientError IO ()
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        where
          errors :: [Handler IO (Either (ProtocolClientError err) b)]
errors =
            [ (HTTP2Error -> IO (Either (ProtocolClientError err) b))
-> Handler IO (Either (ProtocolClientError err) b)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((HTTP2Error -> IO (Either (ProtocolClientError err) b))
 -> Handler IO (Either (ProtocolClientError err) b))
-> (HTTP2Error -> IO (Either (ProtocolClientError err) b))
-> Handler IO (Either (ProtocolClientError err) b)
forall a b. (a -> b) -> a -> b
$ \(HTTP2Error
e :: H.HTTP2Error) -> Either (ProtocolClientError err) b
-> IO (Either (ProtocolClientError err) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ProtocolClientError err) b
 -> IO (Either (ProtocolClientError err) b))
-> Either (ProtocolClientError err) b
-> IO (Either (ProtocolClientError err) b)
forall a b. (a -> b) -> a -> b
$ ProtocolClientError err -> Either (ProtocolClientError err) b
forall a b. a -> Either a b
Left (ProtocolClientError err -> Either (ProtocolClientError err) b)
-> ProtocolClientError err -> Either (ProtocolClientError err) b
forall a b. (a -> b) -> a -> b
$ NetworkError -> ProtocolClientError err
forall err. NetworkError -> ProtocolClientError err
PCENetworkError (NetworkError -> ProtocolClientError err)
-> NetworkError -> ProtocolClientError err
forall a b. (a -> b) -> a -> b
$ String -> NetworkError
NEConnectError (String -> NetworkError) -> String -> NetworkError
forall a b. (a -> b) -> a -> b
$ HTTP2Error -> String
forall e. Exception e => e -> String
displayException HTTP2Error
e,
              (IOException -> IO (Either (ProtocolClientError err) b))
-> Handler IO (Either (ProtocolClientError err) b)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((IOException -> IO (Either (ProtocolClientError err) b))
 -> Handler IO (Either (ProtocolClientError err) b))
-> (IOException -> IO (Either (ProtocolClientError err) b))
-> Handler IO (Either (ProtocolClientError err) b)
forall a b. (a -> b) -> a -> b
$ \(IOException
e :: IOException) -> Either (ProtocolClientError err) b
-> IO (Either (ProtocolClientError err) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ProtocolClientError err) b
 -> IO (Either (ProtocolClientError err) b))
-> Either (ProtocolClientError err) b
-> IO (Either (ProtocolClientError err) b)
forall a b. (a -> b) -> a -> b
$ ProtocolClientError err -> Either (ProtocolClientError err) b
forall a b. a -> Either a b
Left (ProtocolClientError err -> Either (ProtocolClientError err) b)
-> ProtocolClientError err -> Either (ProtocolClientError err) b
forall a b. (a -> b) -> a -> b
$ IOException -> ProtocolClientError err
forall err. IOException -> ProtocolClientError err
PCEIOError IOException
e,
              (SomeException -> IO (Either (ProtocolClientError err) b))
-> Handler IO (Either (ProtocolClientError err) b)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> IO (Either (ProtocolClientError err) b))
 -> Handler IO (Either (ProtocolClientError err) b))
-> (SomeException -> IO (Either (ProtocolClientError err) b))
-> Handler IO (Either (ProtocolClientError err) b)
forall a b. (a -> b) -> a -> b
$ \(SomeException
e :: SomeException) -> Either (ProtocolClientError err) b
-> IO (Either (ProtocolClientError err) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ProtocolClientError err) b
 -> IO (Either (ProtocolClientError err) b))
-> Either (ProtocolClientError err) b
-> IO (Either (ProtocolClientError err) b)
forall a b. (a -> b) -> a -> b
$ ProtocolClientError err -> Either (ProtocolClientError err) b
forall a b. a -> Either a b
Left (ProtocolClientError err -> Either (ProtocolClientError err) b)
-> ProtocolClientError err -> Either (ProtocolClientError err) b
forall a b. (a -> b) -> a -> b
$ NetworkError -> ProtocolClientError err
forall err. NetworkError -> ProtocolClientError err
PCENetworkError (NetworkError -> ProtocolClientError err)
-> NetworkError -> ProtocolClientError err
forall a b. (a -> b) -> a -> b
$ SomeException -> NetworkError
toNetworkError SomeException
e
            ]
          download :: SbState -> IO (Either XFTPClientError ())
download SbState
cbState =
            ExceptT XFTPClientError IO () -> IO (Either XFTPClientError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT XFTPClientError IO () -> IO (Either XFTPClientError ()))
-> (ExceptT XFTPErrorType IO () -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPErrorType IO ()
-> IO (Either XFTPClientError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XFTPErrorType -> XFTPClientError)
-> ExceptT XFTPErrorType IO () -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT XFTPErrorType -> XFTPClientError
forall err. err -> ProtocolClientError err
PCEResponseError (ExceptT XFTPErrorType IO () -> IO (Either XFTPClientError ()))
-> ExceptT XFTPErrorType IO () -> IO (Either XFTPClientError ())
forall a b. (a -> b) -> a -> b
$
              (Int -> IO SessionId)
-> SbState -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
receiveEncFile Int -> IO SessionId
chunkPart SbState
cbState XFTPRcvChunkSpec
chunkSpec ExceptT XFTPErrorType IO ()
-> (XFTPErrorType -> ExceptT XFTPErrorType IO ())
-> ExceptT XFTPErrorType IO ()
forall a.
ExceptT XFTPErrorType IO a
-> (XFTPErrorType -> ExceptT XFTPErrorType IO a)
-> ExceptT XFTPErrorType IO a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \XFTPErrorType
e ->
                ExceptT XFTPErrorType IO Bool
-> ExceptT XFTPErrorType IO () -> ExceptT XFTPErrorType IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> ExceptT XFTPErrorType IO Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist String
filePath) (String -> ExceptT XFTPErrorType IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
removeFile String
filePath) ExceptT XFTPErrorType IO ()
-> ExceptT XFTPErrorType IO () -> ExceptT XFTPErrorType IO ()
forall a b.
ExceptT XFTPErrorType IO a
-> ExceptT XFTPErrorType IO b -> ExceptT XFTPErrorType IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XFTPErrorType -> ExceptT XFTPErrorType IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE XFTPErrorType
e
      Maybe (Int -> IO SessionId)
_ -> XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> XFTPClientError
forall err. err -> ProtocolClientError err
PCEResponseError XFTPErrorType
NO_FILE
    (FileResponse
r, HTTP2Body
_) -> XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ FileResponse -> XFTPClientError
forall r err. Show r => r -> ProtocolClientError err
unexpectedResponse FileResponse
r

xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
xftpReqTimeout cfg :: XFTPClientConfig
cfg@XFTPClientConfig {$sel:xftpNetworkConfig:XFTPClientConfig :: XFTPClientConfig -> NetworkConfig
xftpNetworkConfig = NetworkConfig {NetworkTimeout
tcpTimeout :: NetworkTimeout
$sel:tcpTimeout:NetworkConfig :: NetworkConfig -> NetworkTimeout
tcpTimeout}} Maybe Word32
chunkSize_ =
  Int -> (Word32 -> Int) -> Maybe Word32 -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NetworkTimeout -> NetworkRequestMode -> Int
netTimeoutInt NetworkTimeout
tcpTimeout NetworkRequestMode
NRMBackground) (XFTPClientConfig -> Word32 -> Int
chunkTimeout XFTPClientConfig
cfg) Maybe Word32
chunkSize_

chunkTimeout :: XFTPClientConfig -> Word32 -> Int
chunkTimeout :: XFTPClientConfig -> Word32 -> Int
chunkTimeout XFTPClientConfig {$sel:xftpNetworkConfig:XFTPClientConfig :: XFTPClientConfig -> NetworkConfig
xftpNetworkConfig = NetworkConfig {NetworkTimeout
$sel:tcpTimeout:NetworkConfig :: NetworkConfig -> NetworkTimeout
tcpTimeout :: NetworkTimeout
tcpTimeout, Int64
tcpTimeoutPerKb :: Int64
$sel:tcpTimeoutPerKb:NetworkConfig :: NetworkConfig -> Int64
tcpTimeoutPerKb}} Word32
sz =
  NetworkTimeout -> NetworkRequestMode -> Int
netTimeoutInt NetworkTimeout
tcpTimeout NetworkRequestMode
NRMBackground Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min ((Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sz Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1024) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
tcpTimeoutPerKb) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)))

deleteXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> SenderId -> ExceptT XFTPClientError IO ()
deleteXFTPChunk :: XFTPClient
-> APrivateAuthKey -> XFTPFileId -> ExceptT XFTPClientError IO ()
deleteXFTPChunk XFTPClient
c APrivateAuthKey
spKey XFTPFileId
sId = XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand 'FSender
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand XFTPClient
c APrivateAuthKey
spKey XFTPFileId
sId FileCommand 'FSender
FDEL Maybe XFTPChunkSpec
forall a. Maybe a
Nothing ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-> ((FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO ()
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ()
okResponse

ackXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> RecipientId -> ExceptT XFTPClientError IO ()
ackXFTPChunk :: XFTPClient
-> APrivateAuthKey -> XFTPFileId -> ExceptT XFTPClientError IO ()
ackXFTPChunk XFTPClient
c APrivateAuthKey
rpKey XFTPFileId
rId = XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand 'FRecipient
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
forall (p :: FileParty).
FilePartyI p =>
XFTPClient
-> APrivateAuthKey
-> XFTPFileId
-> FileCommand p
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPCommand XFTPClient
c APrivateAuthKey
rpKey XFTPFileId
rId FileCommand 'FRecipient
FACK Maybe XFTPChunkSpec
forall a. Maybe a
Nothing ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-> ((FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ())
-> ExceptT XFTPClientError IO ()
forall a b.
ExceptT XFTPClientError IO a
-> (a -> ExceptT XFTPClientError IO b)
-> ExceptT XFTPClientError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ()
okResponse

pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
pingXFTP c :: XFTPClient
c@XFTPClient {THandleParams XFTPVersion 'TClient
$sel:thParams:XFTPClient :: XFTPClient -> THandleParams XFTPVersion 'TClient
thParams :: THandleParams XFTPVersion 'TClient
thParams} = do
  SessionId
t <-
    Either XFTPClientError SessionId
-> ExceptT XFTPClientError IO SessionId
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either XFTPClientError SessionId
 -> ExceptT XFTPClientError IO SessionId)
-> (Either TransportError SessionId
    -> Either XFTPClientError SessionId)
-> Either TransportError SessionId
-> ExceptT XFTPClientError IO SessionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransportError -> XFTPClientError)
-> Either TransportError SessionId
-> Either XFTPClientError SessionId
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 -> XFTPClientError
forall err. TransportError -> ProtocolClientError err
PCETransportError (Either TransportError SessionId
 -> ExceptT XFTPClientError IO SessionId)
-> Either TransportError SessionId
-> ExceptT XFTPClientError IO SessionId
forall a b. (a -> b) -> a -> b
$
      THandleParams XFTPVersion 'TClient
-> Transmission FileCmd -> Either TransportError SessionId
forall c (p :: TransportPeer).
ProtocolEncoding XFTPVersion XFTPErrorType c =>
THandleParams XFTPVersion p
-> Transmission c -> Either TransportError SessionId
xftpEncodeTransmission THandleParams XFTPVersion 'TClient
thParams (CorrId
"", XFTPFileId
NoEntity, SFileParty 'FRecipient -> FileCommand 'FRecipient -> FileCmd
forall (p :: FileParty).
FilePartyI p =>
SFileParty p -> FileCommand p -> FileCmd
FileCmd SFileParty 'FRecipient
SFRecipient FileCommand 'FRecipient
PING)
  (FileResponse
r, HTTP2Body
_) <- XFTPClient
-> SessionId
-> Maybe XFTPChunkSpec
-> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
sendXFTPTransmission XFTPClient
c SessionId
t Maybe XFTPChunkSpec
forall a. Maybe a
Nothing
  case FileResponse
r of
    FileResponse
FRPong -> () -> ExceptT XFTPClientError IO ()
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FileResponse
_ -> XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ FileResponse -> XFTPClientError
forall r err. Show r => r -> ProtocolClientError err
unexpectedResponse FileResponse
r

okResponse :: (FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ()
okResponse :: (FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ()
okResponse = \case
  (FileResponse
FROk, HTTP2Body
body) -> HTTP2Body -> () -> ExceptT XFTPClientError IO ()
forall a. HTTP2Body -> a -> ExceptT XFTPClientError IO a
noFile HTTP2Body
body ()
  (FileResponse
r, HTTP2Body
_) -> XFTPClientError -> ExceptT XFTPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (XFTPClientError -> ExceptT XFTPClientError IO ())
-> XFTPClientError -> ExceptT XFTPClientError IO ()
forall a b. (a -> b) -> a -> b
$ FileResponse -> XFTPClientError
forall r err. Show r => r -> ProtocolClientError err
unexpectedResponse FileResponse
r

-- TODO this currently does not check anything because response size is not set and bodyPart is always Just
noFile :: HTTP2Body -> a -> ExceptT XFTPClientError IO a
noFile :: forall a. HTTP2Body -> a -> ExceptT XFTPClientError IO a
noFile HTTP2Body {Maybe (Int -> IO SessionId)
bodyPart :: HTTP2Body -> Maybe (Int -> IO SessionId)
bodyPart :: Maybe (Int -> IO SessionId)
bodyPart} a
a = case Maybe (Int -> IO SessionId)
bodyPart of
  Just Int -> IO SessionId
_ -> a -> ExceptT XFTPClientError IO a
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a -- throwE $ PCEResponseError HAS_FILE
  Maybe (Int -> IO SessionId)
_ -> a -> ExceptT XFTPClientError IO a
forall a. a -> ExceptT XFTPClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- FACK :: FileCommand Recipient
-- PING :: FileCommand Recipient

singleChunkSize :: Int64 -> Maybe Word32
singleChunkSize :: Int64 -> Maybe Word32
singleChunkSize Int64
size' =
  [Word32] -> Maybe Word32
forall a. [a] -> Maybe a
listToMaybe ([Word32] -> Maybe Word32) -> [Word32] -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Bool) -> [Word32] -> [Word32]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
chunkSize) [Word32]
serverChunkSizes
  where
    chunkSize :: Word32
chunkSize = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size'

prepareChunkSizes :: Int64 -> [Word32]
prepareChunkSizes :: Int64 -> [Word32]
prepareChunkSizes Int64
size' = Int64 -> [Word32]
forall {a}. Integral a => a -> [Word32]
prepareSizes Int64
size'
  where
    (Word32
smallSize, Word32
bigSize)
      | Int64
size' Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Int64
forall {a} {a}. (Integral a, Integral a) => a -> a
size34 Word32
chunkSize3 = (Word32
chunkSize2, Word32
chunkSize3)
      | Int64
size' Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Int64
forall {a} {a}. (Integral a, Integral a) => a -> a
size34 Word32
chunkSize2 = (Word32
chunkSize1, Word32
chunkSize2)
      | Bool
otherwise = (Word32
chunkSize0, Word32
chunkSize1)
    size34 :: a -> a
size34 a
sz = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
sz a -> a -> a
forall a. Num a => a -> a -> a
* a
3) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
4
    prepareSizes :: a -> [Word32]
prepareSizes a
0 = []
    prepareSizes a
size
      | a
size a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bigSize = Int -> Word32 -> [Word32]
forall a. Int -> a -> [a]
replicate (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n1) Word32
bigSize [Word32] -> [Word32] -> [Word32]
forall a. Semigroup a => a -> a -> a
<> a -> [Word32]
prepareSizes a
remSz
      | a
size a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> a
forall {a} {a}. (Integral a, Integral a) => a -> a
size34 Word32
bigSize = [Word32
bigSize]
      | Bool
otherwise = Int -> Word32 -> [Word32]
forall a. Int -> a -> [a]
replicate (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n2') Word32
smallSize
      where
        (a
n1, a
remSz) = a
size a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bigSize
        n2' :: a
n2' = let (a
n2, a
remSz2) = (a
size a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
smallSize) in if a
remSz2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
n2 else a
n2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1

prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec]
prepareChunkSpecs :: String -> [Word32] -> [XFTPChunkSpec]
prepareChunkSpecs String
filePath [Word32]
chunkSizes = [XFTPChunkSpec] -> [XFTPChunkSpec]
forall a. [a] -> [a]
reverse ([XFTPChunkSpec] -> [XFTPChunkSpec])
-> ((Int64, [XFTPChunkSpec]) -> [XFTPChunkSpec])
-> (Int64, [XFTPChunkSpec])
-> [XFTPChunkSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, [XFTPChunkSpec]) -> [XFTPChunkSpec]
forall a b. (a, b) -> b
snd ((Int64, [XFTPChunkSpec]) -> [XFTPChunkSpec])
-> (Int64, [XFTPChunkSpec]) -> [XFTPChunkSpec]
forall a b. (a -> b) -> a -> b
$ ((Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec]))
-> (Int64, [XFTPChunkSpec]) -> [Word32] -> (Int64, [XFTPChunkSpec])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
addSpec (Int64
0, []) [Word32]
chunkSizes
  where
    addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
    addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
addSpec (Int64
chunkOffset, [XFTPChunkSpec]
specs) Word32
sz =
      let spec :: XFTPChunkSpec
spec = XFTPChunkSpec {String
$sel:filePath:XFTPChunkSpec :: String
filePath :: String
filePath, Int64
$sel:chunkOffset:XFTPChunkSpec :: Int64
chunkOffset :: Int64
chunkOffset, $sel:chunkSize:XFTPChunkSpec :: Word32
chunkSize = Word32
sz}
       in (Int64
chunkOffset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sz, XFTPChunkSpec
spec XFTPChunkSpec -> [XFTPChunkSpec] -> [XFTPChunkSpec]
forall a. a -> [a] -> [a]
: [XFTPChunkSpec]
specs)

getChunkDigest :: XFTPChunkSpec -> IO ByteString
getChunkDigest :: XFTPChunkSpec -> IO SessionId
getChunkDigest XFTPChunkSpec {$sel:filePath:XFTPChunkSpec :: XFTPChunkSpec -> String
filePath = String
chunkPath, Int64
$sel:chunkOffset:XFTPChunkSpec :: XFTPChunkSpec -> Int64
chunkOffset :: Int64
chunkOffset, Word32
$sel:chunkSize:XFTPChunkSpec :: XFTPChunkSpec -> Word32
chunkSize :: Word32
chunkSize} =
  String -> IOMode -> (Handle -> IO SessionId) -> IO SessionId
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withFile String
chunkPath IOMode
ReadMode ((Handle -> IO SessionId) -> IO SessionId)
-> (Handle -> IO SessionId) -> IO SessionId
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    Handle -> SeekMode -> Integer -> IO ()
forall (m :: * -> *).
MonadIO m =>
Handle -> SeekMode -> Integer -> m ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
chunkOffset
    ByteString
chunk <- Handle -> Int -> IO ByteString
LB.hGet Handle
h (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
chunkSize)
    SessionId -> IO SessionId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionId -> IO SessionId) -> SessionId -> IO SessionId
forall a b. (a -> b) -> a -> b
$! ByteString -> SessionId
LC.sha256Hash ByteString
chunk