From 92957a792a87dbc4d2b8120aaf57bf983c4796e2 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 21 Sep 2018 18:13:12 -0400 Subject: XEd25519 signature algorithm. --- src/Crypto/Nonce.hs | 49 ++++++++++ src/Crypto/XEd25519.hs | 185 ++++++++++++++++++++++++++++++++++++ src/Crypto/XEd25519/FieldElement.hs | 49 ++++++++++ src/Data/Sized.hs | 14 +++ 4 files changed, 297 insertions(+) create mode 100644 src/Crypto/Nonce.hs create mode 100644 src/Crypto/XEd25519.hs create mode 100644 src/Crypto/XEd25519/FieldElement.hs create mode 100644 src/Data/Sized.hs diff --git a/src/Crypto/Nonce.hs b/src/Crypto/Nonce.hs new file mode 100644 index 00000000..263f9b0a --- /dev/null +++ b/src/Crypto/Nonce.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Crypto.Nonce + ( Nonce32 + , generateNonce32 + , zeros32 + ) where + +import Crypto.Random +import Data.ByteArray as BA +import Data.ByteString as B +import qualified Data.ByteString.Base64 as Base64 +import Data.ByteString.Char8 as B8 +import Data.Data +import Data.Serialize +import Data.Sized + +newtype Nonce32 = Nonce32 ByteString + deriving (Eq, Ord, ByteArrayAccess, Data) + +bin2base64 :: ByteArrayAccess bs => bs -> String +bin2base64 = B8.unpack . Base64.encode . BA.convert + +instance Show Nonce32 where + showsPrec d nonce = mappend $ bin2base64 nonce + +instance Read Nonce32 where + readsPrec _ str = either (const []) id $ do + let (ds,ss) = Prelude.splitAt 43 str + ss' <- case ss of + '=':xs -> Right xs -- optional terminating '=' + _ -> Right ss + bs <- Base64.decode (B8.pack $ ds ++ ['=']) + if B.length bs == 32 + then Right [ (Nonce32 bs, ss') ] + else Left "Truncated Nonce32 (expected 43 base64 digits)." + +instance Serialize Nonce32 where + get = Nonce32 <$> getBytes 32 + put (Nonce32 bs) = putByteString bs + +instance Sized Nonce32 where size = ConstSize 32 + + +zeros32 :: Nonce32 +zeros32 = Nonce32 $ BA.replicate 32 0 + +generateNonce32 :: MonadRandom m => m Nonce32 +generateNonce32 = Nonce32 <$> getRandomBytes 32 diff --git a/src/Crypto/XEd25519.hs b/src/Crypto/XEd25519.hs new file mode 100644 index 00000000..372f31a8 --- /dev/null +++ b/src/Crypto/XEd25519.hs @@ -0,0 +1,185 @@ +module Crypto.XEd25519 where + +import Control.Arrow +import Data.Bits +import Data.ByteArray as BA +import Data.Memory.PtrMethods (memCopy) +import Crypto.Hash +import Crypto.ECC.Edwards25519 +import Crypto.Error +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Foreign.Marshal +import Foreign.Ptr +import Foreign.Storable +import qualified Crypto.PubKey.Curve25519 as X25519 + +import Crypto.XEd25519.FieldElement +import Crypto.Nonce + + +data SecretKey = SecretKey { secretScalar :: Scalar } + +data PublicKey = PublicKey Ed25519.PublicKey + deriving Eq + +type Nonce = Nonce32 + +newtype EncodedPoint = EncodedPoint Point + +instance ByteArrayAccess SecretKey where + length _ = 32 + withByteArray (SecretKey scalar) = withByteArray (scalarEncode scalar :: Bytes) + +instance ByteArrayAccess PublicKey where + length _ = 32 + withByteArray (PublicKey edpub) = withByteArray edpub + +instance ByteArrayAccess EncodedPoint where + length _ = 32 + withByteArray (EncodedPoint pt) f = + withByteArray (pointEncode pt :: Bytes) f + + +data Signature = Signature EncodedPoint Scalar + +instance ByteArrayAccess Signature where + length _ = 64 + withByteArray (Signature pt scalar) f = + withByteArray pt $ \ptptr -> do + withByteArray (SecretKey scalar) $ \scalarptr -> do + allocaBytes 64 $ \ptr -> do + memCopy ptr ptptr 32 + memCopy (ptr `plusPtr` 32) scalarptr 32 + f (castPtr ptr) + + +padding :: Bytes +padding = 0xFE `BA.cons` BA.replicate 31 0xFF + +sign :: ByteArrayAccess dta => dta -> Nonce -> SecretKey -> PublicKey -> Signature +sign dta nonce sec pub = Signature rB s + where + rB = ge_p3_tobytes $ ge_scalarmult_base r + + r = sc_reduce $ hashFinalize $ (`hashUpdate` padding) + >>> (`hashUpdate` sec) + >>> (`hashUpdate` dta) + >>> (`hashUpdate` nonce) $ hashInit + + h = sc_reduce $ hashFinalize $ (`hashUpdate` rB) + >>> (`hashUpdate` pub) + >>> (`hashUpdate` dta) $ hashInit + + -- s = r + ha (mod q) + s = sc_muladd h (secretScalar sec) r + + + +ge_p3_tobytes :: Point -> EncodedPoint +ge_p3_tobytes = EncodedPoint + +ge_scalarmult_base :: Scalar -> Point +ge_scalarmult_base = toPoint + +sc_muladd :: Scalar -> Scalar -> Scalar -> Scalar +sc_muladd a b c = scalarAdd (scalarMul a b) c + +sc_reduce :: Digest SHA512 -> Scalar +sc_reduce digest = x where CryptoPassed x = scalarDecodeLong digest -- ??? + +-- Scalar is internally, at least on 64bit machines, represented as 5 +-- 56-bit words in little-endian order, each encoded as a Word64. +sc_neg :: Scalar -> Scalar +sc_neg = scalarMul sc_neg1 + +verify :: ByteArrayAccess dta => PublicKey -> dta -> Signature -> Bool +verify pub dta signature = Ed25519.verify ed_pub dta ed_sig + where + CryptoPassed ed_pub = Ed25519.publicKey pub' + CryptoPassed ed_sig = Ed25519.signature signature' + + -- Get the sign bit from the s part of the signature. + sign_bit = BA.index signature 63 .&. 0x80 + + -- Set the sign bit to zero in the s part of the signature. + signature' :: Bytes + signature' = BA.copyAndFreeze signature $ \ptr -> do + let at63 = plusPtr ptr 63 + byte63 <- peek at63 + poke at63 $ byte63 .&. (0x7F `asTypeOf` sign_bit) + + -- Restore the sign bit on the verification key, which should have 0 as its + -- current sign bit. + pub' :: Bytes + pub' = BA.copyAndFreeze pub $ \ptr -> do + let at31 = plusPtr ptr 31 + byte31 <- peek at31 + poke at31 $ (byte31 .&. 0x7F) .|. sign_bit + + +-- typedef crypto_int32 fe[10]; +-- +-- fe means field element. Here the field is \Z/(2^255-19). +-- An element t, entries t[0]...t[9], represents the integer +-- t[0]+2^26 t[1]+2^51 t[2]+2^77 t[3]+2^102 t[4]+...+2^230 t[9]. +-- Bounds on each t[i] vary depending on context. + +-- mont_pub_to_ed_pub +toSigningKey :: X25519.PublicKey -> PublicKey +toSigningKey mont_pub0 = PublicKey ed_pub + where + -- Read the public key as a field element + mont_pub = fe_frombytes mont_pub0 + + -- Convert the Montgomery public key to a twisted Edwards public key + fe_ONE = fe_1 + + -- Calculate the parameters (u - 1) and (u + 1) + mont_pub_minus_one = fe_sub mont_pub fe_ONE + mont_pub_plus_one0 = fe_add mont_pub fe_ONE + + -- Prepare inv(u + 1) + mont_pub_plus_one = fe_invert mont_pub_plus_one0 + + -- Calculate y = (u - 1) * inv(u + 1) (mod p) + ed_pub0 = fe_mul mont_pub_minus_one mont_pub_plus_one + ed_pub = fe_tobytes ed_pub0 + +-- mont_priv_to_ed_pair +toSigningKeyPair :: X25519.SecretKey -> (SecretKey,PublicKey) +toSigningKeyPair mont_priv0 = (SecretKey ed_priv, PublicKey ed_pub) + where + -- Prepare a buffer for the twisted Edwards private key + ed_priv1 = (throwCryptoError . scalarDecodeLong :: X25519.SecretKey -> Scalar) mont_priv0 + + -- Get the twisted edwards public key, including the sign bit + ed_pub0 = ge_p3_tobytes $ ge_scalarmult_base ed_priv1 + + -- Save the sign bit for later + sign_bit = (BA.index ed_pub0 31 `shiftR` 7) .&. 1 + + -- Force the sign bit to zero + pub' :: Bytes + pub' = BA.copyAndFreeze ed_pub0 $ \ptr -> do + let at31 = plusPtr ptr 31 + byte31 <- peek at31 + poke at31 $ (byte31 .&. 0x7F) `asTypeOf` sign_bit + + CryptoPassed ed_pub = Ed25519.publicKey pub' + + + -- Prepare the negated private key + ed_priv_neg = sc_neg ed_priv1 + + -- Get the correct private key based on the sign stored above + ed_priv = if sign_bit/=0 then ed_priv_neg + else ed_priv1 + +-- sc_zero = throwCryptoError $ scalarDecodeLong (b::Bytes) +-- where +-- b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648493 + +sc_neg1 :: Scalar +sc_neg1 = throwCryptoError $ scalarDecodeLong (b::Bytes) + where + b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648492 diff --git a/src/Crypto/XEd25519/FieldElement.hs b/src/Crypto/XEd25519/FieldElement.hs new file mode 100644 index 00000000..7a916107 --- /dev/null +++ b/src/Crypto/XEd25519/FieldElement.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module Crypto.XEd25519.FieldElement where + +import Crypto.Error +import qualified Crypto.PubKey.Curve25519 as X25519 +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Data.ByteArray as BA (pack,unpack,Bytes) +import Data.Modular +import Data.Word + +-- 2^255 - 19 +type P25519 = 57896044618658097711785492504343953926634992332820282019728792003956564819949 + +newtype FieldElement = FE (ℤ / P25519) + + +fe_frombytes :: X25519.PublicKey -> FieldElement +fe_frombytes pub = FE $ toMod $ decodeLittleEndian $ BA.unpack pub + +fe_tobytes :: FieldElement -> Ed25519.PublicKey +fe_tobytes (FE x) = throwCryptoError $ Ed25519.publicKey (b :: Bytes) + where + b = BA.pack $ take 32 $ (encodeLittleEndian $ unMod x) ++ repeat 0 + +fe_1 :: FieldElement +fe_1 = FE $ toMod 1 + +fe_sub :: FieldElement -> FieldElement -> FieldElement +fe_sub (FE x) (FE y) = FE $ x - y + +fe_add :: FieldElement -> FieldElement -> FieldElement +fe_add (FE x) (FE y) = FE $ x + y + +fe_invert :: FieldElement -> FieldElement +fe_invert (FE x) = FE $ inv x + +fe_mul :: FieldElement -> FieldElement -> FieldElement +fe_mul (FE x) (FE y) = FE (x * y) + +decodeLittleEndian :: [Word8] -> Integer +decodeLittleEndian [] = 0 +decodeLittleEndian (x:xs) = fromIntegral x + 256 * decodeLittleEndian xs + +encodeLittleEndian :: Integer -> [Word8] +encodeLittleEndian 0 = [] +encodeLittleEndian x = let (bs,b) = divMod x 256 + in fromIntegral b : encodeLittleEndian bs + diff --git a/src/Data/Sized.hs b/src/Data/Sized.hs new file mode 100644 index 00000000..0d3d5845 --- /dev/null +++ b/src/Data/Sized.hs @@ -0,0 +1,14 @@ +module Data.Sized where + +import Data.Typeable + + +-- | Info about a type's serialized length. Either the length is known +-- independently of the value, or the length depends on the value. +data Size a + = VarSize (a -> Int) + | ConstSize !Int + deriving Typeable + +class Sized a where size :: Size a + -- cgit v1.2.3