module Network.QUIC.Crypto.Types (
    -- * Types
    PlainText,
    CipherText,
    Key (..),
    IV (..),
    CID,
    Secret (..),
    AssDat (..),
    Sample (..),
    Mask (..),
    Nonce (..),
    Salt,
    Label (..),
    Cipher,
    InitialSecret,
    TrafficSecrets,
    ClientTrafficSecret (..),
    ServerTrafficSecret (..),
) where

import qualified Data.ByteString.Char8 as C8
import Network.TLS hiding (Version)
import Network.TLS.QUIC

import Network.QUIC.Imports
import Network.QUIC.Types

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

type PlainText = ByteString
type CipherText = ByteString
type Salt = ByteString

newtype Key = Key ByteString deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq)
newtype IV = IV ByteString deriving (IV -> IV -> Bool
(IV -> IV -> Bool) -> (IV -> IV -> Bool) -> Eq IV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IV -> IV -> Bool
== :: IV -> IV -> Bool
$c/= :: IV -> IV -> Bool
/= :: IV -> IV -> Bool
Eq)
newtype Secret = Secret ByteString deriving (Secret -> Secret -> Bool
(Secret -> Secret -> Bool)
-> (Secret -> Secret -> Bool) -> Eq Secret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Secret -> Secret -> Bool
== :: Secret -> Secret -> Bool
$c/= :: Secret -> Secret -> Bool
/= :: Secret -> Secret -> Bool
Eq)
newtype AssDat = AssDat ByteString deriving (AssDat -> AssDat -> Bool
(AssDat -> AssDat -> Bool)
-> (AssDat -> AssDat -> Bool) -> Eq AssDat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssDat -> AssDat -> Bool
== :: AssDat -> AssDat -> Bool
$c/= :: AssDat -> AssDat -> Bool
/= :: AssDat -> AssDat -> Bool
Eq)
newtype Sample = Sample ByteString deriving (Sample -> Sample -> Bool
(Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool) -> Eq Sample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
/= :: Sample -> Sample -> Bool
Eq)
newtype Mask = Mask ByteString deriving (Mask -> Mask -> Bool
(Mask -> Mask -> Bool) -> (Mask -> Mask -> Bool) -> Eq Mask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mask -> Mask -> Bool
== :: Mask -> Mask -> Bool
$c/= :: Mask -> Mask -> Bool
/= :: Mask -> Mask -> Bool
Eq)
newtype Label = Label ByteString deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
Eq)
newtype Nonce = Nonce ByteString deriving (Nonce -> Nonce -> Bool
(Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nonce -> Nonce -> Bool
== :: Nonce -> Nonce -> Bool
$c/= :: Nonce -> Nonce -> Bool
/= :: Nonce -> Nonce -> Bool
Eq)

instance Show Key where
    show :: Key -> String
show (Key ByteString
x) = String
"Key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show IV where
    show :: IV -> String
show (IV ByteString
x) = String
"IV=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show Secret where
    show :: Secret -> String
show (Secret ByteString
x) = String
"Secret=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show AssDat where
    show :: AssDat -> String
show (AssDat ByteString
x) = String
"AssDat=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show Sample where
    show :: Sample -> String
show (Sample ByteString
x) = String
"Sample=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show Mask where
    show :: Mask -> String
show (Mask ByteString
x) = String
"Mask=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show Label where
    show :: Label -> String
show (Label ByteString
x) = String
"Label=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)
instance Show Nonce where
    show :: Nonce -> String
show (Nonce ByteString
x) = String
"Nonce=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack (ByteString -> ByteString
enc16 ByteString
x)

data InitialSecret