{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Crypto.PubKey.ElGamal
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
-- ElGamal encryption and signature over the multiplicative group of integers
-- modulo a prime, reusing the parameters of "Crypto.PubKey.DH".
--
-- /These are raw primitives, not a scheme./  The encryption here is textbook
-- ElGamal: it applies no padding, so it is malleable by construction --
-- multiplying a ciphertext's second component by @t@ multiplies the plaintext
-- by @t@ -- and it is not IND-CCA secure.  A message is an 'Integer' below the
-- modulus rather than a byte string, and nothing here maps one to the other.
-- Use it to build a scheme that adds those, or prefer
-- "Crypto.PubKey.RSA.OAEP" or "Crypto.PubKey.ECIES" where a scheme is what is
-- wanted.
--
-- The signature primitive is likewise raw, and an ephemeral value must never
-- be reused between signatures: two signatures under the same @k@ reveal the
-- private key.
--
-- == What is kept from the clock, and what is not
--
-- Every exponentiation with a secret exponent is
-- 'Crypto.Number.ModArithmetic.expSafe'.  Decryption inverts the shared
-- secret by Fermat's little theorem rather than by the extended Euclidean
-- algorithm, whose steps follow the bits it is given.  'sign' cannot do that
-- -- @k@ is inverted modulo @p-1@, which is even -- so it blinds instead: the
-- algorithm is handed @k@ times a fresh random unit, and the blinder is
-- divided out afterwards.  'signWith', having no randomness of its own, hands
-- it @k@.
--
-- What is left is the 'Integer' arithmetic around all of that, whose cost
-- follows the size of the numbers.  See "Crypto.PubKey.DSA" for the same note
-- at more length.
module Crypto.PubKey.ElGamal (
    Params,
    PublicNumber,
    PrivateNumber,
    EphemeralKey (..),
    SharedKey,
    Signature (..),

    -- * Generation
    generatePrivate,
    generatePublic,

    -- * Encryption and decryption with no scheme
    encryptWith,
    encrypt,
    decrypt,

    -- * Signature primitives
    signWith,
    signDigestWith,
    sign,
    signDigest,

    -- * Verification primitives
    verify,
    verifyDigest,
) where

import Crypto.Error
import Crypto.Hash
import Crypto.Internal.ByteArray (ByteArrayAccess)
import Crypto.Internal.Imports
import Crypto.Number.Basic (gcde)
import Crypto.Number.Generate (generateBetween, generateMax)
import Crypto.Number.ModArithmetic (expFast, expSafe, inverseSafe)
import Crypto.Number.Serialize (os2ip)
import Crypto.PubKey.DH (
    Params (..),
    PrivateNumber (..),
    PublicNumber (..),
    SharedKey (..),
 )
import Crypto.Random.Types
import Data.Data

-- | ElGamal Signature
data Signature = Signature
    { Signature -> Integer
sign_r :: Integer
    -- ^ ElGamal r
    , Signature -> Integer
sign_s :: Integer
    -- ^ ElGamal s
    }
    deriving (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, ReadPrec [Signature]
ReadPrec Signature
Int -> ReadS Signature
ReadS [Signature]
(Int -> ReadS Signature)
-> ReadS [Signature]
-> ReadPrec Signature
-> ReadPrec [Signature]
-> Read Signature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Signature
readsPrec :: Int -> ReadS Signature
$creadList :: ReadS [Signature]
readList :: ReadS [Signature]
$creadPrec :: ReadPrec Signature
readPrec :: ReadPrec Signature
$creadListPrec :: ReadPrec [Signature]
readListPrec :: ReadPrec [Signature]
Read, Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Typeable Signature
Typeable Signature =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Signature -> c Signature)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Signature)
-> (Signature -> Constr)
-> (Signature -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Signature))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature))
-> ((forall b. Data b => b -> b) -> Signature -> Signature)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Signature -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Signature -> r)
-> (forall u. (forall d. Data d => d -> u) -> Signature -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Signature -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Signature -> m Signature)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Signature -> m Signature)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Signature -> m Signature)
-> Data Signature
Signature -> Constr
Signature -> DataType
(forall b. Data b => b -> b) -> Signature -> Signature
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Signature -> u
forall u. (forall d. Data d => d -> u) -> Signature -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Signature -> c Signature
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Signature
$ctoConstr :: Signature -> Constr
toConstr :: Signature -> Constr
$cdataTypeOf :: Signature -> DataType
dataTypeOf :: Signature -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Signature)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Signature)
$cgmapT :: (forall b. Data b => b -> b) -> Signature -> Signature
gmapT :: (forall b. Data b => b -> b) -> Signature -> Signature
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Signature -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Signature -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Signature -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Signature -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Signature -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Signature -> m Signature
Data)

