-- |
-- Module      : Network.TLS.Crypto.IES
-- License     : BSD-style
-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Crypto.IES
    (
      GroupPublic
    , GroupPrivate
    , GroupKey
    -- * Group methods
    , groupGenerateKeyPair
    , groupGetPubShared
    , groupGetShared
    , encodeGroupPublic
    , decodeGroupPublic
    -- * Compatibility with 'Network.TLS.Crypto.DH'
    , dhParamsForGroup
    , dhGroupGenerateKeyPair
    , dhGroupGetPubShared
    ) where

import Control.Arrow
import Crypto.ECC
import Crypto.Error
import Crypto.Number.Generate
import Crypto.PubKey.DH hiding (generateParams)
import Crypto.PubKey.ECIES
import qualified Data.ByteArray as B
import Data.Proxy
import Network.TLS.Crypto.Types
import Network.TLS.Extra.FFDHE
import Network.TLS.Imports
import Network.TLS.RNG
import Network.TLS.Util.Serialization (os2ip,i2ospOf_)

data GroupPrivate = GroupPri_P256 (Scalar Curve_P256R1)
                  | GroupPri_P384 (Scalar Curve_P384R1)
                  | GroupPri_P521 (Scalar Curve_P521R1)
                  | GroupPri_X255 (Scalar Curve_X25519)
                  | GroupPri_X448 (Scalar Curve_X448)
                  | GroupPri_FFDHE2048 PrivateNumber
                  | GroupPri_FFDHE3072 PrivateNumber
                  | GroupPri_FFDHE4096 PrivateNumber
                  | GroupPri_FFDHE6144 PrivateNumber
                  | GroupPri_FFDHE8192 PrivateNumber
                  deriving (GroupPrivate -> GroupPrivate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupPrivate -> GroupPrivate -> Bool
$c/= :: GroupPrivate -> GroupPrivate -> Bool
== :: GroupPrivate -> GroupPrivate -> Bool
$c== :: GroupPrivate -> GroupPrivate -> Bool
Eq, Int -> GroupPrivate -> ShowS
[GroupPrivate] -> ShowS
GroupPrivate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupPrivate] -> ShowS
$cshowList :: [GroupPrivate] -> ShowS
show :: GroupPrivate -> String
$cshow :: GroupPrivate -> String
showsPrec :: Int -> GroupPrivate -> ShowS
$cshowsPrec :: Int -> GroupPrivate -> ShowS
Show)

data GroupPublic = GroupPub_P256 (Point Curve_P256R1)
                 | GroupPub_P384 (Point Curve_P384R1)
                 | GroupPub_P521 (Point Curve_P521R1)
                 | GroupPub_X255 (Point Curve_X25519)
                 | GroupPub_X448 (Point Curve_X448)
                 | GroupPub_FFDHE2048 PublicNumber
                 | GroupPub_FFDHE3072 PublicNumber
                 | GroupPub_FFDHE4096 PublicNumber
                 | GroupPub_FFDHE6144 PublicNumber
                 | GroupPub_FFDHE8192 PublicNumber
                 deriving (GroupPublic -> GroupPublic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupPublic -> GroupPublic -> Bool
$c/= :: GroupPublic -> GroupPublic -> Bool
== :: GroupPublic -> GroupPublic -> Bool
$c== :: GroupPublic -> GroupPublic -> Bool
Eq, Int -> GroupPublic -> ShowS
[GroupPublic] -> ShowS
GroupPublic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupPublic] -> ShowS
$cshowList :: [GroupPublic] -> ShowS
show :: GroupPublic -> String
$cshow :: GroupPublic -> String
showsPrec :: Int -> GroupPublic -> ShowS
$cshowsPrec :: Int -> GroupPublic -> ShowS
Show)

type GroupKey = SharedSecret

p256 :: Proxy Curve_P256R1
p256 :: Proxy Curve_P256R1
p256 = forall {k} (t :: k). Proxy t
Proxy

p384 :: Proxy Curve_P384R1
p384 :: Proxy Curve_P384R1
p384 = forall {k} (t :: k). Proxy t
Proxy

