{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Module      : Network.TLS.IO
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.IO
    ( sendPacket
    , sendPacket13
    , recvPacket
    , recvPacket13
    --
    , isRecvComplete
    , checkValid
    -- * Grouping multiple packets in the same flight
    , PacketFlightM
    , runPacketFlight
    , loadPacket13
    ) where

import Control.Exception (finally, throwIO)
import Control.Monad.Reader
import Control.Monad.State.Strict
import qualified Data.ByteString as B
import Data.IORef
import System.IO.Error (mkIOError, eofErrorType)

import Network.TLS.Context.Internal
import Network.TLS.ErrT
import Network.TLS.Hooks
import Network.TLS.Imports
import Network.TLS.Packet
import Network.TLS.Receiving
import Network.TLS.Receiving13
import Network.TLS.Record
import Network.TLS.Sending
import Network.TLS.Sending13
import Network.TLS.State
import Network.TLS.Struct
import Network.TLS.Struct13

----------------------------------------------------------------

-- | Send one packet to the context
sendPacket :: MonadIO m => Context -> Packet -> m ()
sendPacket :: Context -> Packet -> m ()
sendPacket ctx :: Context
ctx pkt :: Packet
pkt = do
    -- in ver <= TLS1.0, block ciphers using CBC are using CBC residue as IV, which can be guessed
    -- by an attacker. Hence, an empty packet is sent before a normal data packet, to
    -- prevent guessability.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Packet -> Bool
isNonNullAppData Packet
pkt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
withEmptyPacket <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Context -> IORef Bool
ctxNeedEmptyPacket Context
ctx
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withEmptyPacket (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Context -> Packet -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Context -> Packet -> m ByteString
writePacketBytes Context
ctx (ByteString -> Packet
AppData ByteString
B.empty) m ByteString -> (ByteString -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
sendBytes Context
ctx

    Context -> Packet -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Context -> Packet -> m ByteString
writePacketBytes Context
ctx Packet
pkt m ByteString -> (ByteString -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
sendBytes Context
ctx
  where isNonNullAppData :: Packet -> Bool
isNonNullAppData (AppData b :: ByteString
b) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
B.null ByteString
b
        isNonNullAppData _           = Bool
False

writePacketBytes :: MonadIO m => Context -> Packet -> m ByteString
writePacketBytes :: Context -> Packet -> m ByteString
writePacketBytes ctx :: Context
ctx pkt :: Packet
pkt = do
    Either TLSError ByteString
edataToSend <- IO (Either TLSError ByteString) -> m (Either TLSError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TLSError ByteString) -> m (Either TLSError ByteString))
-> IO (Either TLSError ByteString)
-> m (Either TLSError ByteString)
forall a b. (a -> b) -> a -> b
$ do
                        Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logging :: Logging
logging -> Logging -> String -> IO ()
loggingPacketSent Logging
logging (Packet -> String
forall a. Show a => a -> String
show Packet
pkt)
                        Context -> Packet -> IO (Either TLSError ByteString)
encodePacket Context
ctx Packet
pkt
    (TLSError -> m ByteString)
-> (ByteString -> m ByteString)
-> Either TLSError ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TLSError -> m ByteString
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwCore ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return Either TLSError ByteString
edataToSend

----------------------------------------------------------------

sendPacket13 :: MonadIO m => Context -> Packet13 -> m ()
sendPacket13 :: Context -> Packet13 -> m ()
sendPacket13 ctx :: Context
ctx pkt :: Packet13
pkt = Context -> Packet13 -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Context -> Packet13 -> m ByteString
writePacketBytes13 Context
ctx Packet13
pkt m ByteString -> (ByteString -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
sendBytes Context
ctx

writePacketBytes13 :: MonadIO m => Context -> Packet13 -> m ByteString
writePacketBytes13 :: Context -> Packet13 -> m ByteString
writePacketBytes13 ctx :: Context
ctx pkt :: Packet13
pkt = do
    Either TLSError ByteString
edataToSend <- IO (Either TLSError ByteString) -> m (Either TLSError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TLSError ByteString) -> m (Either TLSError ByteString))
-> IO (Either TLSError ByteString)
-> m (Either TLSError ByteString)
forall a b. (a -> b) -> a -> b
$ do
                        Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logging :: Logging
logging -> Logging -> String -> IO ()
loggingPacketSent Logging
logging (Packet13 -> String
forall a. Show a => a -> String
show Packet13
pkt)
                        Context -> Packet13 -> IO (Either TLSError ByteString)
encodePacket13 Context
ctx Packet13
pkt
    (TLSError -> m ByteString)
-> (ByteString -> m ByteString)
-> Either TLSError ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TLSError -> m ByteString
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwCore ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return Either TLSError ByteString
edataToSend

sendBytes :: MonadIO m => Context -> ByteString -> m ()
sendBytes :: Context -> ByteString -> m ()
sendBytes ctx :: Context
ctx dataToSend :: ByteString
dataToSend = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logging :: Logging
logging -> Logging -> ByteString -> IO ()
loggingIOSent Logging
logging ByteString
dataToSend
    Context -> ByteString -> IO ()
contextSend Context
ctx ByteString
dataToSend

----------------------------------------------------------------

getRecord :: Context -> Int -> Header -> ByteString -> IO (Either TLSError (Record Plaintext))
getRecord :: Context
-> Int
-> Header
-> ByteString
-> IO (Either TLSError (Record Plaintext))
getRecord ctx :: Context
ctx appDataOverhead :: Int
appDataOverhead header :: Header
header@(Header pt :: ProtocolType
pt _ _) content :: ByteString
content = do
    Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logging :: Logging
logging -> Logging -> Header -> ByteString -> IO ()
loggingIORecv Logging
logging Header
header ByteString
content
    Context
-> RecordM (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall a. Context -> RecordM a -> IO (Either TLSError a)
runRxState Context
ctx (RecordM (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> RecordM (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall a b. (a -> b) -> a -> b
$ do
        Record Plaintext
r <- Header -> ByteString -> RecordM (Record Plaintext)
decodeRecordM Header
header ByteString
content
        let Record _ _ fragment :: Fragment Plaintext
fragment = Record Plaintext
r
        Bool -> RecordM () -> RecordM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length (Fragment Plaintext -> ByteString
forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Plaintext
fragment) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 16384 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
overhead) (RecordM () -> RecordM ()) -> RecordM () -> RecordM ()
forall a b. (a -> b) -> a -> b
$
            TLSError -> RecordM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
contentSizeExceeded
        Record Plaintext -> RecordM (Record Plaintext)
forall (m :: * -> *) a. Monad m => a -> m a
return Record Plaintext
r
  where overhead :: Int
overhead = if ProtocolType
pt ProtocolType -> ProtocolType -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolType
ProtocolType_AppData then Int
appDataOverhead else 0


contentSizeExceeded :: TLSError
contentSizeExceeded :: TLSError
contentSizeExceeded = (String, Bool, AlertDescription) -> TLSError
Error_Protocol ("record content exceeding maximum size", Bool
True, AlertDescription
RecordOverflow)

----------------------------------------------------------------
-- | receive one packet from the context that contains 1 or
-- many messages (many only in case of handshake). if will returns a
-- TLSError if the packet is unexpected or malformed
recvPacket :: MonadIO m => Context -> m (Either TLSError Packet)
recvPacket :: Context -> m (Either TLSError Packet)
recvPacket ctx :: Context
ctx = IO (Either TLSError Packet) -> m (Either TLSError Packet)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TLSError Packet) -> m (Either TLSError Packet))
-> IO (Either TLSError Packet) -> m (Either TLSError Packet)
forall a b. (a -> b) -> a -> b
$ do
    Bool
compatSSLv2 <- Context -> IO Bool
ctxHasSSLv2ClientHello Context
ctx
    Bool
hrr         <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS13HRR
    -- When a client sends 0-RTT data to a server which rejects and sends a HRR,
    -- the server will not decrypt AppData segments.  The server needs to accept
    -- AppData with maximum size 2^14 + 256.  In all other scenarios and record
    -- types the maximum size is 2^14.
    let appDataOverhead :: Int
appDataOverhead = if Bool
hrr then 256 else 0
    Either TLSError (Record Plaintext)
erecord     <- Bool -> Int -> Context -> IO (Either TLSError (Record Plaintext))
recvRecord Bool
compatSSLv2 Int
appDataOverhead Context
ctx
    case Either TLSError (Record Plaintext)
erecord of
        Left err :: TLSError
err     -> Either TLSError Packet -> IO (Either TLSError Packet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError Packet -> IO (Either TLSError Packet))
-> Either TLSError Packet -> IO (Either TLSError Packet)
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError Packet
forall a b. a -> Either a b
Left TLSError
err
        Right record :: Record Plaintext
record ->
            if Bool
hrr Bool -> Bool -> Bool
&& Record Plaintext -> Bool
forall a. Record a -> Bool
isCCS Record Plaintext
record then
                Context -> IO (Either TLSError Packet)
forall (m :: * -> *).
MonadIO m =>
Context -> m (Either TLSError Packet)
recvPacket Context
ctx
              else do
                Either TLSError Packet
pktRecv <- Context -> Record Plaintext -> IO (Either TLSError Packet)
processPacket Context
ctx Record Plaintext
record
                if Either TLSError Packet -> Bool
isEmptyHandshake Either TLSError Packet
pktRecv then
                    -- When a handshake record is fragmented we continue
                    -- receiving in order to feed stHandshakeRecordCont
                    Context -> IO (Either TLSError Packet)
forall (m :: * -> *).
MonadIO m =>
Context -> m (Either TLSError Packet)
recvPacket Context
ctx
                  else do
                    Either TLSError Packet
pkt <- case Either TLSError Packet
pktRecv of
                            Right (Handshake hss :: [Handshake]
hss) ->
                                Context
-> (Hooks -> IO (Either TLSError Packet))
-> IO (Either TLSError Packet)
forall a. Context -> (Hooks -> IO a) -> IO a
ctxWithHooks Context
ctx ((Hooks -> IO (Either TLSError Packet))
 -> IO (Either TLSError Packet))
-> (Hooks -> IO (Either TLSError Packet))
-> IO (Either TLSError Packet)
forall a b. (a -> b) -> a -> b
$ \hooks :: Hooks
hooks ->
                                    Packet -> Either TLSError Packet
forall a b. b -> Either a b
Right (Packet -> Either TLSError Packet)
-> ([Handshake] -> Packet) -> [Handshake] -> Either TLSError Packet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Handshake] -> Packet
Handshake ([Handshake] -> Either TLSError Packet)
-> IO [Handshake] -> IO (Either TLSError Packet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handshake -> IO Handshake) -> [Handshake] -> IO [Handshake]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Hooks -> Handshake -> IO Handshake
hookRecvHandshake Hooks
hooks) [Handshake]
hss
                            _                     -> Either TLSError Packet -> IO (Either TLSError Packet)
forall (m :: * -> *) a. Monad m => a -> m a
return Either TLSError Packet
pktRecv
                    case Either TLSError Packet
pkt of
                        Right p :: Packet
p -> Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logging :: Logging
logging -> Logging -> String -> IO ()
loggingPacketRecv Logging
logging (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Packet -> String
forall a. Show a => a -> String
show Packet
p
                        _       -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
compatSSLv2 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> IO ()
ctxDisableSSLv2ClientHello Context
ctx
                    Either TLSError Packet -> IO (Either TLSError Packet)
forall (m :: * -> *) a. Monad m => a -> m a
return Either TLSError Packet
pkt

-- | recvRecord receive a full TLS record (header + data), from the other side.
--
-- The record is disengaged from the record layer
recvRecord :: Bool    -- ^ flag to enable SSLv2 compat ClientHello reception
           -> Int     -- ^ number of AppData bytes to accept above normal maximum size
           -> Context -- ^ TLS context
           -> IO (Either TLSError (Record Plaintext))
recvRecord :: Bool -> Int -> Context -> IO (Either TLSError (Record Plaintext))
recvRecord compatSSLv2 :: Bool
compatSSLv2 appDataOverhead :: Int
appDataOverhead ctx :: Context
ctx
#ifdef SSLV2_COMPATIBLE
    | Bool
compatSSLv2 = Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx 2 IO (Either TLSError ByteString)
-> (Either TLSError ByteString
    -> IO (Either TLSError (Record Plaintext)))
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError ByteString
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) ByteString -> IO (Either TLSError (Record Plaintext))
sslv2Header
#endif
    | Bool
otherwise = Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx 5 IO (Either TLSError ByteString)
-> (Either TLSError ByteString
    -> IO (Either TLSError (Record Plaintext)))
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError ByteString
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) (Either TLSError Header -> IO (Either TLSError (Record Plaintext))
recvLengthE (Either TLSError Header -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> Either TLSError Header)
-> ByteString
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either TLSError Header
decodeHeader)

        where recvLengthE :: Either TLSError Header -> IO (Either TLSError (Record Plaintext))
recvLengthE = (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (Header -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError Header
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) Header -> IO (Either TLSError (Record Plaintext))
recvLength

              recvLength :: Header -> IO (Either TLSError (Record Plaintext))
recvLength header :: Header
header@(Header _ _ readlen :: Word16
readlen)
                | Word16
readlen Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> 16384 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ 2048 = Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left TLSError
maximumSizeExceeded
                | Bool
otherwise              =
                    Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
readlen) IO (Either TLSError ByteString)
-> (Either TLSError ByteString
    -> IO (Either TLSError (Record Plaintext)))
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError ByteString
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) (Context
-> Int
-> Header
-> ByteString
-> IO (Either TLSError (Record Plaintext))
getRecord Context
ctx Int
appDataOverhead Header
header)
#ifdef SSLV2_COMPATIBLE
              sslv2Header :: ByteString -> IO (Either TLSError (Record Plaintext))
