{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE PatternSynonyms #-}

module Network.TLS.Types (
    Version (Version, SSL2, SSL3, TLS10, TLS11, TLS12, TLS13),
    SessionID,
    SessionIDorTicket,
    Ticket,
    isTicket,
    toSessionID,
    SessionData (..),
    SessionFlag (..),
    CertReqContext,
    TLS13TicketInfo (..),
    CipherID,
    CompressionID,
    Role (..),
    invertRole,
    Direction (..),
    HostName,
    Second,
    Millisecond,
    EarlySecret,
    HandshakeSecret,
    ApplicationSecret,
    ResumptionSecret,
    BaseSecret (..),
    AnyTrafficSecret (..),
    ClientTrafficSecret (..),
    ServerTrafficSecret (..),
    TrafficSecrets,
    SecretTriple (..),
    SecretPair (..),
    MainSecret (..),
) where

import Codec.Serialise
import qualified Data.ByteString as B
import GHC.Generics
import Network.Socket (HostName)
import Network.TLS.Crypto (Group, Hash (..), hash)
import Network.TLS.Imports

type Second = Word32
type Millisecond = Word64

-- | Versions known to TLS
newtype Version = Version Word16 deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Version -> Rep Version x
from :: forall x. Version -> Rep Version x
$cto :: forall x. Rep Version x -> Version
to :: forall x. Rep Version x -> Version
Generic)
{- FOURMOLU_DISABLE -}
pattern SSL2  :: Version
pattern $mSSL2 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bSSL2 :: Version
SSL2   = Version 0x0200
pattern SSL3  :: Version
pattern $mSSL3 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bSSL3 :: Version
SSL3   = Version 0x0300
pattern TLS10 :: Version
pattern $mTLS10 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bTLS10 :: Version
TLS10  = Version 0x0301
pattern TLS11 :: Version
pattern $mTLS11 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bTLS11 :: Version
TLS11  = Version 0x0302
pattern TLS12 :: Version
pattern $mTLS12 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bTLS12 :: Version
TLS12  = Version 0x0303
pattern TLS13 :: Version
pattern $mTLS13 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bTLS13 :: Version
TLS13  = Version 0x0304

instance Show Version where
    show :: Version -> String
show Version
SSL2  = String
"SSL2"
    show Version
SSL3  = String
"SSL3"
    show Version
TLS10 = String
"TLS1.0"
    show Version
TLS11 = String
"TLS1.1"
    show Version
TLS12 = String
"TLS1.2"
    show Version
TLS13 = String
"TLS1.3"
    show (Version Word16
x) = String
"Version " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
x
{- FOURMOLU_ENABLE -}

-- | A session ID
type SessionID = ByteString

-- | Identity
type SessionIDorTicket = ByteString

-- | Encrypted session ticket (encrypt(encode 'SessionData')).
type Ticket = ByteString

isTicket :: SessionIDorTicket -> Bool
isTicket :: SessionIDorTicket -> Bool
isTicket SessionIDorTicket
x
    | SessionIDorTicket -> Int
B.length SessionIDorTicket
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32 = Bool
True
    | Bool
otherwise = Bool
False

toSessionID :: Ticket -> SessionID
toSessionID :: SessionIDorTicket -> SessionIDorTicket
toSessionID = Hash -> SessionIDorTicket -> SessionIDorTicket
hash Hash
SHA256

-- | Session data to resume
data SessionData = SessionData
    { SessionData -> Version
sessionVersion :: Version
    , SessionData -> Word16
sessionCipher :: CipherID
    , SessionData -> CompressionID
sessionCompression :: CompressionID
    , SessionData -> Maybe String
sessionClientSNI :: Maybe HostName
    , SessionData -> SessionIDorTicket
sessionSecret :: ByteString
    , SessionData -> Maybe Group
sessionGroup :: Maybe Group
    , SessionData -> Maybe TLS13TicketInfo
sessionTicketInfo :: Maybe TLS13TicketInfo
    , SessionData -> Maybe SessionIDorTicket
sessionALPN :: Maybe ByteString
    , SessionData -> Int
sessionMaxEarlyDataSize :: Int
    , SessionData -> [SessionFlag]
sessionFlags :: [SessionFlag]
    } -- sessionFromTicket :: Bool
    deriving (Int -> SessionData -> ShowS
[SessionData] -> ShowS
SessionData -> String
(Int -> SessionData -> ShowS)
-> (SessionData -> String)
-> ([SessionData] -> ShowS)
-> Show SessionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionData -> ShowS
showsPrec :: Int -> SessionData -> ShowS
$cshow :: SessionData -> String
show :: SessionData -> String
$cshowList :: [SessionData] -> ShowS
showList :: [SessionData] -> ShowS
Show, SessionData -> SessionData -> Bool
(SessionData -> SessionData -> Bool)
-> (SessionData -> SessionData -> Bool) -> Eq SessionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionData -> SessionData -> Bool
== :: SessionData -> SessionData -> Bool
$c/= :: SessionData -> SessionData -> Bool
/= :: SessionData -> SessionData -> Bool
Eq, (forall x. SessionData -> Rep SessionData x)
-> (forall x. Rep SessionData x -> SessionData)
-> Generic SessionData
forall x. Rep SessionData x -> SessionData
forall x. SessionData -> Rep SessionData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SessionData -> Rep SessionData x
from :: forall x. SessionData -> Rep SessionData x
$cto :: forall x. Rep SessionData x -> SessionData
to :: forall x. Rep SessionData x -> SessionData
Generic)

