module Network.TLS.Struct13 (
    Packet13 (..),
    Handshake13 (..),
    typeOfHandshake13,
    contentType,
    KeyUpdate (..),
) where

import Data.X509 (CertificateChain)
import Network.TLS.Imports
import Network.TLS.Struct
import Network.TLS.Types

data Packet13
    = Handshake13 [Handshake13]
    | Alert13 [(AlertLevel, AlertDescription)]
    | ChangeCipherSpec13
    | AppData13 ByteString
    deriving (Int -> Packet13 -> ShowS
[Packet13] -> ShowS
Packet13 -> String
(Int -> Packet13 -> ShowS)
-> (Packet13 -> String) -> ([Packet13] -> ShowS) -> Show Packet13
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Packet13 -> ShowS
showsPrec :: Int -> Packet13 -> ShowS
$cshow :: Packet13 -> String
show :: Packet13 -> String
$cshowList :: [Packet13] -> ShowS
showList :: [Packet13] -> ShowS
Show, Packet13 -> Packet13 -> Bool
(Packet13 -> Packet13 -> Bool)
-> (Packet13 -> Packet13 -> Bool) -> Eq Packet13
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Packet13 -> Packet13 -> Bool
== :: Packet13 -> Packet13 -> Bool
$c/= :: Packet13 -> Packet13 -> Bool
/= :: Packet13 -> Packet13 -> Bool
Eq)

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

type TicketNonce = ByteString

-- fixme: convert Word32 to proper data type
data Handshake13
    = ServerHello13 ServerRandom Session CipherID [ExtensionRaw]
    | NewSessionTicket13 Second Word32 TicketNonce SessionIDorTicket [ExtensionRaw]
    | EndOfEarlyData13
    | EncryptedExtensions13 [ExtensionRaw]
    | CertRequest13 CertReqContext [ExtensionRaw]
    | Certificate13 CertReqContext CertificateChain [[ExtensionRaw]]
    | CertVerify13 HashAndSignatureAlgorithm Signature
    | Finished13 VerifyData
    | KeyUpdate13 KeyUpdate
    deriving (Int -> Handshake13 -> ShowS
[Handshake13] -> ShowS
Handshake13 -> String
(Int -> Handshake13 -> ShowS)
-> (Handshake13 -> String)
-> ([Handshake13] -> ShowS)
-> Show Handshake13
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Handshake13 -> ShowS
showsPrec :: Int -> Handshake13 -> ShowS
$cshow :: Handshake13 -> String
show :: Handshake13 -> String
$cshowList :: [Handshake13] -> ShowS
showList :: [Handshake13] -> ShowS
Show, Handshake13 -> Handshake13 -> Bool
(Handshake13 -> Handshake13 -> Bool)
-> (Handshake13 -> Handshake13 -> Bool) -> Eq Handshake13
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Handshake13 -> Handshake13 -> Bool
== :: Handshake13 -> Handshake13 -> Bool
$c/= :: Handshake13 -> Handshake13 -> Bool
/= :: Handshake13 -> Handshake13 -> Bool
Eq)

{- FOURMOLU_DISABLE -}
typeOfHandshake13 :: Handshake13 -> HandshakeType
typeOfHandshake13 :: Handshake13 -> HandshakeType
typeOfHandshake13 ServerHello13{}         = HandshakeType
HandshakeType_ServerHello
typeOfHandshake13 EndOfEarlyData13{}      = HandshakeType
HandshakeType_EndOfEarlyData
typeOfHandshake13 NewSessionTicket13{}    = HandshakeType
HandshakeType_NewSessionTicket
typeOfHandshake13 EncryptedExtensions13{} = HandshakeType
HandshakeType_EncryptedExtensions
typeOfHandshake13 CertRequest13{}         = HandshakeType
HandshakeType_CertRequest
typeOfHandshake13 Certificate13{}         = HandshakeType
HandshakeType_Certificate
typeOfHandshake13 CertVerify13{}          = HandshakeType
HandshakeType_CertVerify
typeOfHandshake13 Finished13{}            = HandshakeType
HandshakeType_Finished
typeOfHandshake13 KeyUpdate13{}           = HandshakeType
HandshakeType_KeyUpdate

contentType :: Packet13 -> ProtocolType
contentType :: Packet13 -> ProtocolType
contentType Packet13
ChangeCipherSpec13 = ProtocolType
ProtocolType_ChangeCipherSpec
contentType Handshake13{}      = ProtocolType
ProtocolType_Handshake
contentType Alert13{}          = ProtocolType
ProtocolType_Alert
contentType AppData13{}        = ProtocolType
ProtocolType_AppData
{- FOURMOLU_ENABLE -}