sslv2Header header :: ByteString
header =
                if ByteString -> Word8
B.head ByteString
header Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x80
                    then (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (Word16 -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError Word16
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) Word16 -> IO (Either TLSError (Record Plaintext))
recvDeprecatedLength (Either TLSError Word16 -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError Word16
-> IO (Either TLSError (Record Plaintext))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either TLSError Word16
decodeDeprecatedHeaderLength ByteString
header
                    else Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx 3 IO (Either TLSError ByteString)
-> (Either TLSError ByteString
    -> IO (Either TLSError (Record Plaintext)))
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                            (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError ByteString
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) (Either TLSError Header -> IO (Either TLSError (Record Plaintext))
recvLengthE (Either TLSError Header -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> Either TLSError Header)
-> ByteString
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either TLSError Header
decodeHeader (ByteString -> Either TLSError Header)
-> (ByteString -> ByteString)
-> ByteString
-> Either TLSError Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
B.append ByteString
header)

              recvDeprecatedLength :: Word16 -> IO (Either TLSError (Record Plaintext))
recvDeprecatedLength readlen :: Word16
readlen
                | Word16
readlen Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> 1024 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* 4     = Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left TLSError
maximumSizeExceeded
                | Bool
otherwise              = do
                    Either TLSError ByteString
res <- Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
readlen)
                    case Either TLSError ByteString
res of
                      Left e :: TLSError
e -> Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left TLSError
e
                      Right content :: ByteString
content ->
                        let hdr :: Either TLSError Header
hdr = Word16 -> ByteString -> Either TLSError Header
decodeDeprecatedHeader Word16
readlen (Int -> ByteString -> ByteString
B.take 3 ByteString
content)
                         in (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (Header -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError Header
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) (\h :: Header
h -> Context
-> Int
-> Header
-> ByteString
-> IO (Either TLSError (Record Plaintext))
getRecord Context
ctx Int
appDataOverhead Header
h ByteString
content) Either TLSError Header
hdr
#endif

isCCS :: Record a -> Bool
isCCS :: Record a -> Bool
isCCS (Record ProtocolType_ChangeCipherSpec _ _) = Bool
True
isCCS _                                          = Bool
False

isEmptyHandshake :: Either TLSError Packet -> Bool
isEmptyHandshake :: Either TLSError Packet -> Bool
isEmptyHandshake (Right (Handshake [])) = Bool
True
isEmptyHandshake _                      = Bool
False

----------------------------------------------------------------

recvPacket13 :: MonadIO m => Context -> m (Either TLSError Packet13)
recvPacket13 :: Context -> m (Either TLSError Packet13)
recvPacket13 ctx :: Context
ctx = IO (Either TLSError Packet13) -> m (Either TLSError Packet13)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TLSError Packet13) -> m (Either TLSError Packet13))
-> IO (Either TLSError Packet13) -> m (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ do
    Either TLSError (Record Plaintext)
erecord <- Context -> IO (Either TLSError (Record Plaintext))
recvRecord13 Context
ctx
    case Either TLSError (Record Plaintext)
erecord of
        Left err :: TLSError
err@(Error_Protocol (_, True, BadRecordMac)) -> do
            -- If the server decides to reject RTT0 data but accepts RTT1
            -- data, the server should skip all records for RTT0 data.
            Established
established <- Context -> IO Established
ctxEstablished Context
ctx
            case Established
established of
                EarlyDataNotAllowed n :: Int
n
                    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> do Context -> Established -> IO ()
setEstablished Context
ctx (Established -> IO ()) -> Established -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Established
EarlyDataNotAllowed (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
                                  Context -> IO (Either TLSError Packet13)
forall (m :: * -> *).
MonadIO m =>
Context -> m (Either TLSError Packet13)
recvPacket13 Context
ctx
                _           -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError Packet13 -> IO (Either TLSError Packet13))
-> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError Packet13
forall a b. a -> Either a b
Left TLSError
err
        Left err :: TLSError
err      -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError Packet13 -> IO (Either TLSError Packet13))
-> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError Packet13
forall a b. a -> Either a b
Left TLSError
err
        Right record :: Record Plaintext