p521 :: Proxy Curve_P521R1
p521 :: Proxy Curve_P521R1
p521 = forall {k} (t :: k). Proxy t
Proxy

x25519 :: Proxy Curve_X25519
x25519 :: Proxy Curve_X25519
x25519 = forall {k} (t :: k). Proxy t
Proxy

x448 :: Proxy Curve_X448
x448 :: Proxy Curve_X448
x448 = forall {k} (t :: k). Proxy t
Proxy

dhParamsForGroup :: Group -> Maybe Params
dhParamsForGroup :: Group -> Maybe Params
dhParamsForGroup Group
FFDHE2048 = forall a. a -> Maybe a
Just Params
ffdhe2048
dhParamsForGroup Group
FFDHE3072 = forall a. a -> Maybe a
Just Params
ffdhe3072
dhParamsForGroup Group
FFDHE4096 = forall a. a -> Maybe a
Just Params
ffdhe4096
dhParamsForGroup Group
FFDHE6144 = forall a. a -> Maybe a
Just Params
ffdhe6144
dhParamsForGroup Group
FFDHE8192 = forall a. a -> Maybe a
Just Params
ffdhe8192
dhParamsForGroup Group
_         = forall a. Maybe a
Nothing

groupGenerateKeyPair :: MonadRandom r => Group -> r (GroupPrivate, GroupPublic)
groupGenerateKeyPair :: forall (r :: * -> *).
MonadRandom r =>
Group -> r (GroupPrivate, GroupPublic)
groupGenerateKeyPair Group
P256   =
    (Scalar Curve_P256R1 -> GroupPrivate
GroupPri_P256,Point Curve_P256R1 -> GroupPublic
GroupPub_P256) forall (r :: * -> *) a.
MonadRandom r =>
(Scalar a -> GroupPrivate, Point a -> GroupPublic)
-> r (KeyPair a) -> r (GroupPrivate, GroupPublic)
`fs` forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (KeyPair curve)
curveGenerateKeyPair Proxy Curve_P256R1
p256
groupGenerateKeyPair Group
P384   =
    (Scalar Curve_P384R1 -> GroupPrivate
GroupPri_P384,Point Curve_P384R1 -> GroupPublic
GroupPub_P384) forall (r :: * -> *) a.
MonadRandom r =>
(Scalar a -> GroupPrivate, Point a -> GroupPublic)
-> r (KeyPair a) -> r (GroupPrivate, GroupPublic)
`fs` forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (KeyPair curve)
curveGenerateKeyPair Proxy Curve_P384R1
p384
groupGenerateKeyPair Group
P521   =
    (Scalar Curve_P521R1 -> GroupPrivate
GroupPri_P521,Point Curve_P521R1 -> GroupPublic
GroupPub_P521) forall (r :: * -> *) a.
MonadRandom r =>
(Scalar a -> GroupPrivate, Point a -> GroupPublic)
-> r (KeyPair a) -> r (GroupPrivate, GroupPublic)
`fs` forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (KeyPair curve)
curveGenerateKeyPair Proxy Curve_P521R1
p521
groupGenerateKeyPair Group
X25519 =
    (Scalar Curve_X25519 -> GroupPrivate
GroupPri_X255,Point Curve_X25519 -> GroupPublic
GroupPub_X255) forall (r :: * -> *) a.
MonadRandom r =>
(Scalar a -> GroupPrivate, Point a -> GroupPublic)
-> r (KeyPair a) -> r (GroupPrivate, GroupPublic)
`fs` forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (KeyPair curve)
curveGenerateKeyPair Proxy Curve_X25519
x25519
groupGenerateKeyPair Group
X448 =
    (Scalar Curve_X448 -> GroupPrivate
GroupPri_X448,Point Curve_X448 -> GroupPublic
GroupPub_X448) forall (r :: * -> *) a.
MonadRandom r =>
(Scalar a -> GroupPrivate, Point a -> GroupPublic)
-> r (KeyPair a) -> r (GroupPrivate, GroupPublic)
`fs` forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (KeyPair curve)
curveGenerateKeyPair Proxy Curve_X448
x448
groupGenerateKeyPair Group
FFDHE2048 = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> (PrivateNumber -> GroupPrivate)
-> (PublicNumber -> GroupPublic)
-> r (GroupPrivate, GroupPublic)
gen Params
ffdhe2048 Int
exp2048 PrivateNumber -> GroupPrivate
GroupPri_FFDHE2048 PublicNumber -> GroupPublic
GroupPub_FFDHE2048
groupGenerateKeyPair Group
FFDHE3072 = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> (PrivateNumber -> GroupPrivate)
-> (PublicNumber -> GroupPublic)
-> r (GroupPrivate, GroupPublic)
gen Params
ffdhe3072 Int
exp3072 PrivateNumber -> GroupPrivate
GroupPri_FFDHE3072 PublicNumber -> GroupPublic
GroupPub_FFDHE3072
groupGenerateKeyPair Group
FFDHE4096 = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> (PrivateNumber -> GroupPrivate)
-> (PublicNumber -> GroupPublic)
-> r (GroupPrivate, GroupPublic)
gen Params
ffdhe4096 Int
exp4096 PrivateNumber -> GroupPrivate
GroupPri_FFDHE4096 PublicNumber -> GroupPublic
GroupPub_FFDHE4096
groupGenerateKeyPair Group
FFDHE6144 = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> (PrivateNumber -> GroupPrivate)
-> (PublicNumber -> GroupPublic)
-> r (GroupPrivate, GroupPublic)
gen Params
ffdhe6144 Int
exp6144 PrivateNumber -> GroupPrivate
GroupPri_FFDHE6144 PublicNumber -> GroupPublic
GroupPub_FFDHE6144
groupGenerateKeyPair Group
FFDHE8192 = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> (PrivateNumber -> GroupPrivate)
-> (PublicNumber -> GroupPublic)
-> r (GroupPrivate, GroupPublic)
gen Params
ffdhe8192 Int
exp8192 PrivateNumber -> GroupPrivate
GroupPri_FFDHE8192 PublicNumber -> GroupPublic
GroupPub_FFDHE8192

