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