record -> do
            Either TLSError Packet13
pktRecv <- Context -> Record Plaintext -> IO (Either TLSError Packet13)
processPacket13 Context
ctx Record Plaintext
record
            if Either TLSError Packet13 -> Bool
isEmptyHandshake13 Either TLSError Packet13
pktRecv then
                -- When a handshake record is fragmented we continue receiving
                -- in order to feed stHandshakeRecordCont13
                Context -> IO (Either TLSError Packet13)
forall (m :: * -> *).
MonadIO m =>
Context -> m (Either TLSError Packet13)
recvPacket13 Context
ctx
              else do
                Either TLSError Packet13
pkt <- case Either TLSError Packet13
pktRecv of
                        Right (Handshake13 hss :: [Handshake13]
hss) ->
                            Context
-> (Hooks -> IO (Either TLSError Packet13))
-> IO (Either TLSError Packet13)
forall a. Context -> (Hooks -> IO a) -> IO a
ctxWithHooks Context
ctx ((Hooks -> IO (Either TLSError Packet13))
 -> IO (Either TLSError Packet13))
-> (Hooks -> IO (Either TLSError Packet13))
-> IO (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ \hooks :: Hooks
hooks ->
                                Packet13 -> Either TLSError Packet13
forall a b. b -> Either a b
Right (Packet13 -> Either TLSError Packet13)
-> ([Handshake13] -> Packet13)
-> [Handshake13]
-> Either TLSError Packet13
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Handshake13] -> Packet13
Handshake13 ([Handshake13] -> Either TLSError Packet13)
-> IO [Handshake13] -> IO (Either TLSError Packet13)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handshake13 -> IO Handshake13)
-> [Handshake13] -> IO [Handshake13]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Hooks -> Handshake13 -> IO Handshake13
hookRecvHandshake13 Hooks
hooks) [Handshake13]
hss
                        _                       -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return Either TLSError Packet13
