hecc 0.2 → 0.3

raw patch · 9 files changed

+813/−320 lines, 9 filesdep +binarydep +bytestringdep +cerealdep −MonadRandomdep −haskell98dep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: binary, bytestring, cereal, crypto-api, random, repa, vector

Dependencies removed: MonadRandom, haskell98

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• COPYING +1/−1
• hecc.cabal +21/−9
• src/Codec/Crypto/ECC/Base.hs +506/−0
• src/Codec/Crypto/ECC/F2.hs +187/−0
• src/Codec/Crypto/ECC/StandardCurves.hs +73/−0
• src/Codec/Encryption/ECC/Base.hs +0/−253
• src/Codec/Encryption/ECC/StandardCurves.hs +0/−37
• src/Examples.hs +1/−1
• src/bench.hs +24/−19

@@ -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

@@ -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

@@ -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))

@@ -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

@@ -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+  }

@@ -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

@@ -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-       }-

@@ -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

@@ -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