{-# LANGUAGE EmptyDataDecls #-}
-- |
-- Module      : Network.TLS.Record.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- 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 Network.TLS.Struct
import Network.TLS.Imports
import Network.TLS.Record.State
import qualified Data.ByteString as B

-- | 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
showList :: [Record a] -> ShowS
$cshowList :: forall a. [Record a] -> ShowS
show :: Record a -> String
$cshow :: forall a. Record a -> String
showsPrec :: Int -> Record a -> ShowS
$cshowsPrec :: forall a. Int -> 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
/= :: Record a -> Record a -> Bool
$c/= :: forall a. Record a -> Record a -> Bool
== :: Record a -> Record a -> Bool
$c== :: forall a. Record a -> Record a -> Bool
Eq)

newtype Fragment a = Fragment { 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
showList :: [Fragment a] -> ShowS
$cshowList :: forall a. [Fragment a] -> ShowS
show :: Fragment a -> String
$cshow :: forall a. Fragment a -> String
showsPrec :: Int -> Fragment a -> ShowS
$cshowsPrec :: forall a. Int -> 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
/= :: Fragment a -> Fragment a -> Bool
$c/= :: forall a. Fragment a -> Fragment a -> Bool
== :: Fragment a -> Fragment a -> Bool
$c== :: forall a. 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 :: 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 :: (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 :: 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 :: 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 :: 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)