dhGroupGenerateKeyPair :: MonadRandom r => Group -> r (Params, PrivateNumber, PublicNumber)
dhGroupGenerateKeyPair :: forall (r :: * -> *).
MonadRandom r =>
Group -> r (Params, PrivateNumber, PublicNumber)
dhGroupGenerateKeyPair Group
FFDHE2048 = forall (f :: * -> *) a b.
Functor f =>
Params -> f (a, b) -> f (Params, a, b)
addParams Params
ffdhe2048 (forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
ffdhe2048 Int
exp2048)
dhGroupGenerateKeyPair Group
FFDHE3072 = forall (f :: * -> *) a b.
Functor f =>
Params -> f (a, b) -> f (Params, a, b)
addParams Params
ffdhe3072 (forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
ffdhe3072 Int
exp3072)
dhGroupGenerateKeyPair Group
FFDHE4096 = forall (f :: * -> *) a b.
Functor f =>
Params -> f (a, b) -> f (Params, a, b)
addParams Params
ffdhe4096 (forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
ffdhe4096 Int
exp4096)
dhGroupGenerateKeyPair Group
FFDHE6144 = forall (f :: * -> *) a b.
Functor f =>
Params -> f (a, b) -> f (Params, a, b)
addParams Params
ffdhe6144 (forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
ffdhe6144 Int
exp6144)
dhGroupGenerateKeyPair Group
FFDHE8192 = forall (f :: * -> *) a b.
Functor f =>
Params -> f (a, b) -> f (Params, a, b)
addParams Params
ffdhe8192 (forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
ffdhe8192 Int
exp8192)
dhGroupGenerateKeyPair Group
grp       = forall a. HasCallStack => String -> a
error (String
"invalid FFDHE group: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Group
grp)

addParams :: Functor f => Params -> f (a, b) -> f (Params, a, b)
addParams :: forall (f :: * -> *) a b.
Functor f =>
Params -> f (a, b) -> f (Params, a, b)
addParams Params
params = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) -> (Params
params, a
a, b
b)

fs :: MonadRandom r
   => (Scalar a -> GroupPrivate, Point a -> GroupPublic)
   -> r (KeyPair a)
   -> r (GroupPrivate, GroupPublic)
