{-# LANGUAGE EmptyDataDecls #-}

-- | The Record Protocol takes messages to be transmitted, fragments
-- the data into manageable blocks, optionally compresses the data,
-- applies a MAC, encrypts, and transmits the result.  Received data
-- is decrypted, verified, decompressed, reassembled, and then
-- delivered to higher-level clients.
module Network.TLS.Record.Types (
    Header (..),
    ProtocolType (..),
    packetType,

    -- * TLS Records
    Record (..),

    -- * TLS Record fragment and constructors
    Fragment,
    fragmentGetBytes,
    fragmentPlaintext,
    fragmentCompressed,
    fragmentCiphertext,
    Plaintext,
    Compressed,
    Ciphertext,

    -- * manipulate record
    onRecordFragment,
    fragmentCompress,
    fragmentCipher,
    fragmentUncipher,
    fragmentUncompress,

    -- * serialize record
    rawToRecord,
    recordToRaw,
    recordToHeader,
) where

import qualified Data.ByteString as B
import Network.TLS.Imports
import Network.TLS.Record.State
import Network.TLS.Struct

-- | Represent a TLS record.
data Record a = Record ProtocolType Version (Fragment a) deriving (Int -> Record a -> ShowS
[Record a] -> ShowS
Record a -> String
(Int -> Record a -> ShowS)
-> (Record a -> String) -> ([Record a] -> ShowS) -> Show (Record a)
forall a. Int -> Record a -> ShowS
forall a. [Record a] -> ShowS
forall a. Record a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Record a -> ShowS
showsPrec :: Int -> Record a -> ShowS
$cshow :: forall a. Record a -> String
show :: Record a -> String
$cshowList :: forall a. [Record a] -> ShowS
showList :: [Record a] -> ShowS
Show, Record a -> Record a -> Bool
(Record a -> Record a -> Bool)
-> (Record a -> Record a -> Bool) -> Eq (Record a)
forall a. Record a -> Record a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Record a -> Record a -> Bool
== :: Record a -> Record a -> Bool
$c/= :: forall a. Record a -> Record a -> Bool
/= :: Record a -> Record a -> Bool
Eq)

newtype Fragment a = Fragment {forall a. Fragment a -> ByteString
fragmentGetBytes :: ByteString}
    deriving (Int -> Fragment a -> ShowS
[Fragment a] -> ShowS
Fragment a -> String
(Int -> Fragment a -> ShowS)
-> (Fragment a -> String)
-> ([Fragment a] -> ShowS)
-> Show (Fragment a)
forall a. Int -> Fragment a -> ShowS
forall a. [Fragment a] -> ShowS
forall a. Fragment a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Fragment a -> ShowS
showsPrec :: Int -> Fragment a -> ShowS
$cshow :: forall a. Fragment a -> String
show :: Fragment a -> String
$cshowList :: forall a. [Fragment a] -> ShowS
showList :: [Fragment a] -> ShowS
Show, Fragment a -> Fragment a -> Bool
(Fragment a -> Fragment a -> Bool)
-> (Fragment a -> Fragment a -> Bool) -> Eq (Fragment a)
forall a. Fragment a -> Fragment a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Fragment a -> Fragment a -> Bool
== :: Fragment a -> Fragment a -> Bool
$c/= :: forall a. Fragment a -> Fragment a -> Bool
/= :: Fragment a -> Fragment a -> Bool
Eq)

data Plaintext
data Compressed
data Ciphertext

fragmentPlaintext :: ByteString -> Fragment Plaintext
fragmentPlaintext :: ByteString -> Fragment Plaintext
fragmentPlaintext ByteString
bytes = ByteString -> Fragment Plaintext
forall a. ByteString -> Fragment a
Fragment ByteString
bytes

fragmentCompressed :: ByteString -> Fragment Compressed
fragmentCompressed :: ByteString -> Fragment Compressed
fragmentCompressed ByteString
bytes = ByteString -> Fragment Compressed
forall a. ByteString -> Fragment a
Fragment ByteString
bytes

fragmentCiphertext :: ByteString -> Fragment Ciphertext
fragmentCiphertext :: ByteString -> Fragment Ciphertext
fragmentCiphertext ByteString
bytes = ByteString -> Fragment Ciphertext
forall a. ByteString -> Fragment a
Fragment ByteString
bytes

onRecordFragment
    :: Record a -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
onRecordFragment :: forall a b.
Record a
-> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
onRecordFragment (Record ProtocolType
pt Version
ver Fragment a
frag) Fragment a -> RecordM (Fragment b)
f = ProtocolType -> Version -> Fragment b -> Record b
forall a. ProtocolType -> Version -> Fragment a -> Record a
Record ProtocolType
pt Version
ver (Fragment b -> Record b)
-> RecordM (Fragment b) -> RecordM (Record b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fragment a -> RecordM (Fragment b)
f Fragment a
frag

fragmentMap
    :: (ByteString -> RecordM ByteString) -> Fragment a -> RecordM (Fragment b)
fragmentMap :: forall a b.
(ByteString -> RecordM ByteString)
-> Fragment a -> RecordM (Fragment b)
fragmentMap ByteString -> RecordM ByteString
f (Fragment ByteString
b) = ByteString -> Fragment b
forall a. ByteString -> Fragment a
Fragment (ByteString -> Fragment b)
-> RecordM ByteString -> RecordM (Fragment b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> RecordM ByteString
f ByteString
b

-- | turn a plaintext record into a compressed record using the compression function supplied
fragmentCompress
    :: (ByteString -> RecordM ByteString)
    -> Fragment Plaintext
    -> RecordM (Fragment Compressed)
fragmentCompress :: (ByteString -> RecordM ByteString)
-> Fragment Plaintext -> RecordM (Fragment Compressed)
fragmentCompress ByteString -> RecordM ByteString
f = (ByteString -> RecordM ByteString)
-> Fragment Plaintext -> RecordM (Fragment Compressed)
forall a b.
(ByteString -> RecordM ByteString)
-> Fragment a -> RecordM (Fragment b)
fragmentMap ByteString -> RecordM ByteString
f

-- | turn a compressed record into a ciphertext record using the cipher function supplied
fragmentCipher
    :: (ByteString -> RecordM ByteString)
    -> Fragment Compressed
    -> RecordM (Fragment Ciphertext)
fragmentCipher :: (ByteString -> RecordM ByteString)
-> Fragment Compressed -> RecordM (Fragment Ciphertext)
fragmentCipher ByteString -> RecordM ByteString
f = (ByteString -> RecordM ByteString)
-> Fragment Compressed -> RecordM (Fragment Ciphertext)
forall a b.
(ByteString -> RecordM ByteString)
-> Fragment a -> RecordM (Fragment b)
fragmentMap ByteString -> RecordM ByteString
f

-- | turn a ciphertext fragment into a compressed fragment using the cipher function supplied
fragmentUncipher
    :: (ByteString -> RecordM ByteString)
    -> Fragment Ciphertext
    -> RecordM (Fragment Compressed)
fragmentUncipher :: (ByteString -> RecordM ByteString)
-> Fragment Ciphertext -> RecordM (Fragment Compressed)
fragmentUncipher ByteString -> RecordM ByteString
f = (ByteString -> RecordM ByteString)
-> Fragment Ciphertext -> RecordM (Fragment Compressed)
forall a b.
(ByteString -> RecordM ByteString)
-> Fragment a -> RecordM (Fragment b)
fragmentMap ByteString -> RecordM ByteString
f

-- | turn a compressed fragment into a plaintext fragment using the decompression function supplied
fragmentUncompress
    :: (ByteString -> RecordM ByteString)
    -> Fragment Compressed
    -> RecordM (Fragment Plaintext)
fragmentUncompress :: (ByteString -> RecordM ByteString)
-> Fragment Compressed -> RecordM (Fragment Plaintext)
fragmentUncompress ByteString -> RecordM ByteString
f = (ByteString -> RecordM ByteString)
-> Fragment Compressed -> RecordM (Fragment Plaintext)
forall a b.
(ByteString -> RecordM ByteString)
-> Fragment a -> RecordM (Fragment b)
fragmentMap ByteString -> RecordM ByteString
f

-- | turn a record into an header and bytes
recordToRaw :: Record a -> (Header, ByteString)
recordToRaw :: forall a. Record a -> (Header, ByteString)
recordToRaw (Record ProtocolType
pt Version
ver (Fragment ByteString
bytes)) = (ProtocolType -> Version -> Word16 -> Header
Header ProtocolType
pt Version
ver (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bytes), ByteString
bytes)

-- | turn a header and a fragment into a record
rawToRecord :: Header -> Fragment a -> Record a
rawToRecord :: forall a. Header -> Fragment a -> Record a
rawToRecord (Header ProtocolType
pt Version
ver Word16
_) Fragment a
fragment = ProtocolType -> Version -> Fragment a -> Record a
forall a. ProtocolType -> Version -> Fragment a -> Record a
Record ProtocolType
pt Version
ver Fragment a
fragment

-- | turn a record into a header
recordToHeader :: Record a -> Header
recordToHeader :: forall a. Record a -> Header
recordToHeader (Record ProtocolType
pt Version
ver (Fragment ByteString
bytes)) = ProtocolType -> Version -> Word16 -> Header
Header ProtocolType
pt Version
ver (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bytes)