{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.TLS.IO
( sendPacket
, sendPacket13
, recvPacket
, recvPacket13
, isRecvComplete
, checkValid
, 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
sendPacket :: MonadIO m => Context -> Packet -> m ()
sendPacket :: Context -> Packet -> m ()
sendPacket Context
ctx Packet
pkt = do
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)
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
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
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 :: Bool
-> Int
-> 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
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
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
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
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]
:)