(Scalar a -> GroupPrivate
t1, Point a -> GroupPublic
t2) fs :: forall (r :: * -> *) a.
MonadRandom r =>
(Scalar a -> GroupPrivate, Point a -> GroupPublic)
-> r (KeyPair a) -> r (GroupPrivate, GroupPublic)
`fs` r (KeyPair a)
action = do
    KeyPair a
keypair <- r (KeyPair a)
action
    let pub :: Point a
pub = forall curve. KeyPair curve -> Point curve
keypairGetPublic KeyPair a
keypair
        pri :: Scalar a
pri = forall curve. KeyPair curve -> Scalar curve
keypairGetPrivate KeyPair a
keypair
    forall (m :: * -> *) a. Monad m => a -> m a
return (Scalar a -> GroupPrivate
t1 Scalar a
pri, Point a -> GroupPublic
t2 Point a
pub)

gen :: MonadRandom r
    => Params
    -> Int
    -> (PrivateNumber -> GroupPrivate)
    -> (PublicNumber -> GroupPublic)
    -> r (GroupPrivate, GroupPublic)
gen :: forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> (PrivateNumber -> GroupPrivate)
-> (PublicNumber -> GroupPublic)
-> r (GroupPrivate, GroupPublic)
gen Params
params Int
expBits PrivateNumber -> GroupPrivate
priTag PublicNumber -> GroupPublic
pubTag = (PrivateNumber -> GroupPrivate
priTag forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** PublicNumber -> GroupPublic
pubTag) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
params Int
expBits

gen' :: MonadRandom r
     => Params
     -> Int
     -> r (PrivateNumber, PublicNumber)
gen' :: forall (r :: * -> *).
MonadRandom r =>
Params -> Int -> r (PrivateNumber, PublicNumber)
gen' Params
params Int
expBits = (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Params -> PrivateNumber -> PublicNumber
calculatePublic Params
params) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: * -> *). MonadRandom r => Int -> r PrivateNumber
generatePriv Int
expBits