pktRecv
                case Either TLSError Packet13
pkt of
                    Right p :: Packet13
p -> Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \logging :: Logging
logging -> Logging -> String -> IO ()
loggingPacketRecv Logging
logging (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Packet13 -> String
forall a. Show a => a -> String
show Packet13
p
                    _       -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return Either TLSError Packet13
pkt

recvRecord13 :: Context
            -> IO (Either TLSError (Record Plaintext))
recvRecord13 :: Context -> IO (Either TLSError (Record Plaintext))
recvRecord13 ctx :: Context
ctx = Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx 5 IO (Either TLSError ByteString)
-> (Either TLSError ByteString
    -> IO (Either TLSError (Record Plaintext)))
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError ByteString
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) (Either TLSError Header -> IO (Either TLSError (Record Plaintext))
recvLengthE (Either TLSError Header -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> Either TLSError Header)
-> ByteString
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either TLSError Header
decodeHeader)
  where recvLengthE :: Either TLSError Header -> IO (Either TLSError (Record Plaintext))
recvLengthE = (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (Header -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError Header
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) Header -> IO (Either TLSError (Record Plaintext))
recvLength
        recvLength :: Header -> IO (Either TLSError (Record Plaintext))
recvLength header :: Header
header@(Header _ _ readlen :: Word16
readlen)
          | Word16
readlen Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> 16384 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ 256  = Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall a b. (a -> b) -> a -> b
$ TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left TLSError
maximumSizeExceeded
          | Bool
otherwise              =
              Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
readlen) IO (Either TLSError ByteString)
-> (Either TLSError ByteString
    -> IO (Either TLSError (Record Plaintext)))
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                 (TLSError -> IO (Either TLSError (Record Plaintext)))
-> (ByteString -> IO (Either TLSError (Record Plaintext)))
-> Either TLSError ByteString
-> IO (Either TLSError (Record Plaintext))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either TLSError (Record Plaintext)
-> IO (Either TLSError (Record Plaintext))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError (Record Plaintext)
 -> IO (Either TLSError (Record Plaintext)))
