vYBjZT55

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module Ed25519 where
3
4import           Control.DeepSeq
5
6import           Data.Bits
7import           Data.ByteArray (ByteArrayAccess, Bytes, ScrubbedBytes, View)
8import qualified Data.ByteArray as B
9import           Data.Word
10
11import           Foreign.Storable
12
13import           Crypto.ECC.Edwards25519
14import           Crypto.Error
15import           Crypto.Hash
16import           Crypto.Random
17
18
19-- | An Ed25519 Secret key
20newtype SecretKey = SecretKey ScrubbedBytes
21    deriving (Show,Eq,ByteArrayAccess,NFData)
22
23-- | An Ed25519 public key
24newtype PublicKey = PublicKey Bytes
25    deriving (Show,Eq,ByteArrayAccess,NFData)
26
27-- | An Ed25519 signature
28newtype Signature = Signature Bytes
29    deriving (Show,Eq,ByteArrayAccess,NFData)
30
31-- | Size of public keys
32publicKeySize :: Int
33publicKeySize = 32
34
35-- | Size of secret keys
36secretKeySize :: Int
37secretKeySize = 32
38
39-- | Size of signatures
40signatureSize :: Int
41signatureSize = 64
42
43
44-- Constructors
45
46-- | Try to build a public key from a bytearray
47publicKey :: ByteArrayAccess ba
48          => ba -> CryptoFailable PublicKey
49publicKey bs
50    | B.length bs == publicKeySize =
51        CryptoPassed (PublicKey $ B.convert bs)
52    | otherwise =
53        CryptoFailed CryptoError_PublicKeySizeInvalid
54
55-- | Try to build a secret key from a bytearray
56secretKey :: ByteArrayAccess ba
57          => ba -> CryptoFailable SecretKey
58secretKey bs
59    | B.length bs == secretKeySize =
60        CryptoPassed (SecretKey $ B.convert bs)
61    | otherwise                        =
62        CryptoFailed CryptoError_SecretKeyStructureInvalid
63
64-- | Try to build a signature from a bytearray
65signature :: ByteArrayAccess ba
66          => ba -> CryptoFailable Signature
67signature bs
68    | B.length bs == signatureSize =
69        CryptoPassed (Signature $ B.convert bs)
70    | otherwise =
71        CryptoFailed CryptoError_SecretKeyStructureInvalid
72
73
74-- Conversions
75
76-- | Generate a secret key
77generateSecretKey :: MonadRandom m => m SecretKey
78generateSecretKey = SecretKey <$> getRandomBytes secretKeySize
79
80-- | Create a public key from a secret key
81toPublic :: SecretKey -> PublicKey
82toPublic priv = pointPublic (toPoint $ secretScalar priv)
83
84-- | Create a scalar from an Ed25519 secret key
85secretScalar :: SecretKey -> Scalar
86secretScalar priv = fst (scheduleSecret priv)
87
88
89-- Ed25519 signature generation & verification
90
91-- | Sign a message using the key pair
92sign :: ByteArrayAccess msg => SecretKey -> PublicKey -> msg -> Signature
93sign priv pub msg =
94    let (s, prefix) = scheduleSecret priv
95        digR = hashFinalize $ hashUpdate (hashUpdate hashInitWithDom prefix) msg
96        r    = decodeScalarNoErr digR
97        pR   = toPoint r
98        sK   = getK pub pR msg
99        sS   = scalarAdd r (scalarMul sK s)
100     in encodeSignature (pR, sS)
101
102-- | Verify a message
103verify :: ByteArrayAccess msg => PublicKey -> msg -> Signature -> Bool
104verify pub msg sig =
105    case doVerify of
106        CryptoPassed verified -> verified
107        CryptoFailed _        -> False
108  where
109    doVerify = do
110        (pR, sS) <- decodeSignature sig
111        nPub <- pointNegate `fmap` publicPoint pub
112        let sK  = getK pub pR msg
113            pR' = pointsMulVarTime sS sK nPub
114        return (pR == pR')
115
116getK :: ByteArrayAccess msg => PublicKey -> Point -> msg -> Scalar
117getK pub pR msg =
118    let bsR  = pointEncode pR :: Bytes
119        digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate hashInitWithDom bsR) pub) msg
120     in decodeScalarNoErr digK
121
122encodeSignature :: (Point, Scalar) -> Signature
123encodeSignature (pR, sS) =
124    let bsS  = scalarEncode sS :: Bytes
125        len0 = signatureSize - publicKeySize - B.length bsS
126     in Signature $ B.concat [ pointEncode pR, bsS, B.zero len0 ]
127
128decodeSignature :: Signature -> CryptoFailable (Point, Scalar)
129decodeSignature (Signature bs) = do
130    let (bsR, bsS) = B.splitAt publicKeySize bs
131    pR <- pointDecode bsR
132    sS <- scalarDecodeLong bsS
133    return (pR, sS)
134
135-- implementation is supposed to decode any scalar up to the size of the digest
136decodeScalarNoErr :: ByteArrayAccess bs => bs -> Scalar
137decodeScalarNoErr = throwCryptoError . scalarDecodeLong
138
139type HashAlg = SHA512
140
141-- prepare hash context with specified parameters
142hashInitWithDom :: Context HashAlg
143hashInitWithDom = hashInitWith SHA512
144
145pointPublic :: Point -> PublicKey
146pointPublic = PublicKey . pointEncode
147
148publicPoint :: PublicKey -> CryptoFailable Point
149publicPoint = pointDecode
150
151-- how to use bits in a secret key
152scheduleSecret :: SecretKey -> (Scalar, View (Digest HashAlg))
153scheduleSecret priv = (decodeScalarNoErr clamped, B.dropView hashed 32)
154  where
155    hashed  = hashWith SHA512 priv
156
157    clamped :: Bytes
158    clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do
159                  b0  <- peekElemOff p 0  :: IO Word8
160                  b31 <- peekElemOff p 31 :: IO Word8
161                  pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40)
162                  pokeElemOff p 0  (b0 .&. 0xF8)