{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}

module Network.TLS.Types.Cipher where

import Crypto.Cipher.Types (AuthTag)
import Data.IORef
import GHC.Generics
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf

import Network.TLS.Crypto (Hash (..))
import Network.TLS.Imports
import Network.TLS.Types.Version

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

-- | Cipher identification
type CipherID = Word16

newtype CipherId = CipherId {CipherId -> Word16
fromCipherId :: Word16}
    deriving (CipherId -> CipherId -> Bool
(CipherId -> CipherId -> Bool)
-> (CipherId -> CipherId -> Bool) -> Eq CipherId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherId -> CipherId -> Bool
== :: CipherId -> CipherId -> Bool
$c/= :: CipherId -> CipherId -> Bool
/= :: CipherId -> CipherId -> Bool
Eq, Eq CipherId
Eq CipherId =>
(CipherId -> CipherId -> Ordering)
-> (CipherId -> CipherId -> Bool)
-> (CipherId -> CipherId -> Bool)
-> (CipherId -> CipherId -> Bool)
-> (CipherId -> CipherId -> Bool)
-> (CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> CipherId)
-> Ord CipherId
CipherId -> CipherId -> Bool
CipherId -> CipherId -> Ordering
CipherId -> CipherId -> CipherId
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 :: CipherId -> CipherId -> Ordering
compare :: CipherId -> CipherId -> Ordering
$c< :: CipherId -> CipherId -> Bool
< :: CipherId -> CipherId -> Bool
$c<= :: CipherId -> CipherId -> Bool
<= :: CipherId -> CipherId -> Bool
$c> :: CipherId -> CipherId -> Bool
> :: CipherId -> CipherId -> Bool
$c>= :: CipherId -> CipherId -> Bool
>= :: CipherId -> CipherId -> Bool
$cmax :: CipherId -> CipherId -> CipherId
max :: CipherId -> CipherId -> CipherId
$cmin :: CipherId -> CipherId -> CipherId
min :: CipherId -> CipherId -> CipherId
Ord, Int -> CipherId
CipherId -> Int
CipherId -> [CipherId]
CipherId -> CipherId
CipherId -> CipherId -> [CipherId]
CipherId -> CipherId -> CipherId -> [CipherId]
(CipherId -> CipherId)
-> (CipherId -> CipherId)
-> (Int -> CipherId)
-> (CipherId -> Int)
-> (CipherId -> [CipherId])
-> (CipherId -> CipherId -> [CipherId])
-> (CipherId -> CipherId -> [CipherId])
-> (CipherId -> CipherId -> CipherId -> [CipherId])
-> Enum CipherId
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 :: CipherId -> CipherId
succ :: CipherId -> CipherId
$cpred :: CipherId -> CipherId
pred :: CipherId -> CipherId
$ctoEnum :: Int -> CipherId
toEnum :: Int -> CipherId
$cfromEnum :: CipherId -> Int
fromEnum :: CipherId -> Int
$cenumFrom :: CipherId -> [CipherId]
enumFrom :: CipherId -> [CipherId]
$cenumFromThen :: CipherId -> CipherId -> [CipherId]
enumFromThen :: CipherId -> CipherId -> [CipherId]
$cenumFromTo :: CipherId -> CipherId -> [CipherId]
enumFromTo :: CipherId -> CipherId -> [CipherId]
$cenumFromThenTo :: CipherId -> CipherId -> CipherId -> [CipherId]
enumFromThenTo :: CipherId -> CipherId -> CipherId -> [CipherId]
Enum, Integer -> CipherId
CipherId -> CipherId
CipherId -> CipherId -> CipherId
(CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId)
-> (CipherId -> CipherId)
-> (CipherId -> CipherId)
-> (Integer -> CipherId)
-> Num CipherId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: CipherId -> CipherId -> CipherId
+ :: CipherId -> CipherId -> CipherId
$c- :: CipherId -> CipherId -> CipherId
- :: CipherId -> CipherId -> CipherId
$c* :: CipherId -> CipherId -> CipherId
* :: CipherId -> CipherId -> CipherId
$cnegate :: CipherId -> CipherId
negate :: CipherId -> CipherId
$cabs :: CipherId -> CipherId
abs :: CipherId -> CipherId
$csignum :: CipherId -> CipherId
signum :: CipherId -> CipherId
$cfromInteger :: Integer -> CipherId
fromInteger :: Integer -> CipherId
Num, Enum CipherId
Real CipherId
(Real CipherId, Enum CipherId) =>
(CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> CipherId)
-> (CipherId -> CipherId -> (CipherId, CipherId))
-> (CipherId -> CipherId -> (CipherId, CipherId))
-> (CipherId -> Integer)
-> Integral CipherId
CipherId -> Integer
CipherId -> CipherId -> (CipherId, CipherId)
CipherId -> CipherId -> CipherId
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: CipherId -> CipherId -> CipherId
quot :: CipherId -> CipherId -> CipherId
$crem :: CipherId -> CipherId -> CipherId
rem :: CipherId -> CipherId -> CipherId
$cdiv :: CipherId -> CipherId -> CipherId
div :: CipherId -> CipherId -> CipherId
$cmod :: CipherId -> CipherId -> CipherId
mod :: CipherId -> CipherId -> CipherId
$cquotRem :: CipherId -> CipherId -> (CipherId, CipherId)
quotRem :: CipherId -> CipherId -> (CipherId, CipherId)
$cdivMod :: CipherId -> CipherId -> (CipherId, CipherId)
divMod :: CipherId -> CipherId -> (CipherId, CipherId)
$ctoInteger :: CipherId -> Integer
toInteger :: CipherId -> Integer
Integral, Num CipherId
Ord CipherId
(Num CipherId, Ord CipherId) =>
(CipherId -> Rational) -> Real CipherId
CipherId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: CipherId -> Rational
toRational :: CipherId -> Rational
Real, ReadPrec [CipherId]
ReadPrec CipherId
Int -> ReadS CipherId
ReadS [CipherId]
(Int -> ReadS CipherId)
-> ReadS [CipherId]
-> ReadPrec CipherId
-> ReadPrec [CipherId]
-> Read CipherId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CipherId
readsPrec :: Int -> ReadS CipherId
$creadList :: ReadS [CipherId]
readList :: ReadS [CipherId]
$creadPrec :: ReadPrec CipherId
readPrec :: ReadPrec CipherId
$creadListPrec :: ReadPrec [CipherId]
readListPrec :: ReadPrec [CipherId]
Read, (forall x. CipherId -> Rep CipherId x)
-> (forall x. Rep CipherId x -> CipherId) -> Generic CipherId
forall x. Rep CipherId x -> CipherId
forall x. CipherId -> Rep CipherId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CipherId -> Rep CipherId x
from :: forall x. CipherId -> Rep CipherId x
$cto :: forall x. Rep CipherId x -> CipherId
to :: forall x. Rep CipherId x -> CipherId
Generic)