-- | Some session flags
data SessionFlag
    = -- | Session created with Extended Main Secret
      SessionEMS
    deriving (Int -> SessionFlag -> ShowS
[SessionFlag] -> ShowS
SessionFlag -> String
(Int -> SessionFlag -> ShowS)
-> (SessionFlag -> String)
-> ([SessionFlag] -> ShowS)
-> Show SessionFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionFlag -> ShowS
showsPrec :: Int -> SessionFlag -> ShowS
$cshow :: SessionFlag -> String
show :: SessionFlag -> String
$cshowList :: [SessionFlag] -> ShowS
showList :: [SessionFlag] -> ShowS
Show, SessionFlag -> SessionFlag -> Bool
(SessionFlag -> SessionFlag -> Bool)
-> (SessionFlag -> SessionFlag -> Bool) -> Eq SessionFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionFlag -> SessionFlag -> Bool
== :: SessionFlag -> SessionFlag -> Bool
$c/= :: SessionFlag -> SessionFlag -> Bool
/= :: SessionFlag -> SessionFlag -> Bool
Eq, Int -> SessionFlag
SessionFlag -> Int
SessionFlag -> [SessionFlag]
SessionFlag -> SessionFlag
SessionFlag -> SessionFlag -> [SessionFlag]
SessionFlag -> SessionFlag -> SessionFlag -> [SessionFlag]
(SessionFlag -> SessionFlag)
-> (SessionFlag -> SessionFlag)
-> (Int -> SessionFlag)
-> (SessionFlag -> Int)
-> (SessionFlag -> [SessionFlag])
-> (SessionFlag -> SessionFlag -> [SessionFlag])
-> (SessionFlag -> SessionFlag -> [SessionFlag])
-> (SessionFlag -> SessionFlag -> SessionFlag -> [SessionFlag])
-> Enum SessionFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SessionFlag -> SessionFlag
succ :: SessionFlag -> SessionFlag
$cpred :: SessionFlag -> SessionFlag
pred :: SessionFlag -> SessionFlag
$ctoEnum :: Int -> SessionFlag
toEnum :: Int -> SessionFlag
$cfromEnum :: SessionFlag -> Int
fromEnum :: SessionFlag -> Int
$cenumFrom :: SessionFlag -> [SessionFlag]
enumFrom :: SessionFlag -> [SessionFlag]
$cenumFromThen :: SessionFlag -> SessionFlag -> [SessionFlag]
enumFromThen :: SessionFlag -> SessionFlag -> [SessionFlag]
$cenumFromTo :: SessionFlag -> SessionFlag -> [SessionFlag]
enumFromTo :: SessionFlag -> SessionFlag -> [SessionFlag]
$cenumFromThenTo :: SessionFlag -> SessionFlag -> SessionFlag -> [SessionFlag]
enumFromThenTo :: SessionFlag -> SessionFlag -> SessionFlag -> [SessionFlag]
Enum, (forall x. SessionFlag -> Rep SessionFlag x)
-> (forall x. Rep SessionFlag x -> SessionFlag)
-> Generic SessionFlag
forall x. Rep SessionFlag x -> SessionFlag
forall x. SessionFlag -> Rep SessionFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SessionFlag -> Rep SessionFlag x
from :: forall x. SessionFlag -> Rep SessionFlag x
$cto :: forall x. Rep SessionFlag x -> SessionFlag
to :: forall x. Rep SessionFlag x -> SessionFlag
Generic)

-- | Certificate request context for TLS 1.3.
type CertReqContext = ByteString

