{-# LANGUAGE CPP #-}
module Network.TLS.Record.Reading
( recvRecord
, recvRecord13
) where
import Control.Monad.Reader
import qualified Data.ByteString as B
import Network.TLS.Context.Internal
import Network.TLS.ErrT
import Network.TLS.Hooks
import Network.TLS.Imports
import Network.TLS.Packet
import Network.TLS.Record
import Network.TLS.Struct
exceeds :: Integral ty => Context -> Int -> ty -> Bool
exceeds :: Context -> Int -> ty -> Bool
exceeds Context
ctx Int
overhead ty
actual =
case Context -> Maybe Int
ctxFragmentSize Context
ctx of
Maybe Int
Nothing -> Bool
False
Just Int
sz -> ty -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ty
actual Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
overhead
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 (Context -> Int -> Int -> Bool
forall ty. Integral ty => Context -> Int -> ty -> Bool
exceeds Context
ctx Int
overhead (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length (Fragment Plaintext -> ByteString
forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Plaintext
fragment)) (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
decodeRecordM :: Header -> ByteString -> RecordM (Record Plaintext)
decodeRecordM :: Header -> ByteString -> RecordM (Record Plaintext)
decodeRecordM Header
header ByteString
content = Record Ciphertext -> RecordM (Record Plaintext)
disengageRecord Record Ciphertext
erecord
where
erecord :: Record Ciphertext
erecord = Header -> Fragment Ciphertext -> Record Ciphertext
forall a. Header -> Fragment a -> Record a
rawToRecord Header
header (ByteString -> Fragment Ciphertext
fragmentCiphertext ByteString
content)
contentSizeExceeded :: TLSError
contentSizeExceeded :: TLSError
contentSizeExceeded = (String, Bool, AlertDescription) -> TLSError
Error_Protocol (String
"record content exceeding maximum size", Bool
True, AlertDescription
RecordOverflow)
recvRecord :: Context
-> Bool
-> Int
-> IO (Either TLSError (Record Plaintext))
recvRecord :: Context -> Bool -> Int -> IO (Either TLSError (Record Plaintext))
recvRecord Context
ctx Bool
compatSSLv2 Int
appDataOverhead
#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)
| Context -> Int -> Word16 -> Bool
forall ty. Integral ty => Context -> Int -> ty -> Bool
exceeds Context
ctx Int
2048 Word16
readlen = 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
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)
| Context -> Int -> Word16 -> Bool
forall ty. Integral ty => Context -> Int -> ty -> Bool
exceeds Context
ctx Int
256 Word16
readlen = 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)
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))