{-# 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 Context
ctx 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 ByteString
b) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
B.null ByteString
b
        isNonNullAppData Packet
_           = Bool
False

writePacketBytes :: MonadIO m => Context -> Packet -> m ByteString
writePacketBytes :: Context -> Packet -> m ByteString
writePacketBytes Context
ctx 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 -> 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 Context
ctx 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 Context
ctx 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 -> 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 Context
ctx 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 -> 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 Context
ctx Int
appDataOverhead header :: Header
header@(Header ProtocolType
pt Version
_ Word16
_) 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 -> 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 ProtocolType
_ Version
_ 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
> Int
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 Int
0


contentSizeExceeded :: TLSError
contentSizeExceeded :: TLSError
contentSizeExceeded = (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
"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 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 Int
256 else Int
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 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 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 [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 ->
                                    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
_                     -> 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 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 -> 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
                        Either TLSError Packet
_       -> () -> 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 Bool
compatSSLv2 Int
appDataOverhead Context
ctx
#ifdef SSLV2_COMPATIBLE
    | Bool
compatSSLv2 = Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx Int
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 Int
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 ProtocolType
_ Version
_ Word16
readlen)
                | Word16
readlen Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
16384 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
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 ByteString
header =
                if ByteString -> Word8
B.head ByteString
header Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
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 Int
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 Word16
readlen
                | Word16
readlen Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
1024 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
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 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 ByteString
content ->
                        let hdr :: Either TLSError Header
hdr = Word16 -> ByteString -> Either TLSError Header
decodeDeprecatedHeader Word16
readlen (Int -> ByteString -> ByteString
B.take Int
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) (\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
ProtocolType_ChangeCipherSpec Version
_ Fragment a
_) = Bool
True
isCCS Record a
_                                          = Bool
False

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

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

recvPacket13 :: MonadIO m => Context -> m (Either TLSError Packet13)
recvPacket13 :: Context -> m (Either TLSError Packet13)
recvPacket13 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 (String
_, Bool
True, AlertDescription
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 Int
n
                    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
- Int
1)
                                  Context -> IO (Either TLSError Packet13)
forall (m :: * -> *).
MonadIO m =>
Context -> m (Either TLSError Packet13)
recvPacket13 Context
ctx
                Established
_           -> 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 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 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 [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 ->
                                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
_                       -> 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 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 -> 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
                    Either TLSError Packet13
_       -> () -> 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 Context
ctx = Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx Int
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 ProtocolType
_ Version
_ Word16
readlen)
          | Word16
readlen Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
16384 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
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 Int
0 Header
header)

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

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

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

readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx 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 (String
"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]
++ String
" 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 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 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 String
"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 Context
ctx (PacketFlightM 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 Context
ctx 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]
:)