1{-# OPTIONS_HADDOCK hide #-}
2{-# LANGUAGE ExistentialQuantification #-}
3-- |
4-- Module      : Network.TLS.Cipher
5-- License     : BSD-style
6-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
7-- Stability   : experimental
8-- Portability : unknown
9--
10module Network.TLS.Cipher
11    ( CipherKeyExchangeType(..)
12    , Bulk(..)
13    , BulkFunctions(..)
14    , BulkDirection(..)
15    , BulkState(..)
16    , BulkStream(..)
17    , BulkBlock
18    , BulkAEAD
19    , bulkInit
20    , Hash(..)
21    , Cipher(..)
22    , CipherID
23    , cipherKeyBlockSize
24    , BulkKey
25    , BulkIV
26    , BulkNonce
27    , BulkAdditionalData
28    , cipherAllowedForVersion
29    , hasMAC
30    , hasRecordIV
31    ) where
32
33import Crypto.Cipher.Types (AuthTag)
34import Network.TLS.Types (CipherID, Version(..))
35import Network.TLS.Crypto (Hash(..), hashDigestSize)
36
37import qualified Data.ByteString as B
38
39-- FIXME convert to newtype
40type BulkKey = B.ByteString
41type BulkIV = B.ByteString
42type BulkNonce = B.ByteString
43type BulkAdditionalData = B.ByteString
44
45data BulkState =
46      BulkStateStream BulkStream
47    | BulkStateBlock  BulkBlock
48    | BulkStateAEAD   BulkAEAD
49    | BulkStateUninitialized
50
51instance Show BulkState where
52    show (BulkStateStream _)      = "BulkStateStream"
53    show (BulkStateBlock _)       = "BulkStateBlock"
54    show (BulkStateAEAD _)        = "BulkStateAEAD"
55    show  BulkStateUninitialized  = "BulkStateUninitialized"
56
57newtype BulkStream = BulkStream (B.ByteString -> (B.ByteString, BulkStream))
58
59type BulkBlock = BulkIV -> B.ByteString -> (B.ByteString, BulkIV)
60
61type BulkAEAD = BulkNonce -> B.ByteString -> BulkAdditionalData -> (B.ByteString, AuthTag)
62
63data BulkDirection = BulkEncrypt | BulkDecrypt
64    deriving (Show,Eq)
65
66bulkInit :: Bulk -> BulkDirection -> BulkKey -> BulkState
67bulkInit bulk direction key =
68    case bulkF bulk of
69        BulkBlockF  ini -> BulkStateBlock  (ini direction key)
70        BulkStreamF ini -> BulkStateStream (ini direction key)
71        BulkAeadF   ini -> BulkStateAEAD   (ini direction key)
72
73data BulkFunctions =
74      BulkBlockF  (BulkDirection -> BulkKey -> BulkBlock)
75    | BulkStreamF (BulkDirection -> BulkKey -> BulkStream)
76    | BulkAeadF   (BulkDirection -> BulkKey -> BulkAEAD)
77
78hasMAC,hasRecordIV :: BulkFunctions -> Bool
79
80hasMAC (BulkBlockF _ ) = True
81hasMAC (BulkStreamF _) = True
82hasMAC (BulkAeadF _  ) = False
83
84hasRecordIV = hasMAC
85
86data CipherKeyExchangeType =
87      CipherKeyExchange_RSA
88    | CipherKeyExchange_DH_Anon
89    | CipherKeyExchange_DHE_RSA
90    | CipherKeyExchange_ECDHE_RSA
91    | CipherKeyExchange_DHE_DSS
92    | CipherKeyExchange_DH_DSS
93    | CipherKeyExchange_DH_RSA
94    | CipherKeyExchange_ECDH_ECDSA
95    | CipherKeyExchange_ECDH_RSA
96    | CipherKeyExchange_ECDHE_ECDSA
97    | CipherKeyExchange_TLS13 -- not expressed in cipher suite
98    deriving (Show,Eq)
99
100data Bulk = Bulk
101    { bulkName         :: String
102    , bulkKeySize      :: Int
103    , bulkIVSize       :: Int
104    , bulkExplicitIV   :: Int -- Explicit size for IV for AEAD Cipher, 0 otherwise
105    , bulkAuthTagLen   :: Int -- Authentication tag length in bytes for AEAD Cipher, 0 otherwise
106    , bulkBlockSize    :: Int
107    , bulkF            :: BulkFunctions
108    }
109
110instance Show Bulk where
111    show bulk = bulkName bulk
112instance Eq Bulk where
113    b1 == b2 = and [ bulkName b1 == bulkName b2
114                   , bulkKeySize b1 == bulkKeySize b2
115                   , bulkIVSize b1 == bulkIVSize b2
116                   , bulkBlockSize b1 == bulkBlockSize b2
117                   ]
118
119-- | Cipher algorithm
120data Cipher = Cipher
121    { cipherID           :: CipherID
122    , cipherName         :: String
123    , cipherHash         :: Hash
124    , cipherBulk         :: Bulk
125    , cipherKeyExchange  :: CipherKeyExchangeType
126    , cipherMinVer       :: Maybe Version
127    , cipherPRFHash      :: Maybe Hash
128    }
129
130cipherKeyBlockSize :: Cipher -> Int
131cipherKeyBlockSize cipher = 2 * (hashDigestSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk)
132  where bulk = cipherBulk cipher
133
134-- | Check if a specific 'Cipher' is allowed to be used
135-- with the version specified
136cipherAllowedForVersion :: Version -> Cipher -> Bool
137cipherAllowedForVersion ver cipher =
138    case cipherMinVer cipher of
139        Nothing   -> ver < TLS13
140        Just cVer -> cVer <= ver && (ver < TLS13 || cVer >= TLS13)
141
142instance Show Cipher where
143    show c = cipherName c
144
145instance Eq Cipher where
146    (==) c1 c2 = cipherID c1 == cipherID c2
147