data TLS13TicketInfo = TLS13TicketInfo
    { TLS13TicketInfo -> Second
lifetime :: Second -- NewSessionTicket.ticket_lifetime in seconds
    , TLS13TicketInfo -> Second
ageAdd :: Second -- NewSessionTicket.ticket_age_add
    , TLS13TicketInfo -> Millisecond
txrxTime :: Millisecond -- serverSendTime or clientReceiveTime
    , TLS13TicketInfo -> Maybe Millisecond
estimatedRTT :: Maybe Millisecond
    }
    deriving (Int -> TLS13TicketInfo -> ShowS
[TLS13TicketInfo] -> ShowS
TLS13TicketInfo -> String
(Int -> TLS13TicketInfo -> ShowS)
-> (TLS13TicketInfo -> String)
-> ([TLS13TicketInfo] -> ShowS)
-> Show TLS13TicketInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLS13TicketInfo -> ShowS
showsPrec :: Int -> TLS13TicketInfo -> ShowS
$cshow :: TLS13TicketInfo -> String
show :: TLS13TicketInfo -> String
$cshowList :: [TLS13TicketInfo] -> ShowS
showList :: [TLS13TicketInfo] -> ShowS
Show, TLS13TicketInfo -> TLS13TicketInfo -> Bool
(TLS13TicketInfo -> TLS13TicketInfo -> Bool)
-> (TLS13TicketInfo -> TLS13TicketInfo -> Bool)
-> Eq TLS13TicketInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLS13TicketInfo -> TLS13TicketInfo -> Bool
== :: TLS13TicketInfo -> TLS13TicketInfo -> Bool
$c/= :: TLS13TicketInfo -> TLS13TicketInfo -> Bool
/= :: TLS13TicketInfo -> TLS13TicketInfo -> Bool
Eq, (forall x. TLS13TicketInfo -> Rep TLS13TicketInfo x)
-> (forall x. Rep TLS13TicketInfo x -> TLS13TicketInfo)
-> Generic TLS13TicketInfo
forall x. Rep TLS13TicketInfo x -> TLS13TicketInfo
forall x. TLS13TicketInfo -> Rep TLS13TicketInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TLS13TicketInfo -> Rep TLS13TicketInfo x
from :: forall x. TLS13TicketInfo -> Rep TLS13TicketInfo x
$cto :: forall x. Rep TLS13TicketInfo x -> TLS13TicketInfo
to :: forall x. Rep TLS13TicketInfo x -> TLS13TicketInfo
Generic)

-- | Cipher identification
type CipherID = Word16

-- | Compression identification
type CompressionID = Word8

-- | Role
data Role = ClientRole | ServerRole
    deriving (Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq)

-- | Direction
data Direction = Tx | Rx
    deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq)

invertRole :: Role -> Role
invertRole :: Role -> Role
invertRole Role
ClientRole = Role
ServerRole
invertRole Role
ServerRole = Role
ClientRole

-- | Phantom type indicating early traffic secret.
data EarlySecret

-- | Phantom type indicating handshake traffic secrets.
data HandshakeSecret

-- | Phantom type indicating application traffic secrets.
data ApplicationSecret

data ResumptionSecret

newtype BaseSecret a = BaseSecret ByteString deriving (Int -> BaseSecret a -> ShowS
[BaseSecret a] -> ShowS
BaseSecret a -> String
(Int -> BaseSecret a -> ShowS)
-> (BaseSecret a -> String)
-> ([BaseSecret a] -> ShowS)
-> Show (BaseSecret a)
forall a. Int -> BaseSecret a -> ShowS
forall a. [BaseSecret a] -> ShowS
forall a. BaseSecret a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> BaseSecret a -> ShowS
showsPrec :: Int -> BaseSecret a -> ShowS
$cshow :: forall a. BaseSecret a -> String
show :: BaseSecret a -> String
$cshowList :: forall a. [BaseSecret a] -> ShowS
showList :: [BaseSecret a] -> ShowS
Show)
newtype AnyTrafficSecret a = AnyTrafficSecret ByteString deriving (Int -> AnyTrafficSecret a -> ShowS
[AnyTrafficSecret a] -> ShowS
AnyTrafficSecret a -> String
(Int -> AnyTrafficSecret a -> ShowS)
-> (AnyTrafficSecret a -> String)
-> ([AnyTrafficSecret a] -> ShowS)
-> Show (AnyTrafficSecret a)
forall a. Int -> AnyTrafficSecret a -> ShowS
forall a. [AnyTrafficSecret a] -> ShowS
forall a. AnyTrafficSecret a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> AnyTrafficSecret a -> ShowS
showsPrec :: Int -> AnyTrafficSecret a -> ShowS
$cshow :: forall a. AnyTrafficSecret a -> String
show :: AnyTrafficSecret a -> String
$cshowList :: forall a. [AnyTrafficSecret a] -> ShowS
showList :: [AnyTrafficSecret a] -> ShowS
Show)

