-- | TLS record layer in Rx direction
module Network.TLS.Record.Reading (
    recvRecord,
    recvRecord13,
) where

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 :: forall ty. Integral ty => 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)
runRxRecordState 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
        r <- Header -> ByteString -> RecordM (Record Plaintext)
decodeRecordM Header
header ByteString
content
        let Record _ _ fragment = r
        when (exceeds ctx overhead $ B.length (fragmentGetBytes fragment)) $
            throwError contentSizeExceeded
        return 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 -> AlertDescription -> TLSError
Error_Protocol String
"record content exceeding maximum size" AlertDescription
RecordOverflow

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

-- | recvRecord receive a full TLS record (header + data), from the other side.
--
-- The record is disengaged from the record layer
recvRecord
    :: Context
    -- ^ TLS context
    -> Int
    -- ^ number of AppData bytes to accept above normal maximum size
    -> IO (Either TLSError (Record Plaintext))
recvRecord :: Context -> Int -> IO (Either TLSError (Record Plaintext))
recvRecord Context
ctx Int
appDataOverhead =
    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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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)

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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 -> AlertDescription -> TLSError
Error_Protocol String
"record exceeding maximum size" AlertDescription
RecordOverflow

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

readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
readExactBytes Context
ctx Int
sz = do
    hdrbs <- Context -> Int -> IO ByteString
contextRecv Context
ctx Int
sz
    if B.length hdrbs == sz
        then return $ Right hdrbs
        else do
            setEOF ctx
            return . Left $
                if B.null hdrbs
                    then Error_EOF
                    else
                        Error_Packet
                            ( "partial packet: expecting "
                                ++ show sz
                                ++ " bytes, got: "
                                ++ show (B.length hdrbs)
                            )