-> (TLSError -> Either TLSError (Record Plaintext))
-> TLSError
-> IO (Either TLSError (Record Plaintext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError (Record Plaintext)
forall a b. a -> Either a b
Left) (Context
-> Int
-> Header
-> ByteString
-> IO (Either TLSError (Record Plaintext))
getRecord Context
ctx 0 Header
header)

isEmptyHandshake13 :: Either TLSError Packet13 -> Bool
isEmptyHandshake13 :: Either TLSError Packet13 -> Bool
isEmptyHandshake13 (Right (Handshake13 [])) = Bool
True
isEmptyHandshake13 _                        = Bool
False

----------------------------------------------------------------
-- Common for receiving

maximumSizeExceeded :: TLSError
maximumSizeExceeded :: TLSError
maximumSizeExceeded = (String, Bool, AlertDescription) -> TLSError
Error_Protocol ("record exceeding maximum size", Bool
True, AlertDescription
RecordOverflow)

readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
readExactBytes ctx :: Context
ctx sz :: Int
sz = do
    ByteString
hdrbs <- Context -> Int -> IO ByteString
contextRecv Context
ctx Int
sz
    if ByteString -> Int
B.length ByteString
hdrbs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
        then Either TLSError ByteString -> IO (Either TLSError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError ByteString -> IO (Either TLSError ByteString))
-> Either TLSError ByteString -> IO (Either TLSError ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either TLSError ByteString
forall a b. b -> Either a b
Right ByteString
hdrbs
        else do
            Context -> IO ()
setEOF Context
ctx
            Either TLSError ByteString -> IO (Either TLSError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError ByteString -> IO (Either TLSError ByteString))
-> (TLSError -> Either TLSError ByteString)
-> TLSError
-> IO (Either TLSError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> Either TLSError ByteString
forall a b. a -> Either a b
Left (TLSError -> IO (Either TLSError ByteString))
-> TLSError -> IO (Either TLSError ByteString)
forall a b. (a -> b) -> a -> b
$
                if ByteString -> Bool
B.null ByteString
hdrbs
                    then TLSError
Error_EOF
                    else String -> TLSError
Error_Packet ("partial packet: expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> String -> String
forall a. [a] -> [a] -> [a]
++ " bytes, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
hdrbs))

----------------------------------------------------------------

isRecvComplete :: Context -> IO Bool
isRecvComplete :: Context -> IO Bool
isRecvComplete ctx :: Context
ctx = Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt Bool -> IO Bool) -> TLSSt Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    Maybe (GetContinuation (HandshakeType, ByteString))
cont <- (TLSState -> Maybe (GetContinuation (HandshakeType, ByteString)))
-> TLSSt (Maybe (GetContinuation (HandshakeType, ByteString)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe (GetContinuation (HandshakeType, ByteString))
stHandshakeRecordCont
    Maybe (GetContinuation (HandshakeType13, ByteString))
cont13 <- (TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString)))
-> TLSSt (Maybe (GetContinuation (HandshakeType13, ByteString)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString))
stHandshakeRecordCont13
    Bool -> TLSSt Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> TLSSt Bool) -> Bool -> TLSSt Bool