groupGetPubShared :: MonadRandom r => GroupPublic -> r (Maybe (GroupPublic, GroupKey))
groupGetPubShared :: forall (r :: * -> *).
MonadRandom r =>
GroupPublic -> r (Maybe (GroupPublic, GroupKey))
groupGetPubShared (GroupPub_P256 Point Curve_P256R1
pub) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Point Curve_P256R1 -> GroupPublic
GroupPub_P256) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (randomly :: * -> *) curve (proxy :: * -> *).
(MonadRandom randomly, EllipticCurveDH curve) =>
proxy curve
-> Point curve -> randomly (CryptoFailable (Point curve, GroupKey))
deriveEncrypt Proxy Curve_P256R1
p256 Point Curve_P256R1
pub
groupGetPubShared (GroupPub_P384 Point Curve_P384R1
pub) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Point Curve_P384R1 -> GroupPublic
GroupPub_P384) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (randomly :: * -> *) curve (proxy :: * -> *).
(MonadRandom randomly, EllipticCurveDH curve) =>
proxy curve
-> Point curve -> randomly (CryptoFailable (Point curve, GroupKey))
deriveEncrypt Proxy Curve_P384R1
p384 Point Curve_P384R1
pub
groupGetPubShared (GroupPub_P521 Point Curve_P521R1
pub) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Point Curve_P521R1 -> GroupPublic
GroupPub_P521) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (randomly :: * -> *) curve (proxy :: * -> *).
(MonadRandom randomly, EllipticCurveDH curve) =>
proxy curve
-> Point curve -> randomly (CryptoFailable (Point curve, GroupKey))
deriveEncrypt Proxy Curve_P521R1
p521 Point Curve_P521R1
pub
groupGetPubShared (GroupPub_X255 Point Curve_X25519
pub) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Point Curve_X25519 -> GroupPublic
GroupPub_X255) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (randomly :: * -> *) curve (proxy :: * -> *).
(MonadRandom randomly, EllipticCurveDH curve) =>
proxy curve
-> Point curve -> randomly (CryptoFailable (Point curve, GroupKey))
deriveEncrypt Proxy Curve_X25519
x25519 Point Curve_X25519
pub
groupGetPubShared (GroupPub_X448 Point Curve_X448
pub) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Point Curve_X448 -> GroupPublic
GroupPub_X448) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (randomly :: * -> *) curve (proxy :: * -> *).
(MonadRandom randomly, EllipticCurveDH curve) =>
proxy curve
-> Point curve -> randomly (CryptoFailable (Point curve, GroupKey))
deriveEncrypt Proxy Curve_X448
x448 Point Curve_X448
pub
groupGetPubShared (GroupPub_FFDHE2048 PublicNumber
pub) = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> PublicNumber
-> (PublicNumber -> GroupPublic)
-> r (Maybe (GroupPublic, GroupKey))
getPubShared Params
ffdhe2048 Int
exp2048 PublicNumber
pub PublicNumber -> GroupPublic
GroupPub_FFDHE2048
groupGetPubShared (GroupPub_FFDHE3072 PublicNumber
pub) = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> PublicNumber
-> (PublicNumber -> GroupPublic)
-> r (Maybe (GroupPublic, GroupKey))
getPubShared Params
ffdhe3072 Int
exp3072 PublicNumber
pub PublicNumber -> GroupPublic
GroupPub_FFDHE3072
groupGetPubShared (GroupPub_FFDHE4096 PublicNumber
pub) = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> PublicNumber
-> (PublicNumber -> GroupPublic)
-> r (Maybe (GroupPublic, GroupKey))
getPubShared Params
ffdhe4096 Int
exp4096 PublicNumber
pub PublicNumber -> GroupPublic
GroupPub_FFDHE4096
groupGetPubShared (GroupPub_FFDHE6144 PublicNumber
pub) = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> PublicNumber
-> (PublicNumber -> GroupPublic)
-> r (Maybe (GroupPublic, GroupKey))
getPubShared Params
ffdhe6144 Int
exp6144 PublicNumber
pub PublicNumber -> GroupPublic
GroupPub_FFDHE6144
groupGetPubShared (GroupPub_FFDHE8192 PublicNumber
pub) = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> PublicNumber
-> (PublicNumber -> GroupPublic)
-> r (Maybe (GroupPublic, GroupKey))
getPubShared Params
ffdhe8192 Int
exp8192 PublicNumber
pub PublicNumber -> GroupPublic
GroupPub_FFDHE8192

dhGroupGetPubShared :: MonadRandom r => Group -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
dhGroupGetPubShared :: forall (r :: * -> *).
MonadRandom r =>
Group -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
dhGroupGetPubShared Group
FFDHE2048 PublicNumber
pub = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
getPubShared' Params
ffdhe2048 Int
exp2048 PublicNumber
pub
dhGroupGetPubShared Group
FFDHE3072 PublicNumber
pub = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
getPubShared' Params
ffdhe3072 Int
exp3072 PublicNumber
pub
dhGroupGetPubShared Group
FFDHE4096 PublicNumber
pub = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
getPubShared' Params
ffdhe4096 Int
exp4096 PublicNumber
pub
dhGroupGetPubShared Group
FFDHE6144 PublicNumber
pub = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
getPubShared' Params
ffdhe6144 Int
exp6144 PublicNumber
pub
dhGroupGetPubShared Group
FFDHE8192 PublicNumber
pub = forall (r :: * -> *).
MonadRandom r =>
Params
-> Int -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
getPubShared' Params
ffdhe8192 Int
exp8192 PublicNumber
pub
dhGroupGetPubShared Group
_         PublicNumber
_   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

getPubShared :: MonadRandom r
             => Params
             -> Int
             -> PublicNumber
             -> (PublicNumber -> GroupPublic)
             -> r (Maybe (GroupPublic, GroupKey))
getPubShared :: forall (r :: * -> *).
MonadRandom r =>
Params
-> Int
-> PublicNumber
-> (PublicNumber -> GroupPublic)
-> r (Maybe (GroupPublic, GroupKey))
getPubShared Params
params Int
expBits PublicNumber
pub PublicNumber -> GroupPublic
pubTag | Bool -> Bool
not (Params -> PublicNumber -> Bool
valid Params
params PublicNumber
pub) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                                       | Bool
otherwise = do
    PrivateNumber
