ed25519.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Ed25519 where

import           Control.DeepSeq

import           Data.Bits
import           Data.ByteArray (ByteArrayAccess, Bytes, ScrubbedBytes, View)
import qualified Data.ByteArray as B
import           Data.Word

import           Foreign.Storable

import           Crypto.ECC.Edwards25519
import           Crypto.Error
import           Crypto.Hash
import           Crypto.Random


-- | An Ed25519 Secret key
newtype SecretKey = SecretKey ScrubbedBytes
    deriving (Show,Eq,ByteArrayAccess,NFData)

-- | An Ed25519 public key
newtype PublicKey = PublicKey Bytes
    deriving (Show,Eq,ByteArrayAccess,NFData)

-- | An Ed25519 signature
newtype Signature = Signature Bytes
    deriving (Show,Eq,ByteArrayAccess,NFData)

-- | Size of public keys
publicKeySize :: Int
publicKeySize = 32

-- | Size of secret keys
secretKeySize :: Int
secretKeySize = 32

-- | Size of signatures
signatureSize :: Int
signatureSize = 64


-- Constructors

-- | Try to build a public key from a bytearray
publicKey :: ByteArrayAccess ba
          => ba -> CryptoFailable PublicKey
publicKey bs
    | B.length bs == publicKeySize =
        CryptoPassed (PublicKey $ B.convert bs)
    | otherwise =
        CryptoFailed CryptoError_PublicKeySizeInvalid

-- | Try to build a secret key from a bytearray
secretKey :: ByteArrayAccess ba
          => ba -> CryptoFailable SecretKey
secretKey bs
    | B.length bs == secretKeySize =
        CryptoPassed (SecretKey $ B.convert bs)
    | otherwise                        =
        CryptoFailed CryptoError_SecretKeyStructureInvalid

-- | Try to build a signature from a bytearray
signature :: ByteArrayAccess ba
          => ba -> CryptoFailable Signature
signature bs
    | B.length bs == signatureSize =
        CryptoPassed (Signature $ B.convert bs)
    | otherwise =
        CryptoFailed CryptoError_SecretKeyStructureInvalid


-- Conversions

-- | Generate a secret key
generateSecretKey :: MonadRandom m => m SecretKey
generateSecretKey = SecretKey <$> getRandomBytes secretKeySize

-- | Create a public key from a secret key
toPublic :: SecretKey -> PublicKey
toPublic priv = pointPublic (toPoint $ secretScalar priv)

-- | Create a scalar from an Ed25519 secret key
secretScalar :: SecretKey -> Scalar
secretScalar priv = fst (scheduleSecret priv)


-- Ed25519 signature generation & verification

-- | Sign a message using the key pair
sign :: ByteArrayAccess msg => SecretKey -> PublicKey -> msg -> Signature
sign priv pub msg =
    let (s, prefix) = scheduleSecret priv
        digR = hashFinalize $ hashUpdate (hashUpdate hashInitWithDom prefix) msg
        r    = decodeScalarNoErr digR
        pR   = toPoint r
        sK   = getK pub pR msg
        sS   = scalarAdd r (scalarMul sK s)
     in encodeSignature (pR, sS)

-- | Verify a message
verify :: ByteArrayAccess msg => PublicKey -> msg -> Signature -> Bool
verify pub msg sig =
    case doVerify of
        CryptoPassed verified -> verified
        CryptoFailed _        -> False
  where
    doVerify = do
        (pR, sS) <- decodeSignature sig
        nPub <- pointNegate `fmap` publicPoint pub
        let sK  = getK pub pR msg
            pR' = pointsMulVarTime sS sK nPub
        return (pR == pR')

getK :: ByteArrayAccess msg => PublicKey -> Point -> msg -> Scalar
getK pub pR msg =
    let bsR  = pointEncode pR :: Bytes
        digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate hashInitWithDom bsR) pub) msg
     in decodeScalarNoErr digK

encodeSignature :: (Point, Scalar) -> Signature
encodeSignature (pR, sS) =
    let bsS  = scalarEncode sS :: Bytes
        len0 = signatureSize - publicKeySize - B.length bsS
     in Signature $ B.concat [ pointEncode pR, bsS, B.zero len0 ]

decodeSignature :: Signature -> CryptoFailable (Point, Scalar)
decodeSignature (Signature bs) = do
    let (bsR, bsS) = B.splitAt publicKeySize bs
    pR <- pointDecode bsR
    sS <- scalarDecodeLong bsS
    return (pR, sS)

-- implementation is supposed to decode any scalar up to the size of the digest
decodeScalarNoErr :: ByteArrayAccess bs => bs -> Scalar
decodeScalarNoErr = throwCryptoError . scalarDecodeLong

type HashAlg = SHA512

-- prepare hash context with specified parameters
hashInitWithDom :: Context HashAlg
hashInitWithDom = hashInitWith SHA512

pointPublic :: Point -> PublicKey
pointPublic = PublicKey . pointEncode

publicPoint :: PublicKey -> CryptoFailable Point
publicPoint = pointDecode

-- how to use bits in a secret key
scheduleSecret :: SecretKey -> (Scalar, View (Digest HashAlg))
scheduleSecret priv = (decodeScalarNoErr clamped, B.dropView hashed 32)
  where
    hashed  = hashWith SHA512 priv

    clamped :: Bytes
    clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do
                  b0  <- peekElemOff p 0  :: IO Word8
                  b31 <- peekElemOff p 31 :: IO Word8
                  pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40)
                  pokeElemOff p 0  (b0 .&. 0xF8)