1-- |
2-- Module      : Network.TLS.Crypto.IES
3-- License     : BSD-style
4-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
5-- Stability   : experimental
6-- Portability : unknown
7--
8module Network.TLS.Crypto.IES
9    (
10      GroupPublic
11    , GroupPrivate
12    , GroupKey
13    -- * Group methods
14    , groupGenerateKeyPair
15    , groupGetPubShared
16    , groupGetShared
17    , encodeGroupPublic
18    , decodeGroupPublic
19    -- * Compatibility with 'Network.TLS.Crypto.DH'
20    , dhParamsForGroup
21    , dhGroupGenerateKeyPair
22    , dhGroupGetPubShared
23    ) where
24
25import Control.Arrow
26import Crypto.ECC
27import Crypto.Error
28import Crypto.Number.Generate
29import Crypto.PubKey.DH hiding (generateParams)
30import Crypto.PubKey.ECIES
31import qualified Data.ByteArray as B
32import Data.Proxy
33import Network.TLS.Crypto.Types
34import Network.TLS.Extra.FFDHE
35import Network.TLS.Imports
36import Network.TLS.RNG
37import Network.TLS.Util.Serialization (os2ip,i2ospOf_)
38
39data GroupPrivate = GroupPri_P256 (Scalar Curve_P256R1)
40                  | GroupPri_P384 (Scalar Curve_P384R1)
41                  | GroupPri_P521 (Scalar Curve_P521R1)
42                  | GroupPri_X255 (Scalar Curve_X25519)
43                  | GroupPri_X448 (Scalar Curve_X448)
44                  | GroupPri_FFDHE2048 PrivateNumber
45                  | GroupPri_FFDHE3072 PrivateNumber
46                  | GroupPri_FFDHE4096 PrivateNumber
47                  | GroupPri_FFDHE6144 PrivateNumber
48                  | GroupPri_FFDHE8192 PrivateNumber
49                  deriving (Eq, Show)
50
51data GroupPublic = GroupPub_P256 (Point Curve_P256R1)
52                 | GroupPub_P384 (Point Curve_P384R1)
53                 | GroupPub_P521 (Point Curve_P521R1)
54                 | GroupPub_X255 (Point Curve_X25519)
55                 | GroupPub_X448 (Point Curve_X448)
56                 | GroupPub_FFDHE2048 PublicNumber
57                 | GroupPub_FFDHE3072 PublicNumber
58                 | GroupPub_FFDHE4096 PublicNumber
59                 | GroupPub_FFDHE6144 PublicNumber
60                 | GroupPub_FFDHE8192 PublicNumber
61                 deriving (Eq, Show)
62
63type GroupKey = SharedSecret
64
65p256 :: Proxy Curve_P256R1
66p256 = Proxy
67
68p384 :: Proxy Curve_P384R1
69p384 = Proxy
70
71p521 :: Proxy Curve_P521R1
72p521 = Proxy
73
74x25519 :: Proxy Curve_X25519
75x25519 = Proxy
76
77x448 :: Proxy Curve_X448
78x448 = Proxy
79
80dhParamsForGroup :: Group -> Maybe Params
81dhParamsForGroup FFDHE2048 = Just ffdhe2048
82dhParamsForGroup FFDHE3072 = Just ffdhe3072
83dhParamsForGroup FFDHE4096 = Just ffdhe4096
84dhParamsForGroup FFDHE6144 = Just ffdhe6144
85dhParamsForGroup FFDHE8192 = Just ffdhe8192
86dhParamsForGroup _         = Nothing
87
88groupGenerateKeyPair :: MonadRandom r => Group -> r (GroupPrivate, GroupPublic)
89groupGenerateKeyPair P256   =
90    (GroupPri_P256,GroupPub_P256) `fs` curveGenerateKeyPair p256
91groupGenerateKeyPair P384   =
92    (GroupPri_P384,GroupPub_P384) `fs` curveGenerateKeyPair p384
93groupGenerateKeyPair P521   =
94    (GroupPri_P521,GroupPub_P521) `fs` curveGenerateKeyPair p521
95groupGenerateKeyPair X25519 =
96    (GroupPri_X255,GroupPub_X255) `fs` curveGenerateKeyPair x25519
97groupGenerateKeyPair X448 =
98    (GroupPri_X448,GroupPub_X448) `fs` curveGenerateKeyPair x448
99groupGenerateKeyPair FFDHE2048 = gen ffdhe2048 exp2048 GroupPri_FFDHE2048 GroupPub_FFDHE2048
100groupGenerateKeyPair FFDHE3072 = gen ffdhe3072 exp3072 GroupPri_FFDHE3072 GroupPub_FFDHE3072
101groupGenerateKeyPair FFDHE4096 = gen ffdhe4096 exp4096 GroupPri_FFDHE4096 GroupPub_FFDHE4096
102groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 exp6144 GroupPri_FFDHE6144 GroupPub_FFDHE6144
103groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 exp8192 GroupPri_FFDHE8192 GroupPub_FFDHE8192
104
105dhGroupGenerateKeyPair :: MonadRandom r => Group -> r (Params, PrivateNumber, PublicNumber)
106dhGroupGenerateKeyPair FFDHE2048 = addParams ffdhe2048 (gen' ffdhe2048 exp2048)
107dhGroupGenerateKeyPair FFDHE3072 = addParams ffdhe3072 (gen' ffdhe3072 exp3072)
108dhGroupGenerateKeyPair FFDHE4096 = addParams ffdhe4096 (gen' ffdhe4096 exp4096)
109dhGroupGenerateKeyPair FFDHE6144 = addParams ffdhe6144 (gen' ffdhe6144 exp6144)
110dhGroupGenerateKeyPair FFDHE8192 = addParams ffdhe8192 (gen' ffdhe8192 exp8192)
111dhGroupGenerateKeyPair grp       = error ("invalid FFDHE group: " ++ show grp)
112
113addParams :: Functor f => Params -> f (a, b) -> f (Params, a, b)
114addParams params = fmap $ \(a, b) -> (params, a, b)
115
116fs :: MonadRandom r
117   => (Scalar a -> GroupPrivate, Point a -> GroupPublic)
118   -> r (KeyPair a)
119   -> r (GroupPrivate, GroupPublic)
120(t1, t2) `fs` action = do
121    keypair <- action
122    let pub = keypairGetPublic keypair
123        pri = keypairGetPrivate keypair
124    return (t1 pri, t2 pub)
125
126gen :: MonadRandom r
127    => Params
128    -> Int
129    -> (PrivateNumber -> GroupPrivate)
130    -> (PublicNumber -> GroupPublic)
131    -> r (GroupPrivate, GroupPublic)
132gen params expBits priTag pubTag = (priTag *** pubTag) <$> gen' params expBits
133
134gen' :: MonadRandom r
135     => Params
136     -> Int
137     -> r (PrivateNumber, PublicNumber)
138gen' params expBits = (id &&& calculatePublic params) <$> generatePriv expBits
139
140groupGetPubShared :: MonadRandom r => GroupPublic -> r (Maybe (GroupPublic, GroupKey))
141groupGetPubShared (GroupPub_P256 pub) =
142    fmap (first GroupPub_P256) . maybeCryptoError <$> deriveEncrypt p256 pub
143groupGetPubShared (GroupPub_P384 pub) =
144    fmap (first GroupPub_P384) . maybeCryptoError <$> deriveEncrypt p384 pub
145groupGetPubShared (GroupPub_P521 pub) =
146    fmap (first GroupPub_P521) . maybeCryptoError <$> deriveEncrypt p521 pub
147groupGetPubShared (GroupPub_X255 pub) =
148    fmap (first GroupPub_X255) . maybeCryptoError <$> deriveEncrypt x25519 pub
149groupGetPubShared (GroupPub_X448 pub) =
150    fmap (first GroupPub_X448) . maybeCryptoError <$> deriveEncrypt x448 pub
151groupGetPubShared (GroupPub_FFDHE2048 pub) = getPubShared ffdhe2048 exp2048 pub GroupPub_FFDHE2048
152groupGetPubShared (GroupPub_FFDHE3072 pub) = getPubShared ffdhe3072 exp3072 pub GroupPub_FFDHE3072
153groupGetPubShared (GroupPub_FFDHE4096 pub) = getPubShared ffdhe4096 exp4096 pub GroupPub_FFDHE4096
154groupGetPubShared (GroupPub_FFDHE6144 pub) = getPubShared ffdhe6144 exp6144 pub GroupPub_FFDHE6144
155groupGetPubShared (GroupPub_FFDHE8192 pub) = getPubShared ffdhe8192 exp8192 pub GroupPub_FFDHE8192
156
157dhGroupGetPubShared :: MonadRandom r => Group -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
158dhGroupGetPubShared FFDHE2048 pub = getPubShared' ffdhe2048 exp2048 pub
159dhGroupGetPubShared FFDHE3072 pub = getPubShared' ffdhe3072 exp3072 pub
160dhGroupGetPubShared FFDHE4096 pub = getPubShared' ffdhe4096 exp4096 pub
161dhGroupGetPubShared FFDHE6144 pub = getPubShared' ffdhe6144 exp6144 pub
162dhGroupGetPubShared FFDHE8192 pub = getPubShared' ffdhe8192 exp8192 pub
163dhGroupGetPubShared _         _   = return Nothing
164
165getPubShared :: MonadRandom r
166             => Params
167             -> Int
168             -> PublicNumber
169             -> (PublicNumber -> GroupPublic)
170             -> r (Maybe (GroupPublic, GroupKey))
171getPubShared params expBits pub pubTag | not (valid params pub) = return Nothing
172                                       | otherwise = do
173    mypri <- generatePriv expBits
174    let mypub = calculatePublic params mypri
175    let SharedKey share = getShared params mypri pub
176    return $ Just (pubTag mypub, SharedSecret share)
177
178getPubShared' :: MonadRandom r
179              => Params
180              -> Int
181              -> PublicNumber
182              -> r (Maybe (PublicNumber, SharedKey))
183getPubShared' params expBits pub
184    | not (valid params pub) = return Nothing
185    | otherwise = do
186        mypri <- generatePriv expBits
187        let share = stripLeadingZeros (getShared params mypri pub)
188        return $ Just (calculatePublic params mypri, SharedKey share)
189
190groupGetShared ::  GroupPublic -> GroupPrivate -> Maybe GroupKey
191groupGetShared (GroupPub_P256 pub) (GroupPri_P256 pri) = maybeCryptoError $ deriveDecrypt p256 pub pri
192groupGetShared (GroupPub_P384 pub) (GroupPri_P384 pri) = maybeCryptoError $ deriveDecrypt p384 pub pri
193groupGetShared (GroupPub_P521 pub) (GroupPri_P521 pri) = maybeCryptoError $ deriveDecrypt p521 pub pri
194groupGetShared (GroupPub_X255 pub) (GroupPri_X255 pri) = maybeCryptoError $ deriveDecrypt x25519 pub pri
195groupGetShared (GroupPub_X448 pub) (GroupPri_X448 pri) = maybeCryptoError $ deriveDecrypt x448 pub pri
196groupGetShared (GroupPub_FFDHE2048 pub) (GroupPri_FFDHE2048 pri) = calcShared ffdhe2048 pub pri
197groupGetShared (GroupPub_FFDHE3072 pub) (GroupPri_FFDHE3072 pri) = calcShared ffdhe3072 pub pri
198groupGetShared (GroupPub_FFDHE4096 pub) (GroupPri_FFDHE4096 pri) = calcShared ffdhe4096 pub pri
199groupGetShared (GroupPub_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = calcShared ffdhe6144 pub pri
200groupGetShared (GroupPub_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = calcShared ffdhe8192 pub pri
201groupGetShared _ _ = Nothing
202
203calcShared :: Params -> PublicNumber -> PrivateNumber -> Maybe SharedSecret
204calcShared params pub pri
205    | valid params pub = Just $ SharedSecret share
206    | otherwise        = Nothing
207  where
208    SharedKey share = getShared params pri pub
209
210encodeGroupPublic :: GroupPublic -> ByteString
211encodeGroupPublic (GroupPub_P256 p) = encodePoint p256 p
212encodeGroupPublic (GroupPub_P384 p) = encodePoint p384 p
213encodeGroupPublic (GroupPub_P521 p) = encodePoint p521 p
214encodeGroupPublic (GroupPub_X255 p) = encodePoint x25519 p
215encodeGroupPublic (GroupPub_X448 p) = encodePoint x448 p
216encodeGroupPublic (GroupPub_FFDHE2048 p) = enc ffdhe2048 p
217encodeGroupPublic (GroupPub_FFDHE3072 p) = enc ffdhe3072 p
218encodeGroupPublic (GroupPub_FFDHE4096 p) = enc ffdhe4096 p
219encodeGroupPublic (GroupPub_FFDHE6144 p) = enc ffdhe6144 p
220encodeGroupPublic (GroupPub_FFDHE8192 p) = enc ffdhe8192 p
221
222enc :: Params -> PublicNumber -> ByteString
223enc params (PublicNumber p) = i2ospOf_ ((params_bits params + 7) `div` 8) p
224
225decodeGroupPublic :: Group -> ByteString -> Either CryptoError GroupPublic
226decodeGroupPublic P256   bs = eitherCryptoError $ GroupPub_P256 <$> decodePoint p256 bs
227decodeGroupPublic P384   bs = eitherCryptoError $ GroupPub_P384 <$> decodePoint p384 bs
228decodeGroupPublic P521   bs = eitherCryptoError $ GroupPub_P521 <$> decodePoint p521 bs
229decodeGroupPublic X25519 bs = eitherCryptoError $ GroupPub_X255 <$> decodePoint x25519 bs
230decodeGroupPublic X448 bs = eitherCryptoError $ GroupPub_X448 <$> decodePoint x448 bs
231decodeGroupPublic FFDHE2048 bs = Right . GroupPub_FFDHE2048 . PublicNumber $ os2ip bs
232decodeGroupPublic FFDHE3072 bs = Right . GroupPub_FFDHE3072 . PublicNumber $ os2ip bs
233decodeGroupPublic FFDHE4096 bs = Right . GroupPub_FFDHE4096 . PublicNumber $ os2ip bs
234decodeGroupPublic FFDHE6144 bs = Right . GroupPub_FFDHE6144 . PublicNumber $ os2ip bs
235decodeGroupPublic FFDHE8192 bs = Right . GroupPub_FFDHE8192 . PublicNumber $ os2ip bs
236
237-- Check that group element in not in the 2-element subgroup { 1, p - 1 }.
238-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1.
239valid :: Params -> PublicNumber -> Bool
240valid (Params p _ _) (PublicNumber y) = 1 < y && y < p - 1
241
242-- strips leading zeros from the result of getShared, as required
243-- for DH(E) premaster secret in SSL/TLS before version 1.3.
244stripLeadingZeros :: SharedKey -> B.ScrubbedBytes
245stripLeadingZeros (SharedKey sb) = snd $ B.span (== 0) sb
246
247-- Use short exponents as optimization, see RFC 7919 section 5.2.
248generatePriv :: MonadRandom r => Int -> r PrivateNumber
249generatePriv e = PrivateNumber <$> generateParams e (Just SetHighest) False
250
251-- Short exponent bit sizes from RFC 7919 appendix A, rounded to next
252-- multiple of 16 bits, i.e. going through a function like:
253-- let shortExp n = head [ e | i <- [1..], let e = n + i, e `mod` 16 == 0 ]
254exp2048 :: Int
255exp3072 :: Int
256exp4096 :: Int
257exp6144 :: Int
258exp8192 :: Int
259exp2048 = 240 -- shortExp 225
260exp3072 = 288 -- shortExp 275
261exp4096 = 336 -- shortExp 325
262exp6144 = 384 -- shortExp 375
263exp8192 = 416 -- shortExp 400
264