mypri <- forall (r :: * -> *). MonadRandom r => Int -> r PrivateNumber
generatePriv Int
expBits
    let mypub :: PublicNumber
mypub = Params -> PrivateNumber -> PublicNumber
calculatePublic Params
params PrivateNumber
mypri
    let SharedKey ScrubbedBytes
share = Params -> PrivateNumber -> PublicNumber -> SharedKey
getShared Params
params PrivateNumber
mypri PublicNumber
pub
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (PublicNumber -> GroupPublic
pubTag PublicNumber
mypub, ScrubbedBytes -> GroupKey
SharedSecret ScrubbedBytes
share)

getPubShared' :: MonadRandom r
              => Params
              -> Int
              -> PublicNumber
              -> r (Maybe (PublicNumber, SharedKey))
getPubShared' :: forall (r :: * -> *).
MonadRandom r =>
Params
-> Int -> PublicNumber -> r (Maybe (PublicNumber, SharedKey))
getPubShared' Params
params Int
expBits PublicNumber
pub
    | Bool -> Bool
not (Params -> PublicNumber -> Bool
valid Params
params PublicNumber
pub) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Bool
otherwise = do
        PrivateNumber
mypri <- forall (r :: * -> *). MonadRandom r => Int -> r PrivateNumber
generatePriv Int
expBits
        let share :: ScrubbedBytes
share = SharedKey -> ScrubbedBytes
stripLeadingZeros (Params -> PrivateNumber -> PublicNumber -> SharedKey
getShared Params
params PrivateNumber
mypri PublicNumber
pub)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Params -> PrivateNumber -> PublicNumber
calculatePublic Params
params PrivateNumber
mypri, ScrubbedBytes -> SharedKey
SharedKey ScrubbedBytes
share)

groupGetShared ::  GroupPublic -> GroupPrivate -> Maybe GroupKey
groupGetShared :: GroupPublic -> GroupPrivate -> Maybe GroupKey
groupGetShared (GroupPub_P256 Point Curve_P256R1
pub) (GroupPri_P256 Scalar Curve_P256R1
pri) = forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Point curve -> Scalar curve -> CryptoFailable GroupKey
deriveDecrypt Proxy Curve_P256R1
p256 Point Curve_P256R1
pub Scalar Curve_P256R1
pri
groupGetShared (GroupPub_P384 Point Curve_P384R1
pub) (GroupPri_P384 Scalar Curve_P384R1
pri) = forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Point curve -> Scalar curve -> CryptoFailable GroupKey
deriveDecrypt Proxy Curve_P384R1
p384 Point Curve_P384R1
pub Scalar Curve_P384R1
pri
groupGetShared (GroupPub_P521 Point Curve_P521R1
pub) (GroupPri_P521 Scalar Curve_P521R1
pri) = forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Point curve -> Scalar curve -> CryptoFailable GroupKey
deriveDecrypt Proxy Curve_P521R1
p521 Point Curve_P521R1
pub Scalar Curve_P521R1
pri
groupGetShared (GroupPub_X255 Point Curve_X25519
pub) (GroupPri_X255 Scalar Curve_X25519
pri) = forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Point curve -> Scalar curve -> CryptoFailable GroupKey
deriveDecrypt Proxy Curve_X25519
x25519 Point Curve_X25519
pub Scalar Curve_X25519
pri
groupGetShared (GroupPub_X448 Point Curve_X448
pub) (GroupPri_X448 Scalar Curve_X448
pri) = forall a. CryptoFailable a -> Maybe a
maybeCryptoError forall a b. (a -> b) -> a -> b
$ forall curve (proxy :: * -> *).
EllipticCurveDH curve =>
proxy curve
-> Point curve -> Scalar curve -> CryptoFailable GroupKey
deriveDecrypt Proxy Curve_X448
x448 Point Curve_X448
pub Scalar Curve_X448
pri
groupGetShared (GroupPub_FFDHE2048 PublicNumber
pub) (GroupPri_FFDHE2048 PrivateNumber
pri) = Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
calcShared Params
ffdhe2048 PublicNumber
pub PrivateNumber
pri
groupGetShared (GroupPub_FFDHE3072 PublicNumber
pub) (GroupPri_FFDHE3072 PrivateNumber
pri) = Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
calcShared Params
ffdhe3072 PublicNumber
pub PrivateNumber
pri
groupGetShared (GroupPub_FFDHE4096 PublicNumber
pub) (GroupPri_FFDHE4096 PrivateNumber
pri) = Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
calcShared Params
ffdhe4096 PublicNumber
pub PrivateNumber
pri
groupGetShared (GroupPub_FFDHE6144 PublicNumber
pub) (GroupPri_FFDHE6144 PrivateNumber
pri) = Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
calcShared Params
ffdhe6144 PublicNumber
pub PrivateNumber
pri
groupGetShared (GroupPub_FFDHE8192 PublicNumber
pub) (GroupPri_FFDHE8192 PrivateNumber
pri) = Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
calcShared Params
ffdhe8192 PublicNumber
pub PrivateNumber
pri
groupGetShared GroupPublic
_ GroupPrivate
_ = forall a. Maybe a
Nothing