instance Show CipherId where
    show :: CipherId -> String
show (CipherId Word16
0x00FF) = String
"TLS_EMPTY_RENEGOTIATION_INFO_SCSV"
    show (CipherId Word16
n) = case (Cipher -> Bool) -> [Cipher] -> Maybe Cipher
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Cipher -> Bool
eqID [Cipher]
dict of
        Just Cipher
c -> Cipher -> String
cipherName Cipher
c
        Maybe Cipher
Nothing -> String -> Word16 -> String
forall r. PrintfType r => String -> r
printf String
"0x%04X" Word16
n
      where
        eqID :: Cipher -> Bool
eqID Cipher
c = Cipher -> Word16
cipherID Cipher
c Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
n
        dict :: [Cipher]
dict = IO [Cipher] -> [Cipher]
forall a. IO a -> a
unsafePerformIO (IO [Cipher] -> [Cipher]) -> IO [Cipher] -> [Cipher]
forall a b. (a -> b) -> a -> b
$ IORef [Cipher] -> IO [Cipher]
forall a. IORef a -> IO a
readIORef IORef [Cipher]
globalCipherDict

-- "ciphersuite" is designed extensible.
-- So, it's not available from internal modules.
-- This is a compromise to gule "ciphersuite" to Show CipherID.

{-# NOINLINE globalCipherDict #-}
globalCipherDict :: IORef [Cipher]
globalCipherDict :: IORef [Cipher]
globalCipherDict = IO (IORef [Cipher]) -> IORef [Cipher]
forall a. IO a -> a
unsafePerformIO (IO (IORef [Cipher]) -> IORef [Cipher])
-> IO (IORef [Cipher]) -> IORef [Cipher]
forall a b. (a -> b) -> a -> b
$ [Cipher] -> IO (IORef [Cipher])
forall a. a -> IO (IORef a)
newIORef []

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

-- | Cipher algorithm
data Cipher = Cipher
    { Cipher -> Word16
cipherID :: CipherID
    , Cipher -> String
cipherName :: String
    , Cipher -> Hash
cipherHash :: Hash
    , Cipher -> Bulk
cipherBulk :: Bulk
    , Cipher -> CipherKeyExchangeType
cipherKeyExchange :: CipherKeyExchangeType
    , Cipher -> Maybe Version
cipherMinVer :: Maybe Version
    , Cipher -> Maybe Hash
cipherPRFHash :: Maybe Hash
    }

instance Show Cipher where
    show :: Cipher -> String
show Cipher
c = Cipher -> String
cipherName Cipher
c

instance Eq Cipher where
    == :: Cipher -> Cipher -> Bool
(==) Cipher
c1 Cipher
c2 = Cipher -> Word16
cipherID Cipher
c1 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Cipher -> Word16
cipherID Cipher
c2

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

data CipherKeyExchangeType
    = CipherKeyExchange_RSA
    | CipherKeyExchange_DH_Anon
    | CipherKeyExchange_DHE_RSA
    | CipherKeyExchange_ECDHE_RSA
    | CipherKeyExchange_DHE_DSA
    | CipherKeyExchange_DH_DSA
    | CipherKeyExchange_DH_RSA
    | CipherKeyExchange_ECDH_ECDSA
    | CipherKeyExchange_ECDH_RSA
    | CipherKeyExchange_ECDHE_ECDSA
    | CipherKeyExchange_TLS13 -- not expressed in cipher suite
    deriving (Int -> CipherKeyExchangeType -> ShowS
[CipherKeyExchangeType] -> ShowS
CipherKeyExchangeType -> String
(Int -> CipherKeyExchangeType -> ShowS)
-> (CipherKeyExchangeType -> String)
-> ([CipherKeyExchangeType] -> ShowS)
-> Show CipherKeyExchangeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherKeyExchangeType -> ShowS
showsPrec :: Int -> CipherKeyExchangeType -> ShowS
$cshow :: CipherKeyExchangeType -> String
show :: CipherKeyExchangeType -> String
$cshowList :: [CipherKeyExchangeType] -> ShowS
showList :: [CipherKeyExchangeType] -> ShowS
Show, CipherKeyExchangeType -> CipherKeyExchangeType -> Bool
(CipherKeyExchangeType -> CipherKeyExchangeType -> Bool)
-> (CipherKeyExchangeType -> CipherKeyExchangeType -> Bool)
-> Eq CipherKeyExchangeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherKeyExchangeType -> CipherKeyExchangeType -> Bool
== :: CipherKeyExchangeType -> CipherKeyExchangeType -> Bool
$c/= :: CipherKeyExchangeType -> CipherKeyExchangeType -> Bool
/= :: CipherKeyExchangeType -> CipherKeyExchangeType -> Bool
Eq)

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

data Bulk = Bulk
    { Bulk -> String
bulkName :: String
    , Bulk -> Int
bulkKeySize :: Int
    , Bulk -> Int
bulkIVSize :: Int
    , Bulk -> Int
bulkExplicitIV :: Int -- Explicit size for IV for AEAD Cipher, 0 otherwise
    , Bulk -> Int
bulkAuthTagLen :: Int -- Authentication tag length in bytes for AEAD Cipher, 0 otherwise
    , Bulk -> Int
bulkBlockSize :: Int
    , Bulk -> BulkFunctions
bulkF :: BulkFunctions
    }

instance Show Bulk where
    show :: Bulk -> String
show Bulk
bulk = Bulk -> String
bulkName Bulk
bulk
instance Eq Bulk where
    Bulk
b1 == :: Bulk -> Bulk -> Bool
== Bulk
b2 =
        [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ Bulk -> String
bulkName Bulk
b1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Bulk -> String
bulkName Bulk
b2
            , Bulk -> Int
bulkKeySize Bulk
b1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Bulk -> Int
bulkKeySize Bulk
b2
            , Bulk -> Int
bulkIVSize Bulk
b1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Bulk -> Int
bulkIVSize Bulk
b2
            , Bulk -> Int
bulkBlockSize Bulk
b1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Bulk -> Int
bulkBlockSize Bulk
b2
            ]

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

data BulkFunctions
    = BulkBlockF (BulkDirection -> BulkKey -> BulkBlock)
    | BulkStreamF (BulkDirection -> BulkKey -> BulkStream)
    | BulkAeadF (BulkDirection -> BulkKey -> BulkAEAD)

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

type BulkBlock = BulkIV -> ByteString -> (ByteString, BulkIV)

type BulkKey = ByteString
type BulkIV = ByteString
type BulkNonce = ByteString
type BulkAdditionalData = ByteString

newtype BulkStream = BulkStream (ByteString -> (ByteString, BulkStream))

type BulkAEAD =
    BulkNonce -> ByteString -> BulkAdditionalData -> (ByteString, AuthTag)