-- | A client traffic secret, typed with a parameter indicating a step in the
-- TLS key schedule.
newtype ClientTrafficSecret a = ClientTrafficSecret ByteString deriving (Int -> ClientTrafficSecret a -> ShowS
[ClientTrafficSecret a] -> ShowS
ClientTrafficSecret a -> String
(Int -> ClientTrafficSecret a -> ShowS)
-> (ClientTrafficSecret a -> String)
-> ([ClientTrafficSecret a] -> ShowS)
-> Show (ClientTrafficSecret a)
forall a. Int -> ClientTrafficSecret a -> ShowS
forall a. [ClientTrafficSecret a] -> ShowS
forall a. ClientTrafficSecret a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> ClientTrafficSecret a -> ShowS
showsPrec :: Int -> ClientTrafficSecret a -> ShowS
$cshow :: forall a. ClientTrafficSecret a -> String
show :: ClientTrafficSecret a -> String
$cshowList :: forall a. [ClientTrafficSecret a] -> ShowS
showList :: [ClientTrafficSecret a] -> ShowS
Show)

-- | A server traffic secret, typed with a parameter indicating a step in the
-- TLS key schedule.
newtype ServerTrafficSecret a = ServerTrafficSecret ByteString deriving (Int -> ServerTrafficSecret a -> ShowS
[ServerTrafficSecret a] -> ShowS
ServerTrafficSecret a -> String
(Int -> ServerTrafficSecret a -> ShowS)
-> (ServerTrafficSecret a -> String)
-> ([ServerTrafficSecret a] -> ShowS)
-> Show (ServerTrafficSecret a)
forall a. Int -> ServerTrafficSecret a -> ShowS
forall a. [ServerTrafficSecret a] -> ShowS
forall a. ServerTrafficSecret a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> ServerTrafficSecret a -> ShowS
showsPrec :: Int -> ServerTrafficSecret a -> ShowS
$cshow :: forall a. ServerTrafficSecret a -> String
show :: ServerTrafficSecret a -> String
$cshowList :: forall a. [ServerTrafficSecret a] -> ShowS
showList :: [ServerTrafficSecret a] -> ShowS
Show)

data SecretTriple a = SecretTriple
    { forall a. SecretTriple a -> BaseSecret a
triBase :: BaseSecret a
    , forall a. SecretTriple a -> ClientTrafficSecret a
triClient :: ClientTrafficSecret a
    , forall a. SecretTriple a -> ServerTrafficSecret a
triServer :: ServerTrafficSecret a
    }
    deriving (Int -> SecretTriple a -> ShowS
[SecretTriple a] -> ShowS
SecretTriple a -> String
(Int -> SecretTriple a -> ShowS)
-> (SecretTriple a -> String)
-> ([SecretTriple a] -> ShowS)
-> Show (SecretTriple a)
forall a. Int -> SecretTriple a -> ShowS
forall a. [SecretTriple a] -> ShowS
forall a. SecretTriple a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> SecretTriple a -> ShowS
showsPrec :: Int -> SecretTriple a -> ShowS
$cshow :: forall a. SecretTriple a -> String
show :: SecretTriple a -> String
$cshowList :: forall a. [SecretTriple a] -> ShowS
showList :: [SecretTriple a] -> ShowS
Show)

data SecretPair a = SecretPair
    { forall a. SecretPair a -> BaseSecret a
pairBase :: BaseSecret a
    , forall a. SecretPair a -> ClientTrafficSecret a
pairClient :: ClientTrafficSecret a
    }

-- | Hold both client and server traffic secrets at the same step.
type TrafficSecrets a = (ClientTrafficSecret a, ServerTrafficSecret a)

-- Main secret for TLS 1.2 or earlier.
newtype MainSecret = MainSecret ByteString deriving (Int -> MainSecret -> ShowS
[MainSecret] -> ShowS
MainSecret -> String
(Int -> MainSecret -> ShowS)
-> (MainSecret -> String)
-> ([MainSecret] -> ShowS)
-> Show MainSecret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MainSecret -> ShowS
showsPrec :: Int -> MainSecret -> ShowS
$cshow :: MainSecret -> String
show :: MainSecret -> String
$cshowList :: [MainSecret] -> ShowS
showList :: [MainSecret] -> ShowS
Show)

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

instance Serialise Version
instance Serialise TLS13TicketInfo
instance Serialise SessionFlag
instance Serialise SessionData