instance NFData Signature where
    rnf :: Signature -> ()
rnf (Signature Integer
r Integer
s) = Integer
r Integer -> () -> ()
forall a b. a -> b -> b
`seq` Integer
s Integer -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | ElGamal Ephemeral key. also called Temporary key.
newtype EphemeralKey = EphemeralKey Integer
    deriving (EphemeralKey -> ()
(EphemeralKey -> ()) -> NFData EphemeralKey
forall a. (a -> ()) -> NFData a
$crnf :: EphemeralKey -> ()
rnf :: EphemeralKey -> ()
NFData)

-- | generate a private number, in @[1, q-1]@ where @q@ is the order of the
-- group.  Zero is excluded: it would make the public number 1 and the shared
-- value constant.
generatePrivate :: MonadRandom m => Integer -> m PrivateNumber
generatePrivate :: forall (m :: * -> *). MonadRandom m => Integer -> m PrivateNumber
generatePrivate Integer
q = Integer -> PrivateNumber
PrivateNumber (Integer -> PrivateNumber) -> m Integer -> m PrivateNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
1 (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

-- | generate a public number that is for the other party benefits.
-- this number is usually called h=g^a
generatePublic :: Params -> PrivateNumber -> PublicNumber
generatePublic :: Params -> PrivateNumber -> PublicNumber
generatePublic (Params Integer
p Integer
g Int
_) (PrivateNumber Integer
a) = Integer -> PublicNumber
PublicNumber (Integer -> PublicNumber) -> Integer -> PublicNumber
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
expSafe Integer
g Integer
a Integer
p

-- | Is the other party's public number usable?
--
-- @1@ and @p-1@ generate a group of one or two elements, so the value they
-- mask the message with is one of a handful of constants.
validPublic :: Integer -> Integer -> Bool
validPublic :: Integer -> Integer -> Bool
validPublic Integer
p Integer
h = Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 Bool -> Bool -> Bool
&& Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

-- | encrypt with a specified ephemeral key
--
-- The ephemeral key must lie in @[1, p-2]@ and must never be reused: zero
-- would leave the message unmasked, and a repeat lets anyone who learns one
-- plaintext recover the other.  A message must be below the modulus, or
-- decryption would return it reduced.
encryptWith
    :: EphemeralKey
    -> Params
    -> PublicNumber
    -> Integer
    -> CryptoFailable (Integer, Integer)
encryptWith :: EphemeralKey
-> Params
-> PublicNumber
-> Integer
-> CryptoFailable (Integer, Integer)
encryptWith (EphemeralKey Integer
b) (Params Integer
p Integer
g Int
_) (PublicNumber Integer
h) Integer
m
    | Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Bool -> Bool -> Bool
|| Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 = CryptoError -> CryptoFailable (Integer, Integer)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Bool -> Bool
not (Integer -> Integer -> Bool
validPublic Integer
p Integer
h) = CryptoError -> CryptoFailable (Integer, Integer)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p = CryptoError -> CryptoFailable (Integer, Integer)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Bool
otherwise = (Integer, Integer) -> CryptoFailable (Integer, Integer)
forall a. a -> CryptoFailable a
CryptoPassed (Integer
c1, Integer
c2)
  where
    s :: Integer
s = Integer -> Integer -> Integer -> Integer
expSafe Integer
h Integer
b Integer
p
    c1 :: Integer
c1 = Integer -> Integer -> Integer -> Integer
expSafe Integer
g Integer
b Integer
p
    c2 :: Integer
c2 = (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p

-- | encrypt a message using params and public keys
-- will generate b (called the ephemeral key)
encrypt
    :: MonadRandom m
    => Params
    -> PublicNumber
    -> Integer
    -> m (CryptoFailable (Integer, Integer))
encrypt :: forall (m :: * -> *).
MonadRandom m =>
Params
-> PublicNumber -> Integer -> m (CryptoFailable (Integer, Integer))
encrypt params :: Params
params@(Params Integer
p Integer
_ Int
_) PublicNumber
public Integer
m
    | Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
5 = CryptoFailable (Integer, Integer)
-> m (CryptoFailable (Integer, Integer))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoError -> CryptoFailable (Integer, Integer)
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid)
    | Bool
otherwise = do
        Integer
b <- Integer -> Integer -> m Integer
forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
1 (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)
        CryptoFailable (Integer, Integer)
-> m (CryptoFailable (Integer, Integer))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoFailable (Integer, Integer)
 -> m (CryptoFailable (Integer, Integer)))