forall a b. (a -> b) -> a -> b
$! Maybe (GetContinuation (HandshakeType, ByteString)) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (GetContinuation (HandshakeType, ByteString))
cont Bool -> Bool -> Bool
&& Maybe (GetContinuation (HandshakeType13, ByteString)) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (GetContinuation (HandshakeType13, ByteString))
cont13

checkValid :: Context -> IO ()
checkValid :: Context -> IO ()
checkValid ctx :: Context
ctx = do
    Established
established <- Context -> IO Established
ctxEstablished Context
ctx
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Established
established Established -> Established -> Bool
forall a. Eq a => a -> a -> Bool
== Established
NotEstablished) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TLSException -> IO ()
forall e a. Exception e => e -> IO a
throwIO TLSException
ConnectionNotEstablished
    Bool
eofed <- Context -> IO Bool
ctxEOF Context
ctx
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
eofed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType "data" Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

----------------------------------------------------------------

-- | State monad used to group several packets together and send them on wire as
-- single flight.  When packets are loaded in the monad, they are logged
-- immediately, update the context digest and transcript, but actual sending is
-- deferred.  Packets are sent all at once when the monadic computation ends
-- (normal termination but also if interrupted by an exception).
newtype PacketFlightM a = PacketFlightM (ReaderT (IORef [ByteString]) IO a)
    deriving (a -> PacketFlightM b -> PacketFlightM a
(a -> b) -> PacketFlightM a -> PacketFlightM b
(forall a b. (a -> b) -> PacketFlightM a -> PacketFlightM b)
-> (forall a b. a -> PacketFlightM b -> PacketFlightM a)
-> Functor PacketFlightM
forall a b. a -> PacketFlightM b -> PacketFlightM a
forall a b. (a -> b) -> PacketFlightM a -> PacketFlightM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PacketFlightM b -> PacketFlightM a
$c<$ :: forall a b. a -> PacketFlightM b -> PacketFlightM a
fmap :: (a -> b) -> PacketFlightM a -> PacketFlightM b
$cfmap :: forall a b. (a -> b) -> PacketFlightM a -> PacketFlightM b
Functor, Functor PacketFlightM
a -> PacketFlightM a
Functor PacketFlightM =>
(forall a. a -> PacketFlightM a)
-> (forall a b.
    PacketFlightM (a -> b) -> PacketFlightM a -> PacketFlightM b)
-> (forall a b c.
    (a -> b -> c)
    -> PacketFlightM a -> PacketFlightM b -> PacketFlightM c)
-> (forall a b.
    PacketFlightM a -> PacketFlightM b -> PacketFlightM b)
-> (forall a b.
    PacketFlightM a -> PacketFlightM b -> PacketFlightM a)
-> Applicative PacketFlightM
PacketFlightM a -> PacketFlightM b -> PacketFlightM b
PacketFlightM a -> PacketFlightM b -> PacketFlightM a
PacketFlightM (a -> b) -> PacketFlightM a -> PacketFlightM b
(a -> b -> c)
-> PacketFlightM a -> PacketFlightM b -> PacketFlightM c
forall a. a -> PacketFlightM a
forall a b. PacketFlightM a -> PacketFlightM b -> PacketFlightM a
forall a b. PacketFlightM a -> PacketFlightM b -> PacketFlightM b
forall a b.
PacketFlightM (a -> b) -> PacketFlightM a -> PacketFlightM b
forall a b c.
(a -> b -> c)
-> PacketFlightM a -> PacketFlightM b -> PacketFlightM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PacketFlightM a -> PacketFlightM b -> PacketFlightM a
$c<* :: forall a b. PacketFlightM a -> PacketFlightM b -> PacketFlightM a
*> :: PacketFlightM a -> PacketFlightM b -> PacketFlightM b
$c*> :: forall a b. PacketFlightM a -> PacketFlightM b -> PacketFlightM b
liftA2 :: (a -> b -> c)
-> PacketFlightM a -> PacketFlightM b -> PacketFlightM c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> PacketFlightM a -> PacketFlightM b -> PacketFlightM c
<*> :: PacketFlightM (a -> b) -> PacketFlightM a -> PacketFlightM b
$c<*> :: forall a b.
PacketFlightM (a -> b) -> PacketFlightM a -> PacketFlightM b
pure :: a -> PacketFlightM a
$cpure :: forall a. a -> PacketFlightM a
$cp1Applicative :: Functor PacketFlightM
Applicative, Applicative PacketFlightM
a -> PacketFlightM a
Applicative PacketFlightM =>
(forall a b.
 PacketFlightM a -> (a -> PacketFlightM b) -> PacketFlightM b)
-> (forall a b.
    PacketFlightM a -> PacketFlightM b -> PacketFlightM b)
-> (forall a. a -> PacketFlightM a)
-> Monad PacketFlightM
PacketFlightM a -> (a -> PacketFlightM b) -> PacketFlightM b
PacketFlightM a -> PacketFlightM b -> PacketFlightM b
forall a. a -> PacketFlightM a
forall a b. PacketFlightM a -> PacketFlightM b -> PacketFlightM b
forall a b.
PacketFlightM a -> (a -> PacketFlightM b) -> PacketFlightM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PacketFlightM a
$creturn :: forall a. a -> PacketFlightM a
>> :: PacketFlightM a -> PacketFlightM b -> PacketFlightM b
$c>> :: forall a b. PacketFlightM a -> PacketFlightM b -> PacketFlightM b
>>= :: PacketFlightM a -> (a -> PacketFlightM b) -> PacketFlightM b
$c>>= :: forall a b.
PacketFlightM a -> (a -> PacketFlightM b) -> PacketFlightM b
$cp1Monad :: Applicative PacketFlightM
Monad, Monad PacketFlightM
Monad PacketFlightM =>
(forall a. String -> PacketFlightM a) -> MonadFail PacketFlightM
String -> PacketFlightM a
forall a. String -> PacketFlightM a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> PacketFlightM a
$cfail :: forall a. String -> PacketFlightM a
$cp1MonadFail :: Monad PacketFlightM
MonadFail, Monad PacketFlightM
Monad PacketFlightM =>
(forall a. IO a -> PacketFlightM a) -> MonadIO PacketFlightM
IO a -> PacketFlightM a
forall a. IO a -> PacketFlightM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> PacketFlightM a
$cliftIO :: forall a. IO a -> PacketFlightM a
$cp1MonadIO :: Monad PacketFlightM
MonadIO)

