DSA.hs

{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module      : Crypto.PubKey.DSA
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
-- An implementation of the Digital Signature Algorithm (DSA)
--
-- == What is kept from the clock, and what is not
--
-- Signing keeps the private number and the ephemeral @k@ out of the two
-- places whose duration would otherwise follow them: the exponentiation is
-- 'Crypto.Number.ModArithmetic.expSafe', which walks the exponent a fixed
-- four bits at a time, and @k@ is inverted by Fermat's little theorem rather
-- than by the extended Euclidean algorithm, whose number of steps follows the
-- bits it is given.
--
-- What is left is the arithmetic around them.  @x * r@, the addition and the
-- reduction modulo @q@ are 'Integer' operations, and an 'Integer' costs what
-- its size says: a private number that happens to be short is multiplied in
-- fewer words than a full-length one.  The same holds in
-- "Crypto.PubKey.ElGamal" and "Crypto.PubKey.Rabin.Basic".  Removing it means
-- leaving 'Integer' for a fixed-width representation, which is what
-- "Crypto.PubKey.RSA" does for its exponentiation and the curve modules do
-- throughout; there is nothing a caller can do about it from here.
module Crypto.PubKey.DSA (
    Params (..),
    Signature (..),
    PublicKey (..),
    PrivateKey (..),
    PublicNumber,
    PrivateNumber,

    -- * Generation
    generatePrivate,
    calculatePublic,

    -- * Signature primitive
    sign,
    signWith,

    -- * Verification primitive
    verify,

    -- * Key pair
    KeyPair (..),
    toPublicKey,
    toPrivateKey,
) where

import Crypto.Debug (DebugShow (..))
import Data.Data

import Crypto.Hash
import Crypto.Internal.ByteArray (ByteArrayAccess)
import Crypto.Internal.Imports
import Crypto.Number.Generate
import Crypto.Number.ModArithmetic (expFast, expSafe, inverse, inverseSafe)
import Crypto.PubKey.Internal (dsaTruncHash)
import Crypto.Random.Types

-- | DSA Public Number, usually embedded in DSA Public Key
type PublicNumber = Integer

-- | DSA Private Number, usually embedded in DSA Private Key
type PrivateNumber = Integer

-- | Represent DSA parameters namely P, G, and Q.
data Params = Params
    { params_p :: Integer
    -- ^ DSA p
    , params_g :: Integer
    -- ^ DSA g
    , params_q :: Integer
    -- ^ DSA q
    }
    deriving (Show, Read, Eq, Data)

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

-- | Represent a DSA signature namely R and S.
data Signature = Signature
    { sign_r :: Integer
    -- ^ DSA r
    , sign_s :: Integer
    -- ^ DSA s
    }
    deriving (Show, Read, Eq, Data)

instance NFData Signature where
    rnf (Signature r s) = r `seq` s `seq` ()

-- | Represent a DSA public key.
data PublicKey = PublicKey
    { public_params :: Params
    -- ^ DSA parameters
    , public_y :: PublicNumber
    -- ^ DSA public Y
    }
    deriving (Show, Read, Eq, Data)

instance NFData PublicKey where
    rnf (PublicKey params y) = y `seq` params `seq` ()

-- | Represent a DSA private key.
--
-- Only x need to be secret.
-- the DSA parameters are publicly shared with the other side.
data PrivateKey = PrivateKey
    { private_params :: Params
    -- ^ DSA parameters
    , private_x :: PrivateNumber
    -- ^ DSA private X
    }
    deriving (Read, Eq, Data)

-- | The parameters are shown; @private_x@ is not.  Use
-- 'Crypto.Debug.debugShow' to see it.
instance Show PrivateKey where
    showsPrec d k =
        showParen (d > 10) $
            showString "PrivateKey {private_params = "
                . shows (private_params k)
                . showString ", private_x = <secret>}"

instance DebugShow PrivateKey where
    debugShow k =
        showString "PrivateKey {private_params = "
            . shows (private_params k)
            . showString ", private_x = "
            . shows (private_x k)
            . showChar '}'
            $ ""

instance NFData PrivateKey where
    rnf (PrivateKey params x) = x `seq` params `seq` ()

-- | Represent a DSA key pair
data KeyPair = KeyPair Params PublicNumber PrivateNumber
    deriving (Read, Eq, Data)

instance Show KeyPair where
    showsPrec d (KeyPair params y _) =
        showParen (d > 10) $
            showString "KeyPair "
                . showsPrec 11 params
                . showChar ' '
                . showsPrec 11 y
                . showString " <secret>"

instance DebugShow KeyPair where
    debugShow (KeyPair params y x) =
        showString "KeyPair "
            . showsPrec 11 params
            . showChar ' '
            . showsPrec 11 y
            . showChar ' '
            . showsPrec 11 x
            $ ""

instance NFData KeyPair where
    rnf (KeyPair params y x) = x `seq` y `seq` params `seq` ()

-- | Public key of a DSA Key pair
toPublicKey :: KeyPair -> PublicKey
toPublicKey (KeyPair params pub _) = PublicKey params pub

-- | Private key of a DSA Key pair
toPrivateKey :: KeyPair -> PrivateKey
toPrivateKey (KeyPair params _ priv) = PrivateKey params priv

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

-- | Calculate the public number from the parameters and the private key
calculatePublic :: Params -> PrivateNumber -> PublicNumber
calculatePublic (Params p g _) x = expSafe g x p

-- | sign message using the private key and an explicit k number.
signWith
    :: (ByteArrayAccess msg, HashAlgorithm hash)
    => Integer
    -- ^ k random number
    -> PrivateKey
    -- ^ private key
    -> hash
    -- ^ hash function
    -> msg
    -- ^ message to sign
    -> Maybe Signature
signWith k pk hashAlg msg = do
    -- k comes from the caller and is only invertible when it is coprime with
    -- q, which the caller cannot check without knowing q is prime.  It is also
    -- a secret worth as much as the private key, so it is inverted without
    -- the extended Euclidean algorithm, whose steps follow the bits of what
    -- it is given
    kInv <- inverseSafe k q
    let hm = dsaTruncHash hashAlg msg q
        r = expSafe g k p `mod` q
        s = (kInv * (hm + x * r)) `mod` q
    if r == 0 || s == 0 then Nothing else Just $ Signature r s
  where
    -- parameters
    (Params p g q) = private_params pk
    x = private_x pk

-- | sign message using the private key.
sign
    :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m)
    => PrivateKey -> hash -> msg -> m Signature
sign pk hashAlg msg = do
    k <- generateMax q
    case signWith k pk hashAlg msg of
        Nothing -> sign pk hashAlg msg
        Just sig -> return sig
  where
    (Params _ _ q) = private_params pk

-- | verify a bytestring using the public key.
verify
    :: (ByteArrayAccess msg, HashAlgorithm hash)
    => hash -> PublicKey -> Signature -> msg -> Bool
verify hashAlg pk (Signature r s) m
    -- Reject the signature if either 0 < r < q or 0 < s < q is not satisfied.
    | r <= 0 || r >= q || s <= 0 || s >= q = False
    -- s is invertible for every 0 < s < q when q is prime, but the parameters
    -- arrive with the public key and a composite q admits an s that is not
    | otherwise = maybe False (r ==) v
  where
    (Params p g q) = public_params pk
    y = public_y pk
    hm = dsaTruncHash hashAlg m q
    v = do
        w <- inverse s q
        let u1 = (hm * w) `mod` q
            u2 = (r * w) `mod` q
        return $ ((expFast g u1 p) * (expFast y u2 p)) `mod` p `mod` q