DH.hs

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

-- |
-- Module      : Crypto.PubKey.DH
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
module Crypto.PubKey.DH (
    Params (..),
    PublicNumber (..),
    PrivateNumber (..),
    SharedKey (..),
    generateParams,
    generatePrivate,
    calculatePublic,
    generatePublic,
    getShared,
    tryGetShared,
) where

import Crypto.Debug (DebugShow (..))
import Crypto.Error (
    CryptoError (..),
    CryptoFailable (..),
    throwCryptoError,
 )
import Crypto.Internal.Imports
import Crypto.Number.Basic (numBytes)
import Crypto.Number.Generate (generateMax)
import Crypto.Number.ModArithmetic (expSafe)
import Crypto.Number.Prime (generateSafePrime)
import Crypto.Number.Serialize (i2ospOf_)
import Crypto.Random.Types
import Data.ByteArray (ByteArrayAccess, ScrubbedBytes)
import Data.Data

-- | Represent Diffie Hellman parameters namely P (prime), and G (generator).
data Params = Params
    { params_p :: Integer
    , params_g :: Integer
    , params_bits :: Int
    }
    deriving (Show, Read, Eq, Data)

instance NFData Params where
    rnf (Params p g bits) = rnf p `seq` rnf g `seq` bits `seq` ()

-- | Represent Diffie Hellman public number Y.
newtype PublicNumber = PublicNumber Integer
    deriving (Show, Read, Eq, Enum, Real, Num, Ord, NFData)

-- | Represent Diffie Hellman private number X.
newtype PrivateNumber = PrivateNumber Integer
    deriving (Read, Eq, Enum, Real, Num, Ord, NFData)

-- | The number is not shown.  Use 'Crypto.Debug.debugShow' to see it.
instance Show PrivateNumber where
    show _ = "PrivateNumber <secret>"

instance DebugShow PrivateNumber where
    debugShow (PrivateNumber n) =
        showString "PrivateNumber " . showsPrec 11 n $ ""

-- | Represent Diffie Hellman shared secret.
newtype SharedKey = SharedKey ScrubbedBytes
    deriving (Show, Eq, ByteArrayAccess, NFData)

-- | generate params from a specific generator (2 or 5 are common values)
-- we generate a safe prime (a prime number of the form 2p+1 where p is also prime)
generateParams
    :: MonadRandom m
    => Int
    -- ^ number of bits
    -> Integer
    -- ^ generator
    -> m Params
generateParams bits generator =
    (\p -> Params p generator bits) <$> generateSafePrime bits

-- | generate a private number with no specific property
-- this number is usually called X in DH text.
generatePrivate :: MonadRandom m => Params -> m PrivateNumber
generatePrivate (Params p _ _) = PrivateNumber <$> generateMax p

-- | calculate the public number from the parameters and the private key
-- this number is usually called Y in DH text.
calculatePublic :: Params -> PrivateNumber -> PublicNumber
calculatePublic (Params p g _) (PrivateNumber x) = PublicNumber $ expSafe g x p

-- | calculate the public number from the parameters and the private key
-- this number is usually called Y in DH text.
--
-- DEPRECATED use calculatePublic
generatePublic :: Params -> PrivateNumber -> PublicNumber
generatePublic = calculatePublic

-- commented until 0.3 {-# DEPRECATED generatePublic "use calculatePublic" #-}

-- | generate a shared key using our private number and the other party public number
--
-- This raises the 'CryptoError' that 'tryGetShared' reports.  Use 'tryGetShared'
-- where the failure has to be handled.
getShared :: Params -> PrivateNumber -> PublicNumber -> SharedKey
getShared params x y = throwCryptoError $ tryGetShared params x y

-- | generate a shared key using our private number and the other party public
-- number, reporting a rejected public number instead of raising.
--
-- The public number comes from the other party, so it is checked to satisfy
-- @1 < y < p-1@ as RFC 7919 section 5.1 requires.  The excluded values
-- generate the subgroup @{1}@ or @{1, p-1}@, so the shared secret they produce
-- is one of a handful of constants and carries none of our private number's
-- secrecy.  A value outside that range is reported as
-- 'CryptoError_ParameterInvalid'.
--
-- Note this is the only check made here: it does not establish that @y@ lies
-- in the subgroup generated by @g@, which needs the subgroup order that
-- t'Params' does not carry.
tryGetShared
    :: Params -> PrivateNumber -> PublicNumber -> CryptoFailable SharedKey
tryGetShared (Params p _ _) (PrivateNumber x) (PublicNumber y)
    | y <= 1 || y >= p - 1 = CryptoFailed CryptoError_ParameterInvalid
    -- the size of p, not params_bits: only p and g travel on the wire, so a
    -- caller-supplied bit size can disagree with p
    | otherwise = CryptoPassed $ SharedKey $ i2ospOf_ (numBytes p) $ expSafe y x p