314 lines
11 KiB
Haskell
314 lines
11 KiB
Haskell
-- |
|
|
-- Module : Crypto.ECC.Ed25519
|
|
-- License : BSD-style
|
|
-- Maintainer : Olivier Chéron <olivier.cheron@gmail.com>
|
|
-- Stability : experimental
|
|
-- Portability : unknown
|
|
--
|
|
-- Ed25519 arithmetic primitives.
|
|
--
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
module Crypto.ECC.Ed25519
|
|
( Scalar
|
|
, Point
|
|
-- * Scalars
|
|
, scalarGenerate
|
|
, scalarDecodeLong
|
|
, scalarEncode
|
|
-- * Points
|
|
, pointDecode
|
|
, pointEncode
|
|
-- * Arithmetic functions
|
|
, toPoint
|
|
, scalarAdd
|
|
, scalarMul
|
|
, pointNegate
|
|
, pointAdd
|
|
, pointDouble
|
|
, pointMul
|
|
, pointMulW
|
|
, pointsMulVarTime
|
|
) where
|
|
|
|
import Data.Bits
|
|
import Data.Word
|
|
import Foreign.C.Types
|
|
import Foreign.Ptr
|
|
import Foreign.Storable
|
|
|
|
import Crypto.Error
|
|
import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes,
|
|
ScrubbedBytes, withByteArray)
|
|
import qualified Crypto.Internal.ByteArray as B
|
|
import Crypto.Internal.Compat
|
|
import Crypto.Internal.Imports
|
|
import Crypto.Random
|
|
|
|
|
|
scalarArraySize :: Int
|
|
scalarArraySize = 40 -- maximum [9 * 4 {- 32 bits -}, 5 * 8 {- 64 bits -}]
|
|
|
|
-- | A scalar modulo order of curve Ed25519.
|
|
newtype Scalar = Scalar ScrubbedBytes
|
|
deriving (Show,NFData)
|
|
|
|
instance Eq Scalar where
|
|
(Scalar s1) == (Scalar s2) = unsafeDoIO $
|
|
withByteArray s1 $ \ps1 ->
|
|
withByteArray s2 $ \ps2 ->
|
|
fmap (/= 0) (ed25519_scalar_eq ps1 ps2)
|
|
{-# NOINLINE (==) #-}
|
|
|
|
pointArraySize :: Int
|
|
pointArraySize = 160 -- maximum [4 * 10 * 4 {- 32 bits -}, 4 * 5 * 8 {- 64 bits -}]
|
|
|
|
-- | A point on curve Ed25519.
|
|
newtype Point = Point Bytes
|
|
deriving NFData
|
|
|
|
instance Show Point where
|
|
showsPrec d p =
|
|
let bs = pointEncode p :: Bytes
|
|
in showParen (d > 10) $ showString "Point "
|
|
. shows (B.convertToBase B.Base16 bs :: Bytes)
|
|
|
|
instance Eq Point where
|
|
(Point p1) == (Point p2) = unsafeDoIO $
|
|
withByteArray p1 $ \pp1 ->
|
|
withByteArray p2 $ \pp2 ->
|
|
fmap (/= 0) (ed25519_point_eq pp1 pp2)
|
|
{-# NOINLINE (==) #-}
|
|
|
|
-- | Generate a random scalar.
|
|
scalarGenerate :: MonadRandom randomly => randomly Scalar
|
|
scalarGenerate = unwrap . scalarDecodeLong . clamp <$> generate
|
|
where
|
|
unwrap (CryptoPassed x) = x
|
|
unwrap (CryptoFailed _) = error "scalarGenerate: assumption failed"
|
|
|
|
generate :: MonadRandom randomly => randomly ScrubbedBytes
|
|
generate = getRandomBytes 32
|
|
|
|
-- Uses the same bit mask than during key-generation procedure,
|
|
-- but without making divisible by 8. As a consequence of modular
|
|
-- reduction, distribution is not uniform. But the curve order is
|
|
-- very close to 2^252 so only a tiny fraction of the scalars have
|
|
-- lower probability, roughly 1/(2^126) of all possible values.
|
|
clamp :: ByteArrayAccess ba => ba -> ScrubbedBytes
|
|
clamp bs = B.copyAndFreeze bs $ \p -> do
|
|
b31 <- peekElemOff p 31 :: IO Word8
|
|
pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40)
|
|
|
|
-- | Serialize a scalar to binary, i.e. a 32-byte little-endian
|
|
-- number.
|
|
--
|
|
-- Format is binary compatible with 'Crypto.PubKey.Curve25519.SecretKey'
|
|
-- from module "Crypto.PubKey.Curve25519".
|
|
scalarEncode :: B.ByteArray bs => Scalar -> bs
|
|
scalarEncode (Scalar s) =
|
|
B.allocAndFreeze 32 $ \out ->
|
|
withByteArray s $ \ps -> ed25519_scalar_encode out ps
|
|
|
|
-- | Deserialize a little-endian number as a scalar. Input array can
|
|
-- have any length from 0 to 64 bytes.
|
|
scalarDecodeLong :: B.ByteArrayAccess bs => bs -> CryptoFailable Scalar
|
|
scalarDecodeLong bs
|
|
| B.length bs > 64 = CryptoFailed CryptoError_EcScalarOutOfBounds
|
|
| otherwise = unsafeDoIO $ withByteArray bs initialize
|
|
where
|
|
len = fromIntegral $ B.length bs
|
|
initialize inp = do
|
|
s <- B.alloc scalarArraySize $ \ps ->
|
|
ed25519_scalar_decode_long ps inp len
|
|
return $ CryptoPassed (Scalar s)
|
|
{-# NOINLINE scalarDecodeLong #-}
|
|
|
|
-- | Add two scalars.
|
|
scalarAdd :: Scalar -> Scalar -> Scalar
|
|
scalarAdd (Scalar a) (Scalar b) =
|
|
Scalar $ B.allocAndFreeze scalarArraySize $ \out ->
|
|
withByteArray a $ \pa ->
|
|
withByteArray b $ \pb ->
|
|
ed25519_scalar_add out pa pb
|
|
|
|
-- | Multiply two scalars.
|
|
scalarMul :: Scalar -> Scalar -> Scalar
|
|
scalarMul (Scalar a) (Scalar b) =
|
|
Scalar $ B.allocAndFreeze scalarArraySize $ \out ->
|
|
withByteArray a $ \pa ->
|
|
withByteArray b $ \pb ->
|
|
ed25519_scalar_mul out pa pb
|
|
|
|
-- | Multiplies a scalar with the curve base point.
|
|
toPoint :: Scalar -> Point
|
|
toPoint (Scalar scalar) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray scalar $ \pscalar ->
|
|
ed25519_point_base_scalarmul out pscalar
|
|
|
|
-- | Serialize a point to a 32-byte array.
|
|
--
|
|
-- Format is binary compatible with 'Crypto.PubKey.Ed25519.PublicKey'
|
|
-- from module "Crypto.PubKey.Ed25519".
|
|
pointEncode :: B.ByteArray bs => Point -> bs
|
|
pointEncode (Point p) =
|
|
B.allocAndFreeze 32 $ \out ->
|
|
withByteArray p $ \pp ->
|
|
ed25519_point_encode out pp
|
|
|
|
-- | Deserialize a 32-byte array as a point, ensuring the point is
|
|
-- valid on Ed25519.
|
|
--
|
|
-- /WARNING:/ variable time
|
|
pointDecode :: B.ByteArrayAccess bs => bs -> CryptoFailable Point
|
|
pointDecode bs
|
|
| B.length bs == 32 = unsafeDoIO $ withByteArray bs initialize
|
|
| otherwise = CryptoFailed CryptoError_PointSizeInvalid
|
|
where
|
|
initialize inp = do
|
|
(res, p) <- B.allocRet pointArraySize $ \pp ->
|
|
ed25519_point_decode_vartime pp inp
|
|
if res == 0 then return $ CryptoFailed CryptoError_PointCoordinatesInvalid
|
|
else return $ CryptoPassed (Point p)
|
|
{-# NOINLINE pointDecode #-}
|
|
|
|
-- | Negate a point.
|
|
pointNegate :: Point -> Point
|
|
pointNegate (Point a) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray a $ \pa ->
|
|
ed25519_point_negate out pa
|
|
|
|
-- | Add two points.
|
|
pointAdd :: Point -> Point -> Point
|
|
pointAdd (Point a) (Point b) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray a $ \pa ->
|
|
withByteArray b $ \pb ->
|
|
ed25519_point_add out pa pb
|
|
|
|
-- | Add a point to itself.
|
|
--
|
|
-- @
|
|
-- pointDouble p = 'pointAdd' p p
|
|
-- @
|
|
pointDouble :: Point -> Point
|
|
pointDouble (Point a) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray a $ \pa ->
|
|
ed25519_point_double out pa
|
|
|
|
-- | Scalar multiplication over Ed25519 (double-add always).
|
|
pointMul :: Scalar -> Point -> Point
|
|
pointMul (Scalar scalar) (Point base) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray scalar $ \pscalar ->
|
|
withByteArray base $ \pbase ->
|
|
ed25519_point_scalarmul out pbase pscalar
|
|
|
|
-- | Scalar multiplication over Ed25519 (4-bit fixed window).
|
|
pointMulW :: Scalar -> Point -> Point
|
|
pointMulW (Scalar scalar) (Point base) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray scalar $ \pscalar ->
|
|
withByteArray base $ \pbase ->
|
|
ed25519_point_scalarmul_w out pbase pscalar
|
|
|
|
-- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@.
|
|
--
|
|
-- @
|
|
-- pointsMulVarTime s1 s2 p = 'pointAdd' ('toPoint' s1) ('pointMul' s2 p)
|
|
-- @
|
|
--
|
|
-- /WARNING:/ variable time
|
|
pointsMulVarTime :: Scalar -> Scalar -> Point -> Point
|
|
pointsMulVarTime (Scalar s1) (Scalar s2) (Point p) =
|
|
Point $ B.allocAndFreeze pointArraySize $ \out ->
|
|
withByteArray s1 $ \ps1 ->
|
|
withByteArray s2 $ \ps2 ->
|
|
withByteArray p $ \pp ->
|
|
ed25519_base_double_scalarmul_vartime out ps1 pp ps2
|
|
|
|
foreign import ccall "cryptonite_ed25519_scalar_eq"
|
|
ed25519_scalar_eq :: Ptr Scalar
|
|
-> Ptr Scalar
|
|
-> IO CInt
|
|
|
|
foreign import ccall "cryptonite_ed25519_scalar_encode"
|
|
ed25519_scalar_encode :: Ptr Word8
|
|
-> Ptr Scalar
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_scalar_decode_long"
|
|
ed25519_scalar_decode_long :: Ptr Scalar
|
|
-> Ptr Word8
|
|
-> CSize
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_scalar_add"
|
|
ed25519_scalar_add :: Ptr Scalar -- sum
|
|
-> Ptr Scalar -- a
|
|
-> Ptr Scalar -- b
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_scalar_mul"
|
|
ed25519_scalar_mul :: Ptr Scalar -- out
|
|
-> Ptr Scalar -- a
|
|
-> Ptr Scalar -- b
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_encode"
|
|
ed25519_point_encode :: Ptr Word8
|
|
-> Ptr Point
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_decode_vartime"
|
|
ed25519_point_decode_vartime :: Ptr Point
|
|
-> Ptr Word8
|
|
-> IO CInt
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_eq"
|
|
ed25519_point_eq :: Ptr Point
|
|
-> Ptr Point
|
|
-> IO CInt
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_negate"
|
|
ed25519_point_negate :: Ptr Point -- minus_a
|
|
-> Ptr Point -- a
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_add"
|
|
ed25519_point_add :: Ptr Point -- sum
|
|
-> Ptr Point -- a
|
|
-> Ptr Point -- b
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_double"
|
|
ed25519_point_double :: Ptr Point -- two_a
|
|
-> Ptr Point -- a
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_base_scalarmul"
|
|
ed25519_point_base_scalarmul :: Ptr Point -- scaled
|
|
-> Ptr Scalar -- scalar
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_scalarmul"
|
|
ed25519_point_scalarmul :: Ptr Point -- scaled
|
|
-> Ptr Point -- base
|
|
-> Ptr Scalar -- scalar
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_point_scalarmul_w"
|
|
ed25519_point_scalarmul_w :: Ptr Point -- scaled
|
|
-> Ptr Point -- base
|
|
-> Ptr Scalar -- scalar
|
|
-> IO ()
|
|
|
|
foreign import ccall "cryptonite_ed25519_base_double_scalarmul_vartime"
|
|
ed25519_base_double_scalarmul_vartime :: Ptr Point -- combo
|
|
-> Ptr Scalar -- scalar1
|
|
-> Ptr Point -- base2
|
|
-> Ptr Scalar -- scalar2
|
|
-> IO ()
|