1-- |
2-- Module      : Crypto.PubKey.EdDSA
3-- License     : BSD-style
4-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- EdDSA signature generation and verification, implemented in Haskell and
9-- parameterized with elliptic curve and hash algorithm.  Only edwards25519 is
10-- supported at the moment.
11--
12-- The module provides \"context\" and \"prehash\" variants defined in
13-- <https://tools.ietf.org/html/rfc8032 RFC 8032>.
14--
15-- This implementation is most useful when wanting to customize the hash
16-- algorithm.  See module "Crypto.PubKey.Ed25519" for faster Ed25519 with
17-- SHA-512.
18--
19{-# LANGUAGE DataKinds                  #-}
20{-# LANGUAGE FlexibleContexts           #-}
21{-# LANGUAGE GeneralizedNewtypeDeriving #-}
22{-# LANGUAGE OverloadedStrings          #-}
23{-# LANGUAGE RankNTypes                 #-}
24{-# LANGUAGE ScopedTypeVariables        #-}
25{-# LANGUAGE TypeFamilies               #-}
26module Crypto.PubKey.EdDSA
27    ( SecretKey
28    , PublicKey
29    , Signature
30    -- * Curves with EdDSA implementation
31    , EllipticCurveEdDSA(CurveDigestSize)
32    , publicKeySize
33    , secretKeySize
34    , signatureSize
35    -- * Smart constructors
36    , signature
37    , publicKey
38    , secretKey
39    -- * Methods
40    , toPublic
41    , sign
42    , signCtx
43    , signPh
44    , verify
45    , verifyCtx
46    , verifyPh
47    , generateSecretKey
48    ) where
49
50import           Data.Bits
51import           Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View)
52import qualified Data.ByteArray as B
53import           Data.ByteString (ByteString)
54import           Data.Proxy
55
56import           Crypto.ECC
57import qualified Crypto.ECC.Edwards25519 as Edwards25519
58import           Crypto.Error
59import           Crypto.Hash (Digest)
60import           Crypto.Hash.IO
61import           Crypto.Random
62
63import           GHC.TypeLits (KnownNat, Nat)
64
65import           Crypto.Internal.Builder
66import           Crypto.Internal.Compat
67import           Crypto.Internal.Imports
68import           Crypto.Internal.Nat (integralNatVal)
69
70import           Foreign.Storable
71
72
73-- API
74
75-- | An EdDSA Secret key
76newtype SecretKey curve = SecretKey ScrubbedBytes
77    deriving (Show,Eq,ByteArrayAccess,NFData)
78
79-- | An EdDSA public key
80newtype PublicKey curve hash = PublicKey Bytes
81    deriving (Show,Eq,ByteArrayAccess,NFData)
82
83-- | An EdDSA signature
84newtype Signature curve hash = Signature Bytes
85    deriving (Show,Eq,ByteArrayAccess,NFData)
86
87-- | Elliptic curves with an implementation of EdDSA
88class ( EllipticCurveBasepointArith curve
89      , KnownNat (CurveDigestSize curve)
90      ) => EllipticCurveEdDSA curve where
91
92    -- | Size of the digest for this curve (in bytes)
93    type CurveDigestSize curve :: Nat
94
95    -- | Size of secret keys for this curve (in bytes)
96    secretKeySize :: proxy curve -> Int
97
98    -- hash with specified parameters
99    hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg)
100                => proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
101
102    -- conversion between scalar, point and public key
103    pointPublic :: proxy curve -> Point curve -> PublicKey curve hash
104    publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
105    encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs
106    decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve)
107
108    -- how to use bits in a secret key
109    scheduleSecret :: ( HashAlgorithm hash
110                      , HashDigestSize hash ~ CurveDigestSize curve
111                      )
112                   => proxy curve
113                   -> hash
114                   -> SecretKey curve
115                   -> (Scalar curve, View Bytes)
116
117-- | Size of public keys for this curve (in bytes)
118publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int
119publicKeySize prx = signatureSize prx `div` 2
120
121-- | Size of signatures for this curve (in bytes)
122signatureSize :: forall proxy curve . EllipticCurveEdDSA curve
123              => proxy curve -> Int
124signatureSize _ = integralNatVal (Proxy :: Proxy (CurveDigestSize curve))
125
126
127-- Constructors
128
129-- | Try to build a public key from a bytearray
130publicKey :: ( EllipticCurveEdDSA curve
131             , HashAlgorithm hash
132             , HashDigestSize hash ~ CurveDigestSize curve
133             , ByteArrayAccess ba
134             )
135          => proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
136publicKey prx _ bs
137    | B.length bs == publicKeySize prx =
138        CryptoPassed (PublicKey $ B.convert bs)
139    | otherwise =
140        CryptoFailed CryptoError_PublicKeySizeInvalid
141
142-- | Try to build a secret key from a bytearray
143secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba)
144          => proxy curve -> ba -> CryptoFailable (SecretKey curve)
145secretKey prx bs
146    | B.length bs == secretKeySize prx =
147        CryptoPassed (SecretKey $ B.convert bs)
148    | otherwise                        =
149        CryptoFailed CryptoError_SecretKeyStructureInvalid
150
151-- | Try to build a signature from a bytearray
152signature :: ( EllipticCurveEdDSA curve
153             , HashAlgorithm hash
154             , HashDigestSize hash ~ CurveDigestSize curve
155             , ByteArrayAccess ba
156             )
157          => proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
158signature prx _ bs
159    | B.length bs == signatureSize prx =
160        CryptoPassed (Signature $ B.convert bs)
161    | otherwise =
162        CryptoFailed CryptoError_SecretKeyStructureInvalid
163
164
165-- Conversions
166
167-- | Generate a secret key
168generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m)
169                  => proxy curve -> m (SecretKey curve)
170generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx)
171
172-- | Create a public key from a secret key
173toPublic :: ( EllipticCurveEdDSA curve
174            , HashAlgorithm hash
175            , HashDigestSize hash ~ CurveDigestSize curve
176            )
177         => proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
178toPublic prx alg priv =
179    let p = pointBaseSmul prx (secretScalar prx alg priv)
180     in pointPublic prx p
181
182secretScalar :: ( EllipticCurveEdDSA curve
183                , HashAlgorithm hash
184                , HashDigestSize hash ~ CurveDigestSize curve
185                )
186             => proxy curve -> hash -> SecretKey curve -> Scalar curve
187secretScalar prx alg priv = fst (scheduleSecret prx alg priv)
188
189
190-- EdDSA signature generation & verification
191
192-- | Sign a message using the key pair
193sign :: ( EllipticCurveEdDSA curve
194        , HashAlgorithm hash
195        , HashDigestSize hash ~ CurveDigestSize curve
196        , ByteArrayAccess msg
197        )
198     => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
199sign prx = signCtx prx emptyCtx
200
201-- | Verify a message
202verify :: ( EllipticCurveEdDSA curve
203          , HashAlgorithm hash
204          , HashDigestSize hash ~ CurveDigestSize curve
205          , ByteArrayAccess msg
206          )
207       => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
208verify prx = verifyCtx prx emptyCtx
209
210-- | Sign a message using the key pair under context @ctx@
211signCtx :: ( EllipticCurveEdDSA curve
212           , HashAlgorithm hash
213           , HashDigestSize hash ~ CurveDigestSize curve
214           , ByteArrayAccess ctx
215           , ByteArrayAccess msg
216           )
217        => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
218signCtx prx = signPhCtx prx False
219
220-- | Verify a message under context @ctx@
221verifyCtx :: ( EllipticCurveEdDSA curve
222             , HashAlgorithm hash
223             , HashDigestSize hash ~ CurveDigestSize curve
224             , ByteArrayAccess ctx
225             , ByteArrayAccess msg
226             )
227          => proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
228verifyCtx prx = verifyPhCtx prx False
229
230-- | Sign a prehashed message using the key pair under context @ctx@
231signPh :: ( EllipticCurveEdDSA curve
232          , HashAlgorithm hash
233          , HashDigestSize hash ~ CurveDigestSize curve
234          , ByteArrayAccess ctx
235          )
236       => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash
237signPh prx = signPhCtx prx True
238
239-- | Verify a prehashed message under context @ctx@
240verifyPh :: ( EllipticCurveEdDSA curve
241            , HashAlgorithm hash
242            , HashDigestSize hash ~ CurveDigestSize curve
243            , ByteArrayAccess ctx
244            )
245         => proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool
246verifyPh prx = verifyPhCtx prx True
247
248signPhCtx :: forall proxy curve hash ctx msg .
249             ( EllipticCurveEdDSA curve
250             , HashAlgorithm hash
251             , HashDigestSize hash ~ CurveDigestSize curve
252             , ByteArrayAccess ctx
253             , ByteArrayAccess msg
254             )
255          => proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
256signPhCtx prx ph ctx priv pub msg =
257    let alg  = undefined :: hash
258        (s, prefix) = scheduleSecret prx alg priv
259        digR = hashWithDom prx alg ph ctx (bytes prefix) msg
260        r    = decodeScalarNoErr prx digR
261        pR   = pointBaseSmul prx r
262        bsR  = encodePoint prx pR
263        sK   = getK prx ph ctx pub bsR msg
264        sS   = scalarAdd prx r (scalarMul prx sK s)
265     in encodeSignature prx (bsR, pR, sS)
266
267verifyPhCtx :: ( EllipticCurveEdDSA curve
268               , HashAlgorithm hash
269               , HashDigestSize hash ~ CurveDigestSize curve
270               , ByteArrayAccess ctx
271               , ByteArrayAccess msg
272               )
273            => proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
274verifyPhCtx prx ph ctx pub msg sig =
275    case doVerify of
276        CryptoPassed verified -> verified
277        CryptoFailed _        -> False
278  where
279    doVerify = do
280        (bsR, pR, sS) <- decodeSignature prx sig
281        nPub <- pointNegate prx `fmap` publicPoint prx pub
282        let sK  = getK prx ph ctx pub bsR msg
283            pR' = pointsSmulVarTime prx sS sK nPub
284        return (pR == pR')
285
286emptyCtx :: Bytes
287emptyCtx = B.empty
288
289getK :: forall proxy curve hash ctx msg .
290        ( EllipticCurveEdDSA curve
291        , HashAlgorithm hash
292        , HashDigestSize hash ~ CurveDigestSize curve
293        , ByteArrayAccess ctx
294        , ByteArrayAccess msg
295        )
296     => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve
297getK prx ph ctx (PublicKey pub) bsR msg =
298    let alg  = undefined :: hash
299        digK = hashWithDom prx alg ph ctx (bytes bsR <> bytes pub) msg
300     in decodeScalarNoErr prx digK
301
302encodeSignature :: EllipticCurveEdDSA curve
303                => proxy curve
304                -> (Bytes, Point curve, Scalar curve)
305                -> Signature curve hash
306encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $
307    bytes bsR <> bytes bsS <> zero len0
308  where
309    bsS  = encodeScalarLE prx sS :: Bytes
310    len0 = signatureSize prx - B.length bsR - B.length bsS
311
312decodeSignature :: ( EllipticCurveEdDSA curve
313                   , HashDigestSize hash ~ CurveDigestSize curve
314                   )
315                => proxy curve
316                -> Signature curve hash
317                -> CryptoFailable (Bytes, Point curve, Scalar curve)
318decodeSignature prx (Signature bs) = do
319    let (bsR, bsS) = B.splitAt (publicKeySize prx) bs
320    pR <- decodePoint prx bsR
321    sS <- decodeScalarLE prx bsS
322    return (bsR, pR, sS)
323
324-- implementations are supposed to decode any scalar up to the size of the digest
325decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs)
326                  => proxy curve -> bs -> Scalar curve
327decodeScalarNoErr prx = unwrap "decodeScalarNoErr" . decodeScalarLE prx
328
329unwrap :: String -> CryptoFailable a -> a
330unwrap name (CryptoFailed _) = error (name ++ ": assumption failed")
331unwrap _    (CryptoPassed x) = x
332
333
334-- Ed25519 implementation
335
336instance EllipticCurveEdDSA Curve_Edwards25519 where
337    type CurveDigestSize Curve_Edwards25519 = 64
338    secretKeySize _ = 32
339
340    hashWithDom _ alg ph ctx bss
341        | not ph && B.null ctx = digestDomMsg alg bss
342        | otherwise            = digestDomMsg alg (dom <> bss)
343      where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <>
344                  byte (if ph then 1 else 0) <>
345                  byte (fromIntegral $ B.length ctx) <>
346                  bytes ctx
347
348    pointPublic _ = PublicKey . Edwards25519.pointEncode
349    publicPoint _ = Edwards25519.pointDecode
350    encodeScalarLE _ = Edwards25519.scalarEncode
351    decodeScalarLE _ = Edwards25519.scalarDecodeLong
352
353    scheduleSecret prx alg priv =
354        (decodeScalarNoErr prx clamped, B.dropView hashed 32)
355      where
356        hashed  = digest alg $ \update -> update priv
357
358        clamped :: Bytes
359        clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do
360                      b0  <- peekElemOff p 0  :: IO Word8
361                      b31 <- peekElemOff p 31 :: IO Word8
362                      pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40)
363                      pokeElemOff p 0  (b0 .&. 0xF8)
364
365
366{-
367  Optimize hashing by limiting the number of roundtrips between Haskell and C.
368  Hash "update" functions do not use unsafe FFI call, so better concanetate
369  small fragments together and call the update function once.
370
371  Using the IO hash interface avoids context buffer copies.
372
373  Data type Digest is not used directly but converted to Bytes early. Any use of
374  withByteArray on the unpinned Digest backend would require copy through a
375  pinned trampoline.
376-}
377
378digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg)
379             => alg -> Builder -> msg -> Bytes
380digestDomMsg alg bss bs = digest alg $ \update ->
381    update (buildAndFreeze bss :: Bytes) >> update bs
382
383digest :: HashAlgorithm alg
384       => alg
385       -> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ())
386       -> Bytes
387digest alg fn = B.convert $ unsafeDoIO $ do
388    mc <- hashMutableInitWith alg
389    fn (hashMutableUpdate mc)
390    hashMutableFinalize mc
391