diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -1,4 +1,4 @@ -Copyright (c) 2009, Marcel Fourné +Copyright (c) 20[09..10], Marcel Fourné All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/hecc.cabal b/hecc.cabal --- a/hecc.cabal +++ b/hecc.cabal @@ -1,10 +1,10 @@ Name: hecc -Version: 0.2 +Version: 0.3 Synopsis: Elliptic Curve Cryptography for Haskell Description: Pure math & algorithms for Elliptic Curve Cryptography in Haskell License: BSD3 License-file: COPYING -Copyright: (c) Marcel Fourné, 2009 +Copyright: (c) Marcel Fourné, 2009-2012 Author: Marcel Fourné Maintainer: Marcel Fourné (hecc@bitrot.dyndns.org) Category: Cryptography @@ -14,10 +14,22 @@ Data-Files: README Extra-Source-Files: src/bench.hs src/Examples.hs -hs-source-dirs: src -Build-Depends: base >= 3 && < 5, - MonadRandom, - haskell98 -Exposed-modules: Codec.Encryption.ECC.Base - Codec.Encryption.ECC.StandardCurves -ghc-options: -Wall -O2 +Library + hs-source-dirs: + src + Build-Depends: + base >= 4 && < 5, + random, + bytestring, + binary, + cereal, + crypto-api, + repa, + vector + Exposed-modules: + Codec.Crypto.ECC.Base + Codec.Crypto.ECC.F2 + Codec.Crypto.ECC.StandardCurves + ghc-options: +-- -Wall -fllvm -feager-blackholing -O2 -rtsopts -threaded + -Wall -fllvm -feager-blackholing diff --git a/src/Codec/Crypto/ECC/Base.hs b/src/Codec/Crypto/ECC/Base.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/ECC/Base.hs @@ -0,0 +1,506 @@ +{-# LANGUAGE PatternGuards,TypeOperators,FlexibleInstances,DatatypeContexts #-} +-- | +-- Module : Codec.Crypto.ECC.Base +-- Copyright : (c) Marcel Fourné 20[09..10] +-- License : BSD3 +-- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org) +-- +-- ECC Base algorithms & point formats + +module Codec.Crypto.ECC.Base (ECP(..), + EC(..), + modinv, + pmul, + ison, + binary, +-- generateInteger, + EPa(..), + EPp(..), + EPj(..), + EPmj(..), + p256point, + p384point, + p521point, + ECPF2(..), + ECCNum(..), + ECurve(..), + ECSC(..), + modinvF2K, + pmulF2, + isonF2, + EPaF2(..), + EPpF2(..), + b283point, + k283point) + where + +import Data.Bits +import Numeric +import Data.Char +import Data.List as L (length) +import Crypto.Types +-- import Crypto.Random +import Codec.Crypto.ECC.F2 +import Codec.Crypto.ECC.StandardCurves +import qualified Data.Array.Repa as R + +-- +-- OLD Implementation, only for Integer +-- + +-- |extended euclidean algorithm, recursive variant +eeukl :: (Integral a ) => a -> a -> (a, a, a) +eeukl a 0 = (a,1,0) +eeukl a b = let (d,s,t) = eeukl b (a `mod` b) + in (d,t,s-(div a b)*t) + +-- |computing the modular inverse of @a@ `mod` @m@ +modinv :: (Integral a) => a -- ^the number to invert + -> a -- ^the modulus + -> a -- ^the inverted value +modinv a m = let (x,y,_) = eeukl a m + in if x == 1 + then mod y m + else undefined + + + +-- |class of all Elliptic Curves, has the form y^2=x^3+A*x+B mod P, the parameters being A, B and P +data EC = EC (Integer, Integer, Integer) + deriving (Eq) +instance Show EC where show (EC (a,b,p)) = "y^2=x^3+" ++ show a ++ "*x+" ++ show b ++ " mod " ++ show p + +-- |class of all Elliptic Curve Points +class ECP a where + -- |function returning the appropriate INF in the specific ECP-Format, for generic higher-level-algorithms + inf :: a + -- |build point from one in affine coordinates + fromAffineCoords :: EPa -> a + -- |get bitlength + getBitLength :: a -> Int + -- |get contents of the curve + getCurve :: a -> EC + -- |generic getter, returning the affine x-value + getx :: a -> Integer + -- |generic getters, returning the affine y-value + gety :: a -> Integer + -- |add an elliptic point onto itself, base for padd a a + pdouble :: a -> a + -- |add 2 elliptic points + padd :: a -> a -> a + +-- |Elliptic Point Affine coordinates, two parameters x and y +data EPa = EPa (BitLength, EC, Integer, Integer) + | Infa + deriving (Eq) +instance Show EPa where show (EPa (a,b,c,d)) = show (a,b,c,d) + show Infa = "Null" +instance ECP EPa where + inf = Infa + fromAffineCoords = id + getBitLength (EPa (l,_,_,_)) = l + getBitLength (Infa) = undefined + getCurve (EPa (_,c,_,_)) = c + getCurve (Infa) = undefined + getx (EPa (_,_,x,_)) = x + getx Infa = undefined + gety (EPa (_,_,_,y)) = y + gety Infa = undefined + pdouble (EPa (l,c@(EC (alpha,_,p)),x1,y1)) = + let lambda = ((3*x1^(2::Int)+alpha)*(modinv (2*y1) p)) `mod` p + x3 = (lambda^(2::Int) - 2*x1) `mod` p + y3 = (lambda*(x1-x3)-y1) `mod` p + in EPa (l,c,x3,y3) + pdouble Infa = Infa + padd Infa a = a + padd a Infa = a + padd a@(EPa (l,c@(EC (_,_,p)),x1,y1)) b@(EPa (l',c',x2,y2)) + | x1==x2,y1==(-y2) = Infa + | a==b = pdouble a + | otherwise = + let lambda = ((y2-y1)*(modinv (x2-x1) p)) `mod` p + x3 = (lambda^(2::Int) - x1 - x2) `mod` p + y3 = (lambda*(x1-x3)-y1) `mod` p + in if l==l' && c==c' then EPa (l,c,x3,y3) + else undefined + +-- |Elliptic Point Projective coordinates, three parameters x, y and z, like affine (x/z,y/z) +data EPp = EPp (BitLength,EC,Integer, Integer, Integer) + | Infp + deriving (Eq) +instance Show EPp where show (EPp (a,b,c,d,e)) = show (a,b,c,d,e) + show Infp = "Null" +instance ECP EPp where + inf = Infp + fromAffineCoords (EPa (l,curve,a,b)) = EPp (l,curve,a,b,1) + fromAffineCoords Infa = Infp + getBitLength (EPp (l,_,_,_,_)) = l + getBitLength (Infp) = undefined + getCurve (EPp (_,c,_,_,_)) = c + getCurve (Infp) = undefined + getx (EPp (_,(EC (_,_,p)),x,_,z))= (x * (modinv z p)) `mod` p + getx Infp = undefined + gety (EPp (_,(EC (_,_,p)),_,y,z)) = (y * (modinv z p)) `mod` p + gety Infp = undefined + pdouble (EPp (l,curve@(EC (alpha,_,p)),x1,y1,z1)) = + let a = (alpha*z1^(2::Int)+3*x1^(2::Int)) `mod` p + b = (y1*z1) `mod` p + c = (x1*y1*b) `mod` p + d = (a^(2::Int)-8*c) `mod` p + x3 = (2*b*d) `mod` p + y3 = (a*(4*c-d)-8*y1^(2::Int)*b^(2::Int)) `mod` p + z3 = (8*b^(3::Int)) `mod` p + in EPp (l,curve,x3,y3,z3) + pdouble Infp = Infp + padd Infp a = a + padd a Infp = a + padd p1@(EPp (l,curve@(EC (_,_,p)),x1,y1,z1)) p2@(EPp (l',curve',x2,y2,z2)) + | x1==x2,y1==(-y2) = Infp + | p1==p2 = pdouble p1 + | otherwise = + let a = (y2*z1 - y1*z2) `mod` p + b = (x2*z1 - x1*z2) `mod` p + c = (a^(2::Int)*z1*z2 - b^(3::Int) - 2*b^(2::Int)*x1*z2) `mod` p + x3 = (b*c) `mod` p + y3 = (a*(b^(2::Int)*x1*z2-c)-b^(3::Int)*y1*z2) `mod` p + z3 = (b^(3::Int)*z1*z2) `mod` p + in if l==l' && curve==curve' then EPp (l,curve,x3,y3,z3) + else undefined + +-- |Elliptic Point Jacobian coordinates, three parameter x, y and z, like affine (x/z^2,y/z^3) +data EPj = EPj (BitLength,EC,Integer, Integer, Integer) + | Infj + deriving (Eq) +instance Show EPj where show (EPj (a,b,c,d,e)) = show (a,b,c,d,e) + show Infj = "Null" +instance ECP EPj where + inf = Infj + fromAffineCoords (EPa (l,curve,a,b)) = EPj (l,curve,a,b,1) + fromAffineCoords Infa = Infj + getBitLength (EPj (l,_,_,_,_)) = l + getBitLength (Infj) = undefined + getCurve (EPj (_,c,_,_,_)) = c + getCurve (Infj) = undefined + getx (EPj (_,(EC (_,_,p)),x,_,z))= (x * (modinv (z^(2::Int)) p)) `mod` p + getx Infj = undefined + gety (EPj (_,(EC (_,_,p)),_,y,z)) = (y * (modinv (z^(3::Int)) p)) `mod` p + gety Infj = undefined + pdouble (EPj (l,c@(EC (alpha,_,p)),x1,y1,z1)) = + let a = 4*x1*y1^(2::Int) `mod` p + b = (3*x1^(2::Int) + alpha*z1^(4::Int)) `mod` p + x3 = (-2*a + b^(2::Int)) `mod` p + y3 = (-8*y1^(4::Int) + b*(a-x3)) `mod` p + z3 = 2*y1*z1 `mod` p + in EPj (l,c,x3,y3,z3) + pdouble Infj = Infj + padd Infj a = a + padd a Infj = a + padd p1@(EPj (l,curve@(EC (_,_,p)),x1,y1,z1)) p2@(EPj (l',curve',x2,y2,z2)) + | x1==x2,y1==(-y2) = Infj + | p1==p2 = pdouble p1 + | otherwise = + let a = (x1*z2^(2::Int)) `mod` p + b = (x2*z1^(2::Int)) `mod` p + c = (y1*z2^(3::Int)) `mod` p + d = (y2*z1^(3::Int)) `mod` p + e = (b - a) `mod` p + f = (d - c) `mod` p + x3 = (-e^(3::Int) - 2*a*e^(2::Int) + f^(2::Int)) `mod` p + y3 = (-c*e^(3::Int) + f*(a*e^(2::Int) - x3)) `mod` p + z3 = (z1*z2*e) `mod` p + in if l==l' && curve==curve' then EPj (l,curve,x3,y3,z3) + else undefined + +-- |Elliptic Point Modified Jacobian coordinates, four parameters x,y,z and A*z^4 (A being the first curve-parameter), like affine coordinates (x/z^2,y/z^3) +data EPmj = EPmj (BitLength,EC,Integer, Integer, Integer, Integer) + | Infmj + deriving (Eq) +instance Show EPmj where show (EPmj (a,b,c,d,e,f)) = show (a,b,c,d,e,f) + show Infmj = "Null" +instance ECP EPmj where + inf = Infmj + fromAffineCoords (EPa (l,curve@(EC (alpha,_,_)),a,b)) = EPmj (l,curve,a,b,1,alpha) + fromAffineCoords Infa = Infmj + getBitLength (EPmj (l,_,_,_,_,_)) = l + getBitLength (Infmj) = undefined + getCurve (EPmj (_,c,_,_,_,_)) = c + getCurve (Infmj) = undefined + getx (EPmj (_,(EC (_,_,p)),x,_,z,_)) = (x * (modinv (z^(2::Int)) p)) `mod` p + getx Infmj = undefined + gety (EPmj (_,(EC (_,_,p)),_,y,z,_)) = (y * (modinv (z^(3::Int)) p)) `mod` p + gety Infmj = undefined + pdouble (EPmj (l,c@(EC (_,_,p)),x1,y1,z1,z1')) = + let s = 4*x1*y1^(2::Int) `mod` p + u = 8*y1^(4::Int) `mod` p + m = (3*x1^(2::Int) + z1') `mod` p + t = (-2*s + m^(2::Int)) `mod` p + x3 = t + y3 = (m*(s - t) - u) `mod` p + z3 = 2*y1*z1 `mod` p + z3' = 2*u*z1' `mod` p + in EPmj (l,c,x3,y3,z3,z3') + pdouble Infmj = Infmj + padd Infmj a = a + padd a Infmj = a + padd p1@(EPmj (l,curve@(EC (alpha,_,p)),x1,y1,z1,_)) p2@(EPmj (l',curve',x2,y2,z2,_)) + | x1==x2,y1==(-y2) = Infmj + | p1==p2 = pdouble p1 + | otherwise = + let u1 = (x1*z2^(2::Int)) `mod` p + u2 = (x2*z1^(2::Int)) `mod` p + s1 = (y1*z2^(3::Int)) `mod` p + s2 = (y2*z1^(3::Int)) `mod` p + h = (u2 - u1) `mod` p + r = (s2 - s1) `mod` p + x3 = (-h^(3::Int) - 2*u1*h^(2::Int) + r^(2::Int)) `mod` p + y3 = (-s1*h^(3::Int) + r*(u1*h^(2::Int) - x3)) `mod` p + z3 = (z1*z2*h) `mod` p + z3' = (alpha*z3^(4::Int)) `mod` p + in if l==l' && curve==curve' then EPmj (l,curve,x3,y3,z3,z3') + else undefined + +-- |this is a generic handle for Point Multiplication. The implementation may change. +pmul :: (ECP a) => a -- ^the point to multiply + -> Integer -- ^times to multiply the point + -> a -- ^the result-point +pmul = montgladder +{-pmul = dnadd + +-- |double and add for generic ECP +dnadd :: (ECP a) => a -> Integer -> a +dnadd b k' = + let (EC (_,_,p)) = getCurve b + k = k' `mod` (p - 1) + ex a i + | i < 0 = a + | not (testBit k i) = ex (pdouble a) (i - 1) + | otherwise = ex (padd (pdouble a) b) (i - 1) + in ex inf (L.length (binary k) - 1) +-} + +-- montgomery ladder, timing-attack-resistant (except for caches...) +montgladder :: (ECP a) => a -> Integer -> a +montgladder b k' = + let (EC (_,_,p)) = getCurve b + k = k' `mod` (p - 1) + ex p1 p2 i + | i < 0 = p1 + | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1) + | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1) + in ex b (pdouble b) ((L.length (binary k)) - 2) + +-- binary representation of an integer +-- taken from http://haskell.org/haskellwiki/Fibonacci_primes_in_parallel +-- binary :: (Integral a) => a -> String +binary = flip (showIntAtBase 2 intToDigit) [] + +-- |generic verify, if generic ECP is on EC via getx and gety +ison :: (ECP a) => a -- ^ the elliptic curve point which we check + -> Bool -- ^is the point on the curve? +ison pt = let (EC (alpha,beta,p)) = getCurve pt + x = getx pt + y = gety pt + in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p +{- +-- | given a generator and a curve, generate a point randomly +genkey :: (ECP a) => a -- ^a generator (a point on the curve which multiplied gets to be every other point on the curve) + -> EC -- ^the curve + -> IO a -- ^the random point which will be the key +genkey a c@(EC (_,_,p)) = do + n <- evalRandIO $ getRandomR (1,p) + return $ pmul a n c +-} +{- +generateInteger :: (ECP a, CryptoRandomGen g) => a -> g -> Maybe (Integer, g) +generateInteger base g = let (EC (_,_,p)) = getCurve base + in case genInteger g (1,p-1) of + Left _ -> Nothing + Right (random1,g') -> Just (random1,g') +-} +-- helper-functions for getting basic points with less fuss +p521point :: (ECP a) => a +p521point = fromAffineCoords (EPa (stdc_l p521,(EC (stdc_a p521,stdc_b p521,stdc_p p521)), stdc_xp p521,stdc_xp p521)) + +p256point :: (ECP a) => a +p256point = fromAffineCoords (EPa (stdc_l p256,(EC (stdc_a p256,stdc_b p256,stdc_p p256)), stdc_xp p256,stdc_xp p256)) + +p384point :: (ECP a) => a +p384point = fromAffineCoords (EPa (stdc_l p384,(EC (stdc_a p384,stdc_b p384,stdc_p p384)), stdc_xp p384,stdc_xp p384)) + + + +-- +-- NEW Implementation, for F(2^e) +-- + +-- platzhalter, falls aufteilen mehr bringt, ansonsten weiter montgladder +-- |computing the modular inverse of @a@ `emod` @m@ +modinvF2K :: (ECPF2 a) => a -- ^the point to invert + -> a -- ^the inverted point +modinvF2K x = let d = getBitLengthF2 x + in pmulF2 x ((2^d)-2) + + +-- This class looks necessary, because repa has it's own Num-instance which is not what's wanted +class ECCNum a where + -- | abstract over (+) + eadd :: a -> a -> a + -- | abstract over (*) + emul :: a -> a -> a + -- | abstract over (^), used for small exponents + epow :: a -> Integer -> a + -- | abstract over mod + emod :: a -> a -> a + +instance ECCNum (R.Array R.U R.DIM1 Bool) where + eadd = f2eAdd + emul = f2eMul + epow = f2ePow + emod = f2eReduceBy + +-- | All Elliptic Curves, binary +class ECurve a where + getA :: a -> R.Array R.U R.DIM1 Bool + getB :: a -> R.Array R.U R.DIM1 Bool + getP :: a -> R.Array R.U R.DIM1 Bool + +-- |class of (non-hyper) Elliptic Curves, has the form y^2+x*y=x^3+A*x^2+B mod P, the parameters being A, B and P +data (ECCNum a) => ECSC a = ECSC (a, a, a) + deriving (Eq) +instance Show (ECSC (R.Array R.U R.DIM1 Bool)) where show (ECSC (a,b,p)) = "y^2+x*y=x^3+" ++ show ((f2eToInteger a)::Integer) ++ "*x^2+" ++ show ((f2eToInteger b)::Integer) ++ " mod " ++ show ((f2eToInteger p)::Integer) +instance ECurve (ECSC (R.Array R.U R.DIM1 Bool)) where + getA (ECSC (a,_,_)) = a + getB (ECSC (_,b,_)) = b + getP (ECSC (_,_,p)) = p + +-- |class of all Elliptic Curve Points +class ECPF2 a where + -- |function returning the appropriate INF in the specific ECP-Format, for generic higher-level-algorithms + infF2 :: a + -- |build point from one in affine coordinates + fromAffineCoordsF2 :: EPaF2 -> a + -- |get bitlength + getBitLengthF2 :: a -> BitLength + -- |get contents of the curve + getCurveF2 :: a -> ECSC (R.Array R.U R.DIM1 Bool) + -- |generic getter, returning the affine x-value + getxF2 :: a -> R.Array R.U R.DIM1 Bool + -- |generic getters, returning the affine y-value + getyF2 :: a -> R.Array R.U R.DIM1 Bool + -- |add an elliptic point onto itself, base for padd a a + pdoubleF2 :: a -> a + -- |add 2 elliptic points + paddF2 :: a -> a -> a + +-- |Elliptic Point Affine coordinates, two parameters x and y +data EPaF2 = EPaF2 (BitLength, ECSC (R.Array R.U R.DIM1 Bool), R.Array R.U R.DIM1 Bool, R.Array R.U R.DIM1 Bool) + | InfaF2 + deriving (Eq) +instance Show EPaF2 where show (EPaF2 (a,b,c,d)) = show (a,b,((f2eToInteger c)::Integer),((f2eToInteger d)::Integer)) + show InfaF2 = "Null" +instance ECPF2 EPaF2 where + infF2 = InfaF2 + fromAffineCoordsF2 = id + getBitLengthF2 (EPaF2 (l,_,_,_)) = l + getBitLengthF2 (InfaF2) = undefined + getCurveF2 (EPaF2 (_,c,_,_)) = c + getCurveF2 (InfaF2) = undefined + getxF2 (EPaF2 (_,_,x,_)) = x + getxF2 InfaF2 = undefined + getyF2 (EPaF2 (_,_,_,y)) = y + getyF2 InfaF2 = undefined + pdoubleF2 (EPaF2 (l,c@(ECSC (alpha,_,p)),x1,y1)) = + let lambda = (x1 `eadd` (y1 `emul` (modinvF2 x1 p))) + x3 = (lambda `epow` 2) `eadd` lambda `eadd` alpha `emod` p + y3 = (lambda `emul` (x1 `eadd` x3)) `eadd` x3 `eadd` y1 `emod` p + in EPaF2 (l,c,x3,y3) + pdoubleF2 InfaF2 = InfaF2 + paddF2 InfaF2 a = a + paddF2 a InfaF2 = a + paddF2 a@(EPaF2 (l,c@(ECSC (alpha,_,p)),x1,y1)) b@(EPaF2 (l',c',x2,y2)) + | ((f2eLen x1 == f2eLen x2) && (x1==x2)), (f2eLen y1 == f2eLen y2 && f2eLen x2 == f2eLen y2) && (y1==(x2 `eadd` y2)) = InfaF2 + | (f2eLen x1 == f2eLen x2) && (f2eLen y1 == f2eLen y2) && a==b = pdoubleF2 a + | otherwise = + let lambda = ((y1 `eadd` y2) `emul` (modinvF2 (x1 `eadd` x2) p)) `emod` p + x3 = ((lambda `epow` 2) `eadd` lambda `eadd` x1 `eadd` x2 `eadd` alpha) `emod` p + y3 = ((lambda `emul` (x1 `eadd` x3)) `eadd` x3 `eadd` y1) `emod` p + in if l==l' && c==c' then EPaF2 (l,c,x3,y3) + else undefined + +-- |Elliptic Point Projective coordinates, three parameters x, y and z, like affine (x/z,y/z) +data EPpF2 = EPpF2 (BitLength, ECSC (R.Array R.U R.DIM1 Bool), R.Array R.U R.DIM1 Bool, R.Array R.U R.DIM1 Bool, R.Array R.U R.DIM1 Bool) + | InfpF2 + deriving (Eq) +instance Show EPpF2 where show (EPpF2 (a,b,c,d,e)) = show (a,b,((f2eToInteger c)::Integer),((f2eToInteger d)::Integer),((f2eToInteger e)::Integer)) + show InfpF2 = "Null" + +instance ECPF2 EPpF2 where + infF2 = InfpF2 + fromAffineCoordsF2 (EPaF2 (l,curve,a,b)) = EPpF2 (l,curve,a,b,f2eFromInteger 1) + fromAffineCoordsF2 InfaF2 = InfpF2 + getBitLengthF2 (EPpF2 (l,_,_,_,_)) = l + getBitLengthF2 (InfpF2) = undefined + getCurveF2 (EPpF2 (_,c,_,_,_)) = c + getCurveF2 (InfpF2) = undefined + getxF2 (EPpF2 (_,(ECSC (_,_,p)),x,_,z))= (x `emul` (modinvF2 z p)) `emod` p + getxF2 InfpF2 = undefined + getyF2 (EPpF2 (_,(ECSC (_,_,p)),_,y,z)) = (y `emul` (modinvF2 z p)) `emod` p + getyF2 InfpF2 = undefined + pdoubleF2 (EPpF2 (l,curve@(ECSC (alpha,_,p)),x1,y1,z1)) = + let a = (x1 `epow` 2) `emod` p + b = (a `eadd` (y1 `emul` z1)) `emod` p + c = (x1 `emul` z1) `emod` p + d = (c `epow` 2) `emod` p + e = ((b `epow` 2) `eadd` (b `emul` c) `eadd` (alpha `emul` d)) `emod` p + x3 = (c `emul` e) `emod` p + y3 = (((b `eadd` c) `emul` e) `eadd` ((a `epow` 2) `emul` c)) `emod` p + z3 = (c `emul` d) `emod` p + in EPpF2 (l,curve,x3,y3,z3) + pdoubleF2 InfpF2 = InfpF2 + paddF2 InfpF2 a = a + paddF2 a InfpF2 = a + paddF2 p1@(EPpF2 (l,curve@(ECSC (alpha,_,p)),x1,y1,z1)) p2@(EPpF2 (l',curve',x2,y2,z2)) + | ((f2eLen x1 == f2eLen x2) && (x1==x2)),((f2eLen y1 == f2eLen y2 && f2eLen x2 == f2eLen y2) && y1==(x2 `eadd` y2)) = InfpF2 + | (f2eLen x1 == f2eLen x2) && (f2eLen y1 == f2eLen y2) && p1==p2 = pdoubleF2 p1 + | otherwise = + let a = ((y1 `emul` z2) `eadd` (z1 `emul` y2)) `emod` p + b = ((x1 `emul` z2) `eadd` (z1 `emul` x2)) `emod` p + c = (x1 `emul` z1) `emod` p + d = (c `epow` 2) `emod` p + e = ((((a `epow` 2) `eadd` (a `emul` b) `eadd` (alpha `emul` c)) `emul` d) `eadd` (b `emul` c)) `emod` p + x3 = (b `emul` e) `emod` p + y3 = (((c `emul` ((a `emul` x1) `eadd` (y1 `emul` b))) `emul` z2) `eadd` ((a `eadd` b) `emul` e)) `emod` p + z3 = ((b `epow` 3) `emul` d) `emod` p + in if l==l' && curve==curve' then EPpF2 (l,curve,x3,y3,z3) + else undefined + +-- |this is a generic handle for Point Multiplication. The implementation may change. +pmulF2 :: (ECPF2 a) => a -- ^the point to multiply + -> Integer -- ^times to multiply the point + -> (ECPF2 a) => a -- ^the result-point +pmulF2 = montgladderF2 + +-- montgomery ladder, timing-attack-resistant (except for caches...) +montgladderF2 :: (ECPF2 a) => a -> Integer -> a +montgladderF2 b k' = + let (ECSC (_,_,p)) = getCurveF2 b + k = k' `mod` ((f2eToInteger p) - 1) + ex p1 p2 i + | i < 0 = p1 + | not (testBit k i) = ex (pdoubleF2 p1) (paddF2 p1 p2) (i - 1) + | otherwise = ex (paddF2 p1 p2) (pdoubleF2 p2) (i - 1) + in ex b (pdoubleF2 b) ((L.length (binary k)) - 2) + +-- |generic verify, if generic ECP is on EC via getx and gety +isonF2 :: (ECPF2 a, Eq a) => a -- ^ the elliptic curve point which we check + -> Bool -- ^is the point on the curve? +isonF2 pt = let (ECSC (alpha,beta,p)) = getCurveF2 pt + x = getxF2 pt + y = getyF2 pt + in ((y `epow` 2) `eadd` (x `emul` y)) `emod` p == ((x `epow` 3) `eadd` (alpha `emul` (x `epow` 2)) `eadd` beta) `emod` p + +b283point :: (ECPF2 a) => a +b283point = fromAffineCoordsF2 (EPaF2 (stdcF_l b283,(ECSC (stdcF_a b283,stdcF_b b283,stdcF_p b283)), stdcF_xp b283,stdcF_yp b283)) + +k283point :: (ECPF2 a) => a +k283point = fromAffineCoordsF2 (EPaF2 (stdcF_l k283,(ECSC (stdcF_a k283,stdcF_b k283,stdcF_p k283)), stdcF_xp k283,stdcF_yp k283)) diff --git a/src/Codec/Crypto/ECC/F2.hs b/src/Codec/Crypto/ECC/F2.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/ECC/F2.hs @@ -0,0 +1,187 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Crypto.ECC.F2 +-- Copyright : (c) Marcel Fourné 2011 +-- License : BSD3 +-- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org) +-- +-- F(2^e)-Backend +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE TypeOperators,FlexibleContexts,FlexibleInstances #-} +module Codec.Crypto.ECC.F2 (f2eAdd, + f2eMul, + f2eBitshift, + f2eReduceBy, + f2eFromInteger, + f2ePow, + f2eToInteger, + f2eTestBit, + elimFalses, + modinvF2, + f2eLen) + where + +import Data.List as L +import Numeric +import Data.Char +import Data.Array.Repa as R +import qualified Data.Vector.Unboxed as V + +instance Eq a => Eq (Array U DIM1 a) where +{-c@(R.Array r1 sh1 a1) == c'@(R.Array r2 sh2 a2) = let l1 = V.length $ toUnboxed c + i1 = index c + i2 = index c' + in foldAllP (and) True $ traverse2 + r1 + (\(sh1 :. l1) -> (sh1 :. l1)) + (\equals i1 i2 sh3 -> + if i1 sh3 Prelude.== i2 sh3 + then True + else False)-} +c == c' = c Prelude.== c' + +bxor :: Bool -> Bool -> Bool +bxor a b | a Prelude.== False = b + | a Prelude.== True = not b + | otherwise = undefined + +-- hier optimieren per C +-- |binary addition of @a1@ and @a2@ +f2eAdd :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool +f2eAdd a1 a2 = let l1 = V.length $ toUnboxed a1 + l2 = V.length $ toUnboxed a2 + l = if l1 >= l2 then l1 + else l2 + add' a1' a2' = R.zipWith + (bxor) + (fillTo a1' l) + (fillTo a2' l) + in computeUnboxedP $ add' a1 a2 + +-- eventuell auch per C optimieren (statt parallel) +-- nötig? doch per slices und internem shift? +-- |a simple bitshift where @n@ shifts left, so a negative @n@ shifts right +f2eBitshift :: Array U DIM1 Bool -> Int -> Array U DIM1 Bool +-- f2eBitShift a 0 = a +f2eBitshift a n = let l1 = V.length $ toUnboxed a + in computeUnboxedP $ R.traverse + a + (\(sh :. l) -> (sh :. (l + n))) + (\lookie (sh:. l2) -> if l2 >= l1 + then False + else lookie (sh :. l2)) +-- |binary multiplication of @a1@ and @a2@ +f2eMul :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool +f2eMul a1 a2 = let l1 = V.length $ toUnboxed a1 + l2 = V.length $ toUnboxed a2 + l = if l1 >= l2 then l1 + else l2 + lz = (2*l) - 1 + nullen = R.fromUnboxed (Z :. lz) $ V.replicate lz False + pseudo = R.fromUnboxed (Z :. l2) $ V.replicate l2 False + fun a b | not $ V.null a = let ltemp = (V.length a) - 1 + in if V.head a Prelude.== True + -- real branch + then fun (V.tail a) (f2eAdd b (fillTo (f2eBitshift a2 ltemp) lz)) + -- for timing-attack-resistance xor with 0s + else fun (V.tail a) (f2eAdd b (fillTo (f2eBitshift pseudo ltemp) lz)) + | otherwise = b + in elimFalses $ fun (toUnboxed $ fillTo a1 l) nullen + +-- |polynomial reduction of @a@ via @r@ +f2eReduceBy :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool +f2eReduceBy a r | (f2eLen r Prelude.== 1) && (f2eToInteger r Prelude.== 1) = f2eFromInteger 0 + | (f2eLen r Prelude.== 1) && (f2eToInteger r Prelude.== 0) = a + | otherwise = + let va = toUnboxed a + lr = V.length $ toUnboxed r + pseudo = R.fromUnboxed (Z :. lr) $ V.replicate lr False + fun z + | V.length z >= lr = + let ltemp = V.length z + in if V.head z Prelude.== True + -- real branch + then fun (V.tail (V.zipWith (bxor) z (toUnboxed $ fillTo (f2eBitshift r (ltemp-lr)) ltemp))) + -- for timing-attack-resistance xor with 0s + else fun (V.tail (V.zipWith (bxor) z (toUnboxed $ fillTo (f2eBitshift pseudo (ltemp-lr)) ltemp))) + | otherwise = z + ergtemp = fun va + pre = fromUnboxed (Z :. (V.length) ergtemp) ergtemp + in elimFalses pre + +-- too much overhead, unroll for the only cases used: k = 2 and k = 3 +f2ePow :: Array U DIM1 Bool -> Integer -> Array U DIM1 Bool +{-f2ePow b k = + let zwo = (f2eFromInteger 2) + ex p1 p2 i + | i < 0 = p1 + | not (testBit k i) = ex (f2eMul p1 zwo) (f2eAdd p1 p2) (i - 1) + | otherwise = ex (f2eAdd p1 p2) (f2eMul p2 zwo) (i - 1) + in ex b (f2eMul b zwo) ((L.length (binary k)) - 2)-} +f2ePow b k | k Prelude.== 2 = f2eMul b b + | k Prelude.== 3 = f2eMul b $ f2eMul b b + | otherwise = b + + + +fillTo :: Array U DIM1 Bool -> Int -> Array U DIM1 Bool +fillTo a n = let vec = toUnboxed a + l = V.length vec + in if l < n + then fromUnboxed (Z :. n) $ (V.replicate (n-l) False) V.++ vec + else a + +shortenTo :: Array U DIM1 Bool -> Int -> Array U DIM1 Bool +shortenTo a n = let vec = toUnboxed a + l = V.length vec + n' = abs n + in fromUnboxed (Z :. n') $ V.drop (l - n') vec + +elimFalses :: Array U DIM1 Bool -> Array U DIM1 Bool +elimFalses a = let v = toUnboxed a + i = V.length v + helper n = if n <= 1 then 1 + else if f2eTestBit a (i - n) Prelude.== False then helper (n - 1) + else n + in shortenTo a (helper i) + +binary :: Integer -> String +binary = flip (showIntAtBase (2::Integer) intToDigit) [] + +f2eFromInteger :: Integer -> Array U DIM1 Bool +f2eFromInteger z = let helper a = if a Prelude.== '1' then True + else False + bin = binary z + len = length bin + in fromListUnboxed (Z :. len) $ L.map helper bin + +f2eToInteger :: Array U DIM1 Bool -> Integer +f2eToInteger z = let helper a = if a Prelude.== True then 1 + else 0 + vec = toUnboxed z + it rest n = let len = V.length rest + in if len > 0 then let el = V.head rest + in it (V.tail rest) (n + (helper el)*2^(len-1)) + else n + in it vec 0 + +f2eTestBit :: Array U DIM1 Bool -> Int -> Bool +f2eTestBit k i = let l = V.length $ toUnboxed k + in if i >= 0 && l >= 0 && i <= l then index k (Z :. i) + else undefined + +-- |computing the modular inverse of @a@ `emod` @m@, this is broken atm +modinvF2 :: Array U DIM1 Bool -- ^the polynomial to invert + -> Array U DIM1 Bool -- ^the modulus + -> Array U DIM1 Bool -- ^the inverted value +modinvF2 a f = let helper u v g1 g2 + | ((V.length $ toUnboxed u) Prelude.== 1) && (u Codec.Crypto.ECC.F2.== f2eFromInteger 1) = g1 + | otherwise = + let j = (V.length $ toUnboxed u) - (V.length $ toUnboxed v) + in if j < 0 then helper (elimFalses (v `f2eAdd` (f2eBitshift u (-j)))) u (elimFalses (g2 `f2eAdd` (f2eBitshift g1 (-j)))) g1 + else helper (elimFalses (u `f2eAdd` (f2eBitshift v j))) v (elimFalses (g1 `f2eAdd` (f2eBitshift g2 j))) g2 + in helper a f (f2eFromInteger 1) (f2eFromInteger 0) + +f2eLen a = V.length $ toUnboxed a diff --git a/src/Codec/Crypto/ECC/StandardCurves.hs b/src/Codec/Crypto/ECC/StandardCurves.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Crypto/ECC/StandardCurves.hs @@ -0,0 +1,73 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Codec.Crypto.ECC.StandardCurves +-- Copyright : (c) Marcel Fourné 2009-2012 +-- License : BSD3 +-- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org) +-- +-- ECC Standard Curves, taken from Standard Documents found somewhere(tm) +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE TypeOperators #-} +module Codec.Crypto.ECC.StandardCurves + where + +import Codec.Crypto.ECC.F2 +import Data.Array.Repa as R + +data StandardCurve = StandardCurve {stdc_l::Int,stdc_p::Integer,stdc_a::Integer,stdc_b::Integer,stdc_xp::Integer,stdc_yp::Integer} + +-- Curves over Prime Fields, NIST variety + +p521:: StandardCurve +p521 = StandardCurve { + stdc_l = 521, + stdc_p = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057151, + stdc_a = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057148, + stdc_b = 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984, + stdc_xp = 2661740802050217063228768716723360960729859168756973147706671368418802944996427808491545080627771902352094241225065558662157113545570916814161637315895999846, + stdc_yp = 3757180025770020463545507224491183603594455134769762486694567779615544477440556316691234405012945539562144444537289428522585666729196580810124344277578376784 + } + +p256:: StandardCurve +p256 = StandardCurve { + stdc_l = 256, + stdc_p = 115792089210356248762697446949407573530086143415290314195533631308867097853951, + stdc_a = 115792089210356248762697446949407573530086143415290314195533631308867097853948, + stdc_b = 41058363725152142129326129780047268409114441015993725554835256314039467401291, + stdc_xp = 48439561293906451759052585252797914202762949526041747995844080717082404635286, + stdc_yp = 36134250956749795798585127919587881956611106672985015071877198253568414405109 + } + +p384:: StandardCurve +p384 = StandardCurve { + stdc_l = 384, + stdc_p = 39402006196394479212279040100143613805079739270465446667948293404245721771496870329047266088258938001861606973112319, + stdc_a = 39402006196394479212279040100143613805079739270465446667948293404245721771496870329047266088258938001861606973112316, + stdc_b = 27580193559959705877849011840389048093056905856361568521428707301988689241309860865136260764883745107765439761230575, + stdc_xp = 26247035095799689268623156744566981891852923491109213387815615900925518854738050089022388053975719786650872476732087, + stdc_yp = 8325710961489029985546751289520108179287853048861315594709205902480503199884419224438643760392947333078086511627871 + } + +data StandardCurveF2 = StandardCurveF2 {stdcF_l::Int,stdcF_p::Array U (Z :. Int) Bool,stdcF_a::Array U (Z :. Int) Bool,stdcF_b::Array U (Z :. Int) Bool,stdcF_xp::Array U (Z :. Int) Bool,stdcF_yp::Array U (Z :. Int) Bool} + +k283:: StandardCurveF2 +k283 = StandardCurveF2 { + stdcF_l = 283, + stdcF_p = f2eFromInteger 15541351137805832567355695254588151253139254712417116170014499277911234281641667989665, + stdcF_a = f2eFromInteger 0, + stdcF_b = f2eFromInteger 1, + stdcF_xp = f2eFromInteger 9737095673315832344313391497449387731784428326114441977662399932694280557468376967222, + stdcF_yp = f2eFromInteger 3497201781826516614681192670485202061196189998012192335594744939847890291586353668697 + } + +b283:: StandardCurveF2 +b283 = StandardCurveF2 { + stdcF_l = 283, + stdcF_p = f2eFromInteger 15541351137805832567355695254588151253139254712417116170014499277911234281641667989665, + stdcF_a = f2eFromInteger 1, + stdcF_b = f2eFromInteger 4821813576056072374006997780399081180312270030300601270120450341205914644378616963829, + stdcF_xp = f2eFromInteger 11604587487407003699882500449177537465719784002620028212980871291231978603047872962643, + stdcF_yp = f2eFromInteger 6612720053854191978412609357563545875491153188501906352980899759345275170452624446196 + } diff --git a/src/Codec/Encryption/ECC/Base.hs b/src/Codec/Encryption/ECC/Base.hs deleted file mode 100644 --- a/src/Codec/Encryption/ECC/Base.hs +++ /dev/null @@ -1,253 +0,0 @@ -{-# LANGUAGE PatternGuards #-} ------------------------------------------------------------------------------ --- | --- Module : Codec.Encryption.ECC.Base --- Copyright : (c) Marcel Fourné 2009 --- License : BSD3 --- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org --- --- ECC Base algorithms & point formats --- ------------------------------------------------------------------------------ - -module Codec.Encryption.ECC.Base (ECP(..), - EC(..), - modinv, - pmul, - ison, - genkey, - EPa(..), - EPp(..), - EPj(..), - EPmj(..)) - where - -import Control.Monad.Random -import Data.Bits -import Numeric -import Char - --- |extended euclidean algorithm, recursive variant -eeukl :: Integer -> Integer -> (Integer, Integer, Integer) -eeukl a 0 = (a,1,0) -eeukl a b = let (d,s,t) = eeukl b (a `mod` b) - in (d,t,s-(div a b)*t) - --- |computing the modular inverse of @a@ `mod` @m@ -modinv :: Integer -- ^the number to invert - -> Integer -- ^the modulus - -> Integer -- ^the inverted value -modinv a m = let (x,y,_) = eeukl a m - in if x == 1 - then mod y m - else undefined - --- |class of all Elliptic Curves, has the form y^2=x^3+A*x+B mod P, the parameters being A, B and P -data EC = EC (Integer, Integer, Integer) - deriving (Eq) -instance Show EC where show (EC (a,b,p)) = "y^2=x^3+" ++ show a ++ "*x+" ++ show b ++ " mod " ++ show p - --- |class of all Elliptic Curve Points -class ECP a where - -- |function returning the appropriate INF in the specific ECP-Format, for generic higher-level-algorithms - inf :: a - -- |generic getter, returning the affine x-value - getx :: a -> EC -> Integer - -- |generic getters, returning the affine y-value - gety :: a -> EC -> Integer - -- |add an elliptic point onto itself, base for padd a a c - pdouble :: a -> EC -> a - -- |add 2 elliptic points - padd :: a -> a -> EC -> a - --- |Elliptic Point Affine coordinates, two parameters x and y -data EPa = EPa (Integer, Integer) - | Infa - deriving (Eq) -instance Show EPa where show (EPa (a,b)) = show (a,b) - show Infa = "Null" -instance ECP EPa where - inf = Infa - getx (EPa (x,_)) _ = x - getx Infa _ = undefined - gety (EPa (_,y)) _ = y - gety Infa _ = undefined - pdouble (EPa (x1,y1)) (EC (alpha,_,p)) = - let lambda = ((3*x1^(2::Int)+alpha)*(modinv (2*y1) p)) `mod` p - x3 = (lambda^(2::Int) - 2*x1) `mod` p - y3 = (lambda*(x1-x3)-y1) `mod` p - in EPa (x3,y3) - pdouble Infa _ = Infa - padd Infa a _ = a - padd a Infa _ = a - padd a@(EPa (x1,y1)) b@(EPa (x2,y2)) c@(EC (_,_,p)) - | x1==x2,y1==(-y2) = Infa - | a==b = pdouble a c - | otherwise = - let lambda = ((y2-y1)*(modinv (x2-x1) p)) `mod` p - x3 = (lambda^(2::Int) - x1 - x2) `mod` p - y3 = (lambda*(x1-x3)-y1) `mod` p - in EPa (x3,y3) - --- |Elliptic Point Projective coordinates, three parameters x, y and z, like affine (x/z,y/z) -data EPp = EPp (Integer, Integer, Integer) - | Infp - deriving (Eq) -instance Show EPp where show (EPp (a,b,c)) = show (a,b,c) - show Infp = "Null" -instance ECP EPp where - inf = Infp - getx (EPp (x,_,z)) (EC (_,_,p)) = (x * (modinv z p)) `mod` p - getx Infp _ = undefined - gety (EPp (_,y,z)) (EC (_,_,p)) = (y * (modinv z p)) `mod` p - gety Infp _ = undefined - pdouble (EPp (x1,y1,z1)) (EC (alpha,_,p)) = - let a = (alpha*z1^(2::Int)+3*x1^(2::Int)) `mod` p - b = (y1*z1) `mod` p - c = (x1*y1*b) `mod` p - d = (a^(2::Int)-8*c) `mod` p - x3 = (2*b*d) `mod` p - y3 = (a*(4*c-d)-8*y1^(2::Int)*b^(2::Int)) `mod` p - z3 = (8*b^(3::Int)) `mod` p - in EPp (x3,y3,z3) - pdouble Infp _ = Infp - padd Infp a _ = a - padd a Infp _ = a - padd p1@(EPp (x1,y1,z1)) p2@(EPp (x2,y2,z2)) curve@(EC (_,_,p)) - | x1==x2,y1==(-y2) = Infp - | p1==p2 = pdouble p1 curve - | otherwise = - let a = (y2*z1 - y1*z2) `mod` p - b = (x2*z1 - x1*z2) `mod` p - c = (a^(2::Int)*z1*z2 - b^(3::Int) - 2*b^(2::Int)*x1*z2) `mod` p - x3 = (b*c) `mod` p - y3 = (a*(b^(2::Int)*x1*z2-c)-b^(3::Int)*y1*z2) `mod` p - z3 = (b^(3::Int)*z1*z2) `mod` p - in EPp (x3,y3,z3) - --- |Elliptic Point Jacobian coordinates, three parameter x, y and z, like affine (x/z^2,y/z^3) -data EPj = EPj (Integer, Integer, Integer) - | Infj - deriving (Eq) -instance Show EPj where show (EPj (a,b,c)) = show (a,b,c) - show Infj = "Null" -instance ECP EPj where - inf = Infj - getx (EPj (x,_,z)) (EC (_,_,p)) = (x * (modinv (z^(2::Int)) p)) `mod` p - getx Infj _ = undefined - gety (EPj (_,y,z)) (EC (_,_,p)) = (y * (modinv (z^(3::Int)) p)) `mod` p - gety Infj _ = undefined - pdouble (EPj (x1,y1,z1)) (EC (alpha,_,p)) = - let a = 4*x1*y1^(2::Int) `mod` p - b = (3*x1^(2::Int) + alpha*z1^(4::Int)) `mod` p - x3 = (-2*a + b^(2::Int)) `mod` p - y3 = (-8*y1^(4::Int) + b*(a-x3)) `mod` p - z3 = 2*y1*z1 `mod` p - in EPj (x3,y3,z3) - pdouble Infj _ = Infj - padd Infj a _ = a - padd a Infj _ = a - padd p1@(EPj (x1,y1,z1)) p2@(EPj (x2,y2,z2)) curve@(EC (_,_,p)) - | x1==x2,y1==(-y2) = Infj - | p1==p2 = pdouble p1 curve - | otherwise = - let a = (x1*z2^(2::Int)) `mod` p - b = (x2*z1^(2::Int)) `mod` p - c = (y1*z2^(3::Int)) `mod` p - d = (y2*z1^(3::Int)) `mod` p - e = (b - a) `mod` p - f = (d - c) `mod` p - x3 = (-e^(3::Int) - 2*a*e^(2::Int) + f^(2::Int)) `mod` p - y3 = (-c*e^(3::Int) + f*(a*e^(2::Int) - x3)) `mod` p - z3 = (z1*z2*e) `mod` p - in EPj (x3,y3,z3) - --- |Elliptic Point Modified Jacobian coordinates, four parameters x,y,z and A*z^4 (A being the first curve-parameter), like affine coordinates (x/z^2,y/z^3) -data EPmj = EPmj (Integer, Integer, Integer, Integer) - | Infmj - deriving (Eq) -instance Show EPmj where show (EPmj (a,b,c,d)) = show (a,b,c,d) - show Infmj = "Null" -instance ECP EPmj where - inf = Infmj - getx (EPmj (x,_,z,_)) (EC (_,_,p)) = (x * (modinv (z^(2::Int)) p)) `mod` p - getx Infmj _ = undefined - gety (EPmj (_,y,z,_)) (EC (_,_,p)) = (y * (modinv (z^(3::Int)) p)) `mod` p - gety Infmj _ = undefined - pdouble (EPmj (x1,y1,z1,z1')) (EC (_,_,p)) = - let s = 4*x1*y1^(2::Int) `mod` p - u = 8*y1^(4::Int) `mod` p - m = (3*x1^(2::Int) + z1') `mod` p - t = (-2*s + m^(2::Int)) `mod` p - x3 = t - y3 = (m*(s - t) - u) `mod` p - z3 = 2*y1*z1 `mod` p - z3' = 2*u*z1' `mod` p - in EPmj (x3,y3,z3,z3') - pdouble Infmj _ = Infmj - padd Infmj a _ = a - padd a Infmj _ = a - padd p1@(EPmj (x1,y1,z1,_)) p2@(EPmj (x2,y2,z2,_)) curve@(EC (alpha,_,p)) - | x1==x2,y1==(-y2) = Infmj - | p1==p2 = pdouble p1 curve - | otherwise = - let u1 = (x1*z2^(2::Int)) `mod` p - u2 = (x2*z1^(2::Int)) `mod` p - s1 = (y1*z2^(3::Int)) `mod` p - s2 = (y2*z1^(3::Int)) `mod` p - h = (u2 - u1) `mod` p - r = (s2 - s1) `mod` p - x3 = (-h^(3::Int) - 2*u1*h^(2::Int) + r^(2::Int)) `mod` p - y3 = (-s1*h^(3::Int) + r*(u1*h^(2::Int) - x3)) `mod` p - z3 = (z1*z2*h) `mod` p - z3' = (alpha*z3^(4::Int)) `mod` p - in EPmj (x3,y3,z3,z3') - --- |this is a generic handle for Point Multiplication. The implementation may change. -pmul :: (ECP a) => a -- ^the point to multiply - -> Integer -- ^times to multiply the point - -> EC -- ^the curve to operate on - -> a -- ^the result-point -pmul = montgladder --- pmul = dnadd - --- |double and add for generic ECP -dnadd :: (ECP a) => a -> Integer -> EC -> a -dnadd b k' c@(EC (_,_,p)) = - let k = k' `mod` (p - 1) - ex a i - | i < 0 = a - | not (testBit k i) = ex (pdouble a c) (i - 1) - | otherwise = ex (padd (pdouble a c) b c) (i - 1) - in ex inf (length (binary k) - 1) - --- montgomery ladder, timing-attack-resistant (except for caches...) -montgladder :: (ECP a) => a -> Integer -> EC -> a -montgladder b k' c@(EC (_,_,p)) = - let k = k' `mod` (p - 1) - ex p1 p2 i - | i < 0 = p1 - | not (testBit k i) = ex (pdouble p1 c) (padd p1 p2 c) (i - 1) - | otherwise = ex (padd p1 p2 c) (pdouble p2 c) (i - 1) - in ex b (pdouble b c) ((length (binary k)) - 2) - --- binary representation of an integer --- taken from http://haskell.org/haskellwiki/Fibonacci_primes_in_parallel -binary :: Integer -> String -binary = flip (showIntAtBase 2 intToDigit) [] - --- |generic verify, if generic ECP is on EC via getx and gety -ison :: (ECP a) => a -- ^ the elliptic curve point which we check - -> EC -- ^the curve to test on - -> Bool -- ^is the point on the curve? -ison pt curve@(EC (alpha,beta,p)) = let x = getx pt curve - y = gety pt curve - in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p - --- | given a generator and a curve, generate a point randomly -genkey :: (ECP a) => a -- ^a generator (a point on the curve which multiplied gets to be every other point on the curve) - -> EC -- ^the curve - -> IO a -- ^the random point which will be the key -genkey a c@(EC (_,_,p)) = do - n <- evalRandIO $ getRandomR (1,p) - return $ pmul a n c diff --git a/src/Codec/Encryption/ECC/StandardCurves.hs b/src/Codec/Encryption/ECC/StandardCurves.hs deleted file mode 100644 --- a/src/Codec/Encryption/ECC/StandardCurves.hs +++ /dev/null @@ -1,37 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Codec.Encryption.ECC.StandardCurves --- Copyright : (c) Marcel Fourné 2009 --- License : BSD3 --- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org --- --- ECC Standard Curves, taken from Standard Documents found somewhere(tm) --- ------------------------------------------------------------------------------ - - -module Codec.Encryption.ECC.StandardCurves - where - -data StandardCurve = StandardCurve {stdc_p::Integer,stdc_a::Integer,stdc_b::Integer,stdc_xp::Integer,stdc_yp::Integer} - --- Curves over Prime Fields, NIST variety - -p521:: StandardCurve -p521 = StandardCurve { - stdc_p = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057151, - stdc_a = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057149, - stdc_b = 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984, - stdc_xp = 2661740802050217063228768716723360960729859168756973147706671368418802944996427808491545080627771902352094241225065558662157113545570916814161637315895999846, - stdc_yp = 3757180025770020463545507224491183603594455134769762486694567779615544477440556316691234405012945539562144444537289428522585666729196580810124344277578376784 - } - -p256:: StandardCurve -p256 = StandardCurve { - stdc_p = 115792089210356248762697446949407573530086143415290314195533631308867097853951, - stdc_a = 115792089210356248762697446949407573530086143415290314195533631308867097853948, - stdc_b = 41058363725152142129326129780047268409114441015993725554835256314039467401291, - stdc_xp = 48439561293906451759052585252797914202762949526041747995844080717082404635286, - stdc_yp = 36134250956749795798585127919587881956611106672985015071877198253568414405109 - } - diff --git a/src/Examples.hs b/src/Examples.hs --- a/src/Examples.hs +++ b/src/Examples.hs @@ -9,7 +9,7 @@ -- ----------------------------------------------------------------------------- -import Codec.Encryption.ECC.Base +import Codec.Crypto.ECC.Base ecdh :: (ECP a) => EC -> a -> Integer -> t -> Integer ecdh c a kprivA kprivB = let kpubA = pmul a kprivA c diff --git a/src/bench.hs b/src/bench.hs --- a/src/bench.hs +++ b/src/bench.hs @@ -8,25 +8,26 @@ -- benchmarking playground, not production quality -- ----------------------------------------------------------------------------- -import Codec.Encryption.ECC.Base ---import Examples -import Criterion.Main -import Codec.Encryption.ECC.StandardCurves -import Control.Monad.Random -import Char +import Codec.Crypto.ECC.Base +import Codec.Crypto.ECC.F2 +-- import Data.Array.Repa +-- import Examples +import Codec.Crypto.ECC.StandardCurves +-- import Control.Monad.Random +-- import Char -testfkt:: (ECP a) => a -> Integer -> EC -> Int -> a -testfkt b k' c n = pmul b ((toInteger (n-n)) + k') c +testfkt:: (ECP a) => a -> Integer -> Int -> a +testfkt b k' n = pmul b ((toInteger (n-n)) + k') main = do ---{- - let c = EC (stdc_a p256,stdc_b p256,stdc_p p256) +{- + let p = p256point::EPp -- k' = 78260987815077071890976764339238653408132491773166348437934213365482899760747 --- k' = 2^254+2^253+2^252+2^251+2^250 --- k' = 2^254+1 +-- k' = 2^254+2^253+2^252+2^251+2^250+2^249 +-- k' = 2^254+2^200+2^150+2^100+2^50+1 k' <- evalRandIO $ getRandomR (1,stdc_p p256) defaultMain [ - bench "NIST P-256" $ whnf (testfkt (EPp (stdc_xp p256,stdc_yp p256,1)) k' c) 10 + bench "NIST P-256" $ whnf (testfkt p k') 10 ] ---} {- @@ -36,12 +37,16 @@ bench "NIST P-521" $ whnf (testfkt (EPp (stdc_xp p521,stdc_yp p521,1)) k' c) 10 ] ---} -{- - let c = EC (stdc_a p256,stdc_b p256,stdc_p p256) - k' = 115792089210356248762697446949407573529996955224135760342422259061068512044368 - x = getx (pmul (EPp (stdc_xp p256, stdc_yp p256, 1)) k' c) c - y = gety (pmul (EPp (stdc_xp p256, stdc_yp p256, 1)) k' c) c - in print (x,y) +-- {- + let p = b283point::EPaF2 +-- k' = 115792089210356248762697446949407573529996955224135760342422259061068512044368 +-- k' = 2 + k' = 3 +-- print p +-- print (pdoubleF2 p) +-- print $ modinvF2 (f2eFromInteger 4) (f2eFromInteger 7) + print $ pmulF2 p k' +-- print $ isonF2 p ---} {- let p = 6277101735386680763835789423207666416083908700390324961279