runPacketFlight :: Context -> PacketFlightM a -> IO a
runPacketFlight :: Context -> PacketFlightM a -> IO a
runPacketFlight ctx :: Context
ctx (PacketFlightM f :: ReaderT (IORef [ByteString]) IO a
f) = do
    IORef [ByteString]
ref <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
newIORef []
    IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally (ReaderT (IORef [ByteString]) IO a -> IORef [ByteString] -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef [ByteString]) IO a
f IORef [ByteString]
ref) (IO () -> IO a) -> IO () -> IO a
forall a b. (a -> b) -> a -> b
$ do
        [ByteString]
st <- IORef [ByteString] -> IO [ByteString]
forall a. IORef a -> IO a
readIORef IORef [ByteString]
ref
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
st) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
sendBytes Context
ctx (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
st

loadPacket13 :: Context -> Packet13 -> PacketFlightM ()
loadPacket13 :: Context -> Packet13 -> PacketFlightM ()
loadPacket13 ctx :: Context
ctx pkt :: Packet13
pkt = ReaderT (IORef [ByteString]) IO () -> PacketFlightM ()
forall a. ReaderT (IORef [ByteString]) IO a -> PacketFlightM a
PacketFlightM (ReaderT (IORef [ByteString]) IO () -> PacketFlightM ())
-> ReaderT (IORef [ByteString]) IO () -> PacketFlightM ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- Context -> Packet13 -> ReaderT (IORef [ByteString]) IO ByteString
forall (m :: * -> *).
MonadIO m =>
Context -> Packet13 -> m ByteString
writePacketBytes13 Context
ctx Packet13
pkt
    IORef [ByteString]
ref <- ReaderT (IORef [ByteString]) IO (IORef [ByteString])
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> ReaderT (IORef [ByteString]) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (IORef [ByteString]) IO ())
-> IO () -> ReaderT (IORef [ByteString]) IO ()
forall a b. (a -> b) -> a -> b
$ IORef [ByteString] -> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [ByteString]
ref (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)