calcShared :: Params -> PublicNumber -> PrivateNumber -> Maybe SharedSecret
calcShared :: Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
calcShared Params
params PublicNumber
pub PrivateNumber
pri
    | Params -> PublicNumber -> Bool
valid Params
params PublicNumber
pub = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> GroupKey
SharedSecret ScrubbedBytes
share
    | Bool
otherwise        = forall a. Maybe a
Nothing
  where
    SharedKey ScrubbedBytes
share = Params -> PrivateNumber -> PublicNumber -> SharedKey
getShared Params
params PrivateNumber
pri PublicNumber
pub

encodeGroupPublic :: GroupPublic -> ByteString
encodeGroupPublic :: GroupPublic -> ByteString
encodeGroupPublic (GroupPub_P256 Point Curve_P256R1
p) = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint Proxy Curve_P256R1
p256 Point Curve_P256R1
p
encodeGroupPublic (GroupPub_P384 Point Curve_P384R1
p) = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint Proxy Curve_P384R1
p384 Point Curve_P384R1
p
encodeGroupPublic (GroupPub_P521 Point Curve_P521R1
p) = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint Proxy Curve_P521R1
p521 Point Curve_P521R1
p
encodeGroupPublic (GroupPub_X255 Point Curve_X25519
p) = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint Proxy Curve_X25519
x25519 Point Curve_X25519
p
encodeGroupPublic (GroupPub_X448 Point Curve_X448
p) = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint Proxy Curve_X448
x448 Point Curve_X448
p
encodeGroupPublic (GroupPub_FFDHE2048 PublicNumber
p) = Params -> PublicNumber -> ByteString
enc Params
ffdhe2048 PublicNumber
p
encodeGroupPublic (GroupPub_FFDHE3072 PublicNumber
p) = Params -> PublicNumber -> ByteString
enc Params
ffdhe3072 PublicNumber
p
encodeGroupPublic (GroupPub_FFDHE4096 PublicNumber
p) = Params -> PublicNumber -> ByteString
enc Params
ffdhe4096 PublicNumber
p
encodeGroupPublic (GroupPub_FFDHE6144 PublicNumber
p) = Params -> PublicNumber -> ByteString
enc Params
ffdhe6144 PublicNumber
p
encodeGroupPublic (GroupPub_FFDHE8192 PublicNumber
p) = Params -> PublicNumber -> ByteString
enc Params
ffdhe8192 PublicNumber
p

enc :: Params -> PublicNumber -> ByteString
enc :: Params -> PublicNumber -> ByteString
enc Params
params (PublicNumber Integer
p) = forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ ((Params -> Int
params_bits Params
params forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8) Integer
p

decodeGroupPublic :: Group -> ByteString -> Either CryptoError GroupPublic
decodeGroupPublic :: Group -> ByteString -> Either CryptoError GroupPublic
decodeGroupPublic Group
P256   ByteString
bs = forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError forall a b. (a -> b) -> a -> b
$ Point Curve_P256R1 -> GroupPublic
GroupPub_P256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint Proxy Curve_P256R1
p256 ByteString
bs
decodeGroupPublic Group
P384   ByteString
bs = forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError forall a b. (a -> b) -> a -> b
$ Point Curve_P384R1 -> GroupPublic
GroupPub_P384 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint Proxy Curve_P384R1
p384 ByteString
bs
decodeGroupPublic Group
P521   ByteString
bs = forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError forall a b. (a -> b) -> a -> b
$ Point Curve_P521R1 -> GroupPublic
GroupPub_P521 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint Proxy Curve_P521R1
p521 ByteString
bs
decodeGroupPublic Group
X25519 ByteString
bs = forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError forall a b. (a -> b) -> a -> b
$ Point Curve_X25519 -> GroupPublic
GroupPub_X255 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint Proxy Curve_X25519
x25519 ByteString
bs
decodeGroupPublic Group
X448 ByteString
bs = forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError forall a b. (a -> b) -> a -> b
$ Point Curve_X448 -> GroupPublic
GroupPub_X448 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint Proxy Curve_X448
x448 ByteString
bs
decodeGroupPublic Group
FFDHE2048 ByteString
bs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicNumber -> GroupPublic
GroupPub_FFDHE2048 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PublicNumber
PublicNumber forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs
decodeGroupPublic Group
FFDHE3072 ByteString
bs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicNumber -> GroupPublic
GroupPub_FFDHE3072 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PublicNumber
PublicNumber forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs
decodeGroupPublic Group
FFDHE4096 ByteString
bs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicNumber -> GroupPublic
GroupPub_FFDHE4096 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PublicNumber
PublicNumber forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs
decodeGroupPublic Group
FFDHE6144 ByteString
bs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicNumber -> GroupPublic
GroupPub_FFDHE6144 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PublicNumber
PublicNumber forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs
decodeGroupPublic Group
FFDHE8192 ByteString
bs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicNumber -> GroupPublic
GroupPub_FFDHE8192 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PublicNumber
PublicNumber forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs

-- Check that group element in not in the 2-element subgroup { 1, p - 1 }.
-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1.
valid :: Params -> PublicNumber -> Bool
valid :: Params -> PublicNumber -> Bool
valid (Params Integer
p Integer
_ Int
_) (PublicNumber Integer
y) = Integer
1 forall a. Ord a => a -> a -> Bool
< Integer
y Bool -> Bool -> Bool
&& Integer
y forall a. Ord a => a -> a -> Bool
< Integer
p forall a. Num a => a -> a -> a
- Integer
1

-- strips leading zeros from the result of getShared, as required
-- for DH(E) premaster secret in SSL/TLS before version 1.3.
stripLeadingZeros :: SharedKey -> B.ScrubbedBytes
stripLeadingZeros :: SharedKey -> ScrubbedBytes
stripLeadingZeros (SharedKey ScrubbedBytes
sb) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall bs. ByteArray bs => (Word8 -> Bool) -> bs -> (bs, bs)
B.span (forall a. Eq a => a -> a -> Bool
== Word8
0) ScrubbedBytes
sb

-- Use short exponents as optimization, see RFC 7919 section 5.2.
generatePriv :: MonadRandom r => Int -> r PrivateNumber
generatePriv :: forall (r :: * -> *). MonadRandom r => Int -> r PrivateNumber
generatePriv Int
e = Integer -> PrivateNumber
PrivateNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadRandom m =>
Int -> Maybe GenTopPolicy -> Bool -> m Integer
generateParams Int
e (forall a. a -> Maybe a
Just GenTopPolicy
SetHighest) Bool
False

-- Short exponent bit sizes from RFC 7919 appendix A, rounded to next
-- multiple of 16 bits, i.e. going through a function like:
-- let shortExp n = head [ e | i <- [1..], let e = n + i, e `mod` 16 == 0 ]
exp2048 :: Int
exp3072 :: Int
exp4096 :: Int
exp6144 :: Int
exp8192 :: Int
exp2048 :: Int
exp2048 = Int
240 -- shortExp 225
exp3072 :: Int
exp3072 = Int
288 -- shortExp 275
exp4096 :: Int
exp4096 = Int
336 -- shortExp 325
exp6144 :: Int
exp6144 = Int
384 -- shortExp 375
exp8192 :: Int
exp8192 = Int
416 -- shortExp 400