1-- | /WARNING:/ Signature operations may leak the private key. Signature verification
2-- should be safe.
3{-# LANGUAGE DeriveDataTypeable #-}
4module Crypto.PubKey.ECC.ECDSA
5    ( Signature(..)
6    , PublicPoint
7    , PublicKey(..)
8    , PrivateNumber
9    , PrivateKey(..)
10    , KeyPair(..)
11    , toPublicKey
12    , toPrivateKey
13    , signWith
14    , signDigestWith
15    , sign
16    , signDigest
17    , verify
18    , verifyDigest
19    ) where
20
21import Control.Monad
22import Data.Data
23
24import Crypto.Hash
25import Crypto.Internal.ByteArray (ByteArrayAccess)
26import Crypto.Number.ModArithmetic (inverse)
27import Crypto.Number.Generate
28import Crypto.PubKey.ECC.Types
29import Crypto.PubKey.ECC.Prim
30import Crypto.PubKey.Internal (dsaTruncHashDigest)
31import Crypto.Random.Types
32
33-- | Represent a ECDSA signature namely R and S.
34data Signature = Signature
35    { sign_r :: Integer -- ^ ECDSA r
36    , sign_s :: Integer -- ^ ECDSA s
37    } deriving (Show,Read,Eq,Data)
38
39-- | ECDSA Private Key.
40data PrivateKey = PrivateKey
41    { private_curve :: Curve
42    , private_d     :: PrivateNumber
43    } deriving (Show,Read,Eq,Data)
44
45-- | ECDSA Public Key.
46data PublicKey = PublicKey
47    { public_curve :: Curve
48    , public_q     :: PublicPoint
49    } deriving (Show,Read,Eq,Data)
50
51-- | ECDSA Key Pair.
52data KeyPair = KeyPair Curve PublicPoint PrivateNumber
53    deriving (Show,Read,Eq,Data)
54
55-- | Public key of a ECDSA Key pair.
56toPublicKey :: KeyPair -> PublicKey
57toPublicKey (KeyPair curve pub _) = PublicKey curve pub
58
59-- | Private key of a ECDSA Key pair.
60toPrivateKey :: KeyPair -> PrivateKey
61toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv
62
63-- | Sign digest using the private key and an explicit k number.
64--
65-- /WARNING:/ Vulnerable to timing attacks.
66signDigestWith :: HashAlgorithm hash
67               => Integer     -- ^ k random number
68               -> PrivateKey  -- ^ private key
69               -> Digest hash -- ^ digest to sign
70               -> Maybe Signature
71signDigestWith k (PrivateKey curve d) digest = do
72    let z = dsaTruncHashDigest digest n
73        CurveCommon _ _ g n _ = common_curve curve
74    let point = pointMul curve k g
75    r <- case point of
76              PointO    -> Nothing
77              Point x _ -> return $ x `mod` n
78    kInv <- inverse k n
79    let s = kInv * (z + r * d) `mod` n
80    when (r == 0 || s == 0) Nothing
81    return $ Signature r s
82
83-- | Sign message using the private key and an explicit k number.
84--
85-- /WARNING:/ Vulnerable to timing attacks.
86signWith :: (ByteArrayAccess msg, HashAlgorithm hash)
87         => Integer    -- ^ k random number
88         -> PrivateKey -- ^ private key
89         -> hash       -- ^ hash function
90         -> msg        -- ^ message to sign
91         -> Maybe Signature
92signWith k pk hashAlg msg = signDigestWith k pk (hashWith hashAlg msg)
93
94-- | Sign digest using the private key.
95--
96-- /WARNING:/ Vulnerable to timing attacks.
97signDigest :: (HashAlgorithm hash, MonadRandom m)
98           => PrivateKey -> Digest hash -> m Signature
99signDigest pk digest = do
100    k <- generateBetween 1 (n - 1)
101    case signDigestWith k pk digest of
102         Nothing  -> signDigest pk digest
103         Just sig -> return sig
104  where n = ecc_n . common_curve $ private_curve pk
105
106-- | Sign message using the private key.
107--
108-- /WARNING:/ Vulnerable to timing attacks.
109sign :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m)
110     => PrivateKey -> hash -> msg -> m Signature
111sign pk hashAlg msg = signDigest pk (hashWith hashAlg msg)
112
113-- | Verify a digest using the public key.
114verifyDigest :: HashAlgorithm hash => PublicKey -> Signature -> Digest hash -> Bool
115verifyDigest (PublicKey _ PointO) _ _ = False
116verifyDigest pk@(PublicKey curve q) (Signature r s) digest
117    | r < 1 || r >= n || s < 1 || s >= n = False
118    | otherwise = maybe False (r ==) $ do
119        w <- inverse s n
120        let z  = dsaTruncHashDigest digest n
121            u1 = z * w `mod` n
122            u2 = r * w `mod` n
123            x  = pointAddTwoMuls curve u1 g u2 q
124        case x of
125             PointO     -> Nothing
126             Point x1 _ -> return $ x1 `mod` n
127  where n = ecc_n cc
128        g = ecc_g cc
129        cc = common_curve $ public_curve pk
130
131-- | Verify a bytestring using the public key.
132verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
133verify hashAlg pk sig msg = verifyDigest pk sig (hashWith hashAlg msg)
134