-> CryptoFailable (Integer, Integer)
-> m (CryptoFailable (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ EphemeralKey
-> Params
-> PublicNumber
-> Integer
-> CryptoFailable (Integer, Integer)
encryptWith (Integer -> EphemeralKey
EphemeralKey Integer
b) Params
params PublicNumber
public Integer
m

-- | decrypt message
--
-- @c1@ must be a unit modulo @p@; a ciphertext whose first component is zero
-- or out of range is rejected rather than raising.
decrypt
    :: Params -> PrivateNumber -> (Integer, Integer) -> CryptoFailable Integer
decrypt :: Params
-> PrivateNumber -> (Integer, Integer) -> CryptoFailable Integer
decrypt (Params Integer
p Integer
_ Int
_) (PrivateNumber Integer
a) (Integer
c1, Integer
c2)
    | Integer
c1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 Bool -> Bool -> Bool
|| Integer
c1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p = CryptoError -> CryptoFailable Integer
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Integer
c2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
c2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p = CryptoError -> CryptoFailable Integer
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
    | Bool
otherwise = case Integer -> Integer -> Maybe Integer
inverseSafe Integer
s Integer
p of
        Maybe Integer
Nothing -> CryptoError -> CryptoFailable Integer
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_ParameterInvalid
        Just Integer
sm1 -> Integer -> CryptoFailable Integer
forall a. a -> CryptoFailable a
CryptoPassed ((Integer
c2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sm1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p)
  where
    -- the shared secret, which the extended Euclidean algorithm would take
    -- apart: its steps follow the bits of what it is given, and this one is
    -- worth the private number.  p is prime, so Fermat gives the inverse
    -- without reading it
    s :: Integer
s = Integer -> Integer -> Integer -> Integer
expSafe Integer
c1 Integer
a Integer
p

-- | sign a message with an explicit ephemeral value
--
-- @k@ has to lie in @[1, p-2]@ and be coprime with @p-1@.  'Nothing' says the
-- value handed in cannot be used: either it fails one of those two conditions,
-- or it is one of the few that produce a second component of zero.  Either way
-- the answer is to draw another @k@, which is what 'sign' does.
--
-- @k@ is an ephemeral private key.  It has to be drawn uniformly at random,
-- kept secret, and used for one signature only: the private number follows
-- from a signature and its @k@, and equally from two signatures made with the
-- same @k@.  None of that is visible to this function, which is why it takes
-- @k@ from the caller and checks only what it can.
signWith
    :: (ByteArrayAccess msg, HashAlgorithm hash)
    => Integer
    -- ^ ephemeral value k, in [1, p-2] and coprime with p-1
    -> Params
    -- ^ DH params (p,g)
    -> PrivateNumber
    -- ^ DH private key
    -> hash
    -- ^ collision resistant hash algorithm
    -> msg
    -- ^ message to sign
    -> Maybe Signature
signWith :: forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
Integer
-> Params -> PrivateNumber -> hash -> msg -> Maybe Signature
signWith Integer
k Params
params PrivateNumber
priv hash
hashAlg msg
msg =
    Integer
-> Params -> PrivateNumber -> Digest hash -> Maybe Signature
forall hash.
HashAlgorithm hash =>
Integer
-> Params -> PrivateNumber -> Digest hash -> Maybe Signature
signDigestWith Integer
k Params
params PrivateNumber
priv (hash -> msg -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)

-- | Sign a digest with an explicit ephemeral value.
--
-- The digest's type says which algorithm made it, so this needs nothing else
-- to name one.  'signWith' takes a @hash@ value and never reads it -- it is
-- there to fix the type -- which leaves a caller that is itself polymorphic
-- in the algorithm with nothing to pass.
signDigestWith
    :: HashAlgorithm hash
    => Integer
    -- ^ ephemeral value k, in [1, p-2] and coprime with p-1
    -> Params
    -- ^ DH params (p,g)
    -> PrivateNumber
    -- ^ DH private key
    -> Digest hash
    -- ^ digest of the message to sign
    -> Maybe Signature
signDigestWith :: forall hash.
HashAlgorithm hash =>
Integer
-> Params -> PrivateNumber -> Digest hash -> Maybe Signature
signDigestWith = Integer
-> Integer
-> Params
-> PrivateNumber
-> Digest hash
-> Maybe Signature
forall hash.
HashAlgorithm hash =>
Integer
-> Integer
-> Params
-> PrivateNumber
-> Digest hash
-> Maybe Signature
signWithBlinder Integer
1

-- | The same with a blinder for the inversion of @k@.
--
-- @k@ is inverted modulo @p-1@, which is even, so Fermat's little theorem
-- does not reach it the way it reaches DSA's @k@ modulo a prime order: the
-- extended Euclidean algorithm is the only way there, and its steps follow
-- the bits of what it is given.  What can be done instead is to hand it
-- something else: for a unit @b@, the inverse of @k*b@ times @b@ is the
-- inverse of @k@, and the steps then follow @k*b@, which is a fresh random
-- number.  A blinder of 1 is no blinding, which is what the exported
-- 'signWith' has to do, having no randomness of its own.
--
-- When @b@ shares a factor with @p-1@ the algorithm reports it the same way
-- it reports one in @k@, and the answer is the same: draw again.
signWithBlinder
    :: HashAlgorithm hash
    => Integer -> Integer -> Params -> PrivateNumber -> Digest hash -> Maybe Signature
signWithBlinder :: forall hash.
HashAlgorithm hash =>
Integer
-> Integer
-> Params
-> PrivateNumber
-> Digest hash
-> Maybe Signature
signWithBlinder Integer
b Integer
k (Params Integer
p Integer
g Int
_) (PrivateNumber Integer
x) Digest hash
digest
    | Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 Bool -> Bool -> Bool
|| Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Bool -> Bool -> Bool
|| Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 Bool -> Bool -> Bool
|| Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 = Maybe Signature
forall a. Maybe a
Nothing
    | Integer
s Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Maybe Signature
forall a. Maybe a
Nothing
    | Bool
otherwise = Signature -> Maybe Signature
forall a. a -> Maybe a
Just (Signature -> Maybe Signature) -> Signature -> Maybe Signature
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Signature
Signature Integer
r Integer
s
  where
    r :: Integer
r = Integer -> Integer -> Integer -> Integer
expSafe Integer
g Integer
k Integer
p
    h :: Integer
h = Digest hash -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip Digest hash
digest
    s :: Integer
s = ((Integer
h Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
kInv) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    kInv :: Integer
kInv = (Integer
kbInv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    (Integer
kbInv, Integer
_, Integer
d) = Integer -> Integer -> (Integer, Integer, Integer)
gcde ((Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)) (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

-- | sign message
--
-- This function draws the ephemeral value itself, and draws a fresh one on
-- each attempt until 'signWith' accepts it, so a caller who has no particular
-- @k@ in mind should use this rather than 'signWith'.
sign
    :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m)
    => Params
    -- ^ DH params (p,g)
    -> PrivateNumber
    -- ^ DH private key
    -> hash
    -- ^ collision resistant hash algorithm
    -> msg
    -- ^ message to sign
    -> m Signature
sign :: forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
Params -> PrivateNumber -> hash -> msg -> m Signature
sign Params
params PrivateNumber
priv hash
hashAlg msg
msg = Params -> PrivateNumber -> Digest hash -> m Signature
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Params -> PrivateNumber -> Digest hash -> m Signature
signDigest Params
params PrivateNumber
priv (hash -> msg -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)

-- | Sign a digest, drawing the ephemeral value.  See 'signDigestWith' for
-- why a digest rather than a @hash@ value.
signDigest
    :: (HashAlgorithm hash, MonadRandom m)
    => Params -> PrivateNumber -> Digest hash -> m Signature
signDigest :: forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Params -> PrivateNumber -> Digest hash -> m Signature
signDigest params :: Params
params@(Params Integer
p Integer
_ Int
_) PrivateNumber
priv Digest hash
digest = do
    Integer
k <- Integer -> m Integer
forall (m :: * -> *). MonadRandom m => Integer -> m Integer
generateMax (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    -- and a blinder for the inversion of k, which is the one step here that
    -- the extended Euclidean algorithm has to do
    Integer
b <- Integer -> m Integer
forall (m :: * -> *). MonadRandom m => Integer -> m Integer
generateMax (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
    case Integer
-> Integer
-> Params
-> PrivateNumber
-> Digest hash
-> Maybe Signature
forall hash.
HashAlgorithm hash =>
Integer
-> Integer
-> Params
-> PrivateNumber
-> Digest hash
-> Maybe Signature
signWithBlinder Integer
b Integer
k Params
params PrivateNumber
priv Digest hash
digest of
        Maybe Signature
Nothing -> Params -> PrivateNumber -> Digest hash -> m Signature
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Params -> PrivateNumber -> Digest hash -> m Signature
signDigest Params
params PrivateNumber
priv Digest hash
digest
        Just Signature
sig -> Signature -> m Signature
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Signature
sig

-- | verify a signature
verify
    :: (ByteArrayAccess msg, HashAlgorithm hash)
    => Params
    -> PublicNumber
    -> hash
    -> msg
    -> Signature
    -> Bool
verify :: forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
Params -> PublicNumber -> hash -> msg -> Signature -> Bool
verify Params
params PublicNumber
pub hash
hashAlg msg
msg Signature
sig =
    Params -> PublicNumber -> Digest hash -> Signature -> Bool
forall hash.
HashAlgorithm hash =>
Params -> PublicNumber -> Digest hash -> Signature -> Bool
verifyDigest Params
params PublicNumber
pub (hash -> msg -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg) Signature
sig

-- | Verify a signature over a digest.  See 'signDigestWith' for why a digest
-- rather than a @hash@ value.
verifyDigest
    :: HashAlgorithm hash
    => Params -> PublicNumber -> Digest hash -> Signature -> Bool
verifyDigest :: forall hash.
HashAlgorithm hash =>
Params -> PublicNumber -> Digest hash -> Signature -> Bool
verifyDigest (Params Integer
p Integer
g Int
_) (PublicNumber Integer
y) Digest hash
digest (Signature Integer
r Integer
s)
    | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0, Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p, Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0, Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)] = Bool
False
    | Bool
otherwise = Integer
lhs Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
rhs
  where
    h :: Integer
h = Digest hash -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip Digest hash
digest
    lhs :: Integer
lhs = Integer -> Integer -> Integer -> Integer
expFast Integer
g Integer
h Integer
p
    rhs :: Integer
rhs = (Integer -> Integer -> Integer -> Integer
expFast Integer
y Integer
r Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Integer -> Integer
expFast Integer
r Integer
s Integer
p) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p