packages feed

hecc 0.3.2 → 0.3.3

raw patch · 6 files changed

+74/−294 lines, 6 filesdep +hF2dep −repadep −vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hF2

Dependencies removed: repa, vector

API changes (from Hackage documentation)

- Codec.Crypto.ECC.Base: class ECCNum a
- Codec.Crypto.ECC.Base: eadd :: ECCNum a => a -> a -> a
- Codec.Crypto.ECC.Base: emod :: ECCNum a => a -> a -> a
- Codec.Crypto.ECC.Base: emul :: ECCNum a => a -> a -> a
- Codec.Crypto.ECC.Base: epow :: ECCNum a => a -> Integer -> a
- Codec.Crypto.ECC.Base: instance (Eq a, ECCNum a) => Eq (ECSC a)
- Codec.Crypto.ECC.Base: instance ECCNum (Array U DIM1 Bool)
- Codec.Crypto.ECC.Base: instance ECurve (ECSC (Array U DIM1 Bool))
- Codec.Crypto.ECC.Base: instance Show (ECSC (Array U DIM1 Bool))
- Codec.Crypto.ECC.F2: elimFalses :: Array U DIM1 Bool -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2eAdd :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2eBitshift :: Array U DIM1 Bool -> Int -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2eFromInteger :: Integer -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2eLen :: Unbox a => Array U sh a -> Int
- Codec.Crypto.ECC.F2: f2eMul :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2ePow :: Array U DIM1 Bool -> Integer -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2eReduceBy :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool
- Codec.Crypto.ECC.F2: f2eTestBit :: Array U DIM1 Bool -> Int -> Bool
- Codec.Crypto.ECC.F2: f2eToInteger :: Array U DIM1 Bool -> Integer
- Codec.Crypto.ECC.F2: instance Eq a => Eq (Array U DIM1 a)
- Codec.Crypto.ECC.F2: modinvF2 :: Array U DIM1 Bool -> Array U DIM1 Bool -> Array U DIM1 Bool
+ Codec.Crypto.ECC.Base: instance ECurve ECSC
+ Codec.Crypto.ECC.Base: instance Eq ECSC
+ Codec.Crypto.ECC.Base: instance Show ECSC
- Codec.Crypto.ECC.Base: ECSC :: (a, a, a) -> ECSC a
+ Codec.Crypto.ECC.Base: ECSC :: (F2, F2, F2) -> ECSC
- Codec.Crypto.ECC.Base: EPaF2 :: (BitLength, ECSC (Array U DIM1 Bool), Array U DIM1 Bool, Array U DIM1 Bool) -> EPaF2
+ Codec.Crypto.ECC.Base: EPaF2 :: (BitLength, ECSC, F2, F2) -> EPaF2
- Codec.Crypto.ECC.Base: EPpF2 :: (BitLength, ECSC (Array U DIM1 Bool), Array U DIM1 Bool, Array U DIM1 Bool, Array U DIM1 Bool) -> EPpF2
+ Codec.Crypto.ECC.Base: EPpF2 :: (BitLength, ECSC, F2, F2, F2) -> EPpF2
- Codec.Crypto.ECC.Base: data ECCNum a => ECSC a
+ Codec.Crypto.ECC.Base: data ECSC
- Codec.Crypto.ECC.Base: getA :: ECurve a => a -> Array U DIM1 Bool
+ Codec.Crypto.ECC.Base: getA :: ECurve a => a -> F2
- Codec.Crypto.ECC.Base: getB :: ECurve a => a -> Array U DIM1 Bool
+ Codec.Crypto.ECC.Base: getB :: ECurve a => a -> F2
- Codec.Crypto.ECC.Base: getCurveF2 :: ECPF2 a => a -> ECSC (Array U DIM1 Bool)
+ Codec.Crypto.ECC.Base: getCurveF2 :: ECPF2 a => a -> ECSC
- Codec.Crypto.ECC.Base: getP :: ECurve a => a -> Array U DIM1 Bool
+ Codec.Crypto.ECC.Base: getP :: ECurve a => a -> F2
- Codec.Crypto.ECC.Base: getxF2 :: ECPF2 a => a -> Array U DIM1 Bool
+ Codec.Crypto.ECC.Base: getxF2 :: ECPF2 a => a -> F2
- Codec.Crypto.ECC.Base: getyF2 :: ECPF2 a => a -> Array U DIM1 Bool
+ Codec.Crypto.ECC.Base: getyF2 :: ECPF2 a => a -> F2
- Codec.Crypto.ECC.StandardCurves: StandardCurveF2 :: Int -> Array U (Z :. Int) Bool -> Array U (Z :. Int) Bool -> Array U (Z :. Int) Bool -> Array U (Z :. Int) Bool -> Array U (Z :. Int) Bool -> StandardCurveF2
+ Codec.Crypto.ECC.StandardCurves: StandardCurveF2 :: Int -> F2 -> F2 -> F2 -> F2 -> F2 -> StandardCurveF2
- Codec.Crypto.ECC.StandardCurves: stdcF_a :: StandardCurveF2 -> Array U (Z :. Int) Bool
+ Codec.Crypto.ECC.StandardCurves: stdcF_a :: StandardCurveF2 -> F2
- Codec.Crypto.ECC.StandardCurves: stdcF_b :: StandardCurveF2 -> Array U (Z :. Int) Bool
+ Codec.Crypto.ECC.StandardCurves: stdcF_b :: StandardCurveF2 -> F2
- Codec.Crypto.ECC.StandardCurves: stdcF_p :: StandardCurveF2 -> Array U (Z :. Int) Bool
+ Codec.Crypto.ECC.StandardCurves: stdcF_p :: StandardCurveF2 -> F2
- Codec.Crypto.ECC.StandardCurves: stdcF_xp :: StandardCurveF2 -> Array U (Z :. Int) Bool
+ Codec.Crypto.ECC.StandardCurves: stdcF_xp :: StandardCurveF2 -> F2
- Codec.Crypto.ECC.StandardCurves: stdcF_yp :: StandardCurveF2 -> Array U (Z :. Int) Bool
+ Codec.Crypto.ECC.StandardCurves: stdcF_yp :: StandardCurveF2 -> F2

Files

COPYING view
@@ -1,4 +1,4 @@-Copyright (c) 20[09..10], Marcel Fourné+Copyright (c) 20[09..12], Marcel Fourné All rights reserved.  Redistribution and use in source and binary forms, with or without
hecc.cabal view
@@ -1,5 +1,5 @@ Name:                hecc-Version:             0.3.2+Version:             0.3.3 Synopsis:	     Elliptic Curve Cryptography for Haskell Description:         Pure math & algorithms for Elliptic Curve Cryptography in Haskell License:             BSD3@@ -19,17 +19,10 @@   src  Build-Depends:   base >= 4 && < 5,---  random,---  bytestring,---  binary,---  cereal,   crypto-api,-  repa == 3.0.*,-  vector+  hF2  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+  -Wall -O2 -fllvm -feager-blackholing
src/Codec/Crypto/ECC/Base.hs view
@@ -1,12 +1,16 @@-{-# LANGUAGE PatternGuards,TypeOperators,FlexibleInstances,DatatypeContexts #-}+----------------------------------------------------------------------------- -- | -- Module      :  Codec.Crypto.ECC.Base--- Copyright   :  (c) Marcel Fourné 20[09..10]+-- Copyright   :  (c) Marcel Fourné 20[09..12] -- License     :  BSD3 -- Maintainer  :  Marcel Fourné (hecc@bitrot.dyndns.org) -- -- ECC Base algorithms & point formats+-- +----------------------------------------------------------------------------- +{-# LANGUAGE PatternGuards #-}+ module Codec.Crypto.ECC.Base (ECP(..),                               EC(..),                               modinv, @@ -22,7 +26,6 @@                               p384point,                               p521point,                               ECPF2(..),-                              ECCNum(..),                               ECurve(..),                               ECSC(..),                               modinvF2K, @@ -40,9 +43,8 @@ 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+import qualified Data.F2 as F2  --  -- OLD Implementation, only for Integer@@ -291,7 +293,7 @@  -- binary representation of an integer -- taken from http://haskell.org/haskellwiki/Fibonacci_primes_in_parallel--- binary :: (Integral a) => a -> String +binary :: Integer -> String binary = flip (showIntAtBase 2 intToDigit) []  -- |generic verify, if generic ECP is on EC via getx and gety@@ -338,37 +340,20 @@ 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-  +              in pmulF2 x ((2^d)-2)+               -- | 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+  getA :: a -> F2.F2+  getB :: a -> F2.F2+  getP :: a -> F2.F2 +-- DATATYPECONTEXT, fix?! -- |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)+data ECSC = ECSC (F2.F2, F2.F2, F2.F2)         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+instance Show ECSC where show (ECSC (a,b,p)) = "y^2+x*y=x^3+" ++ show ((F2.toInteger a)::Integer) ++ "*x^2+" ++ show ((F2.toInteger b)::Integer) ++ " mod " ++ show ((F2.toInteger p)::Integer)+instance ECurve ECSC where   getA (ECSC (a,_,_)) = a   getB (ECSC (_,b,_)) = b   getP (ECSC (_,_,p)) = p@@ -382,21 +367,21 @@     -- |get bitlength     getBitLengthF2 :: a -> BitLength     -- |get contents of the curve-    getCurveF2 :: a -> ECSC (R.Array R.U R.DIM1 Bool)+    getCurveF2 :: a -> ECSC     -- |generic getter, returning the affine x-value-    getxF2 :: a -> R.Array R.U R.DIM1 Bool+    getxF2 :: a -> F2.F2     -- |generic getters, returning the affine y-value-    getyF2 :: a -> R.Array R.U R.DIM1 Bool+    getyF2 :: a -> F2.F2     -- |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) +data EPaF2 = EPaF2 (BitLength, ECSC, F2.F2, F2.F2)           | InfaF2            deriving (Eq)-instance Show EPaF2 where show (EPaF2 (a,b,c,d)) = show (a,b,((f2eToInteger c)::Integer),((f2eToInteger d)::Integer))+instance Show EPaF2 where show (EPaF2 (a,b,c,d)) = show (a,b,((F2.toInteger c)::Integer),((F2.toInteger d)::Integer))                           show InfaF2 = "Null" instance ECPF2 EPaF2 where      infF2 = InfaF2@@ -410,67 +395,67 @@     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+        let lambda = (x1 `F2.add` (y1 `F2.mul` (F2.bininv x1 p)))+            x3 = (lambda `F2.pow` (F2.fromInteger 2)) `F2.add` lambda `F2.add` alpha `F2.reduceBy` p+            y3 = (lambda `F2.mul` (x1 `F2.add` x3)) `F2.add` x3 `F2.add` y1 `F2.reduceBy` 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+        | ((F2.length x1 == F2.length x2) && (x1==x2)), (F2.length y1 == F2.length y2 && F2.length x2 == F2.length y2) && (y1==(x2 `F2.add` y2)) = InfaF2+        | (F2.length x1 == F2.length x2) && (F2.length y1 == F2.length 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+            let lambda = ((y1 `F2.add` y2) `F2.mul` (F2.bininv (x1 `F2.add` x2) p)) `F2.reduceBy` p+                x3 = ((lambda `F2.pow` (F2.fromInteger 2))  `F2.add` lambda `F2.add`  x1  `F2.add`  x2 `F2.add` alpha) `F2.reduceBy` p+                y3 = ((lambda `F2.mul` (x1 `F2.add` x3)) `F2.add` x3 `F2.add` y1) `F2.reduceBy` 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) +data EPpF2 = EPpF2 (BitLength, ECSC, F2.F2, F2.F2, F2.F2)           | 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))+instance Show EPpF2 where show (EPpF2 (a,b,c,d,e)) = show (a,b,((F2.toInteger c)::Integer),((F2.toInteger d)::Integer),((F2.toInteger 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 (EPaF2 (l,curve,a,b)) = EPpF2 (l,curve,a,b,F2.fromInteger 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 (EPpF2 (_,(ECSC (_,_,p)),x,_,z))= (x `F2.mul` (F2.bininv z p)) `F2.reduceBy` p     getxF2 InfpF2 = undefined-    getyF2 (EPpF2 (_,(ECSC (_,_,p)),_,y,z)) = (y `emul` (modinvF2 z p)) `emod` p+    getyF2 (EPpF2 (_,(ECSC (_,_,p)),_,y,z)) = (y `F2.mul` (F2.bininv z p)) `F2.reduceBy` 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+        let a = (x1 `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p+            b = (a `F2.add` (y1 `F2.mul` z1)) `F2.reduceBy` p+            c = (x1 `F2.mul` z1) `F2.reduceBy` p+            d = (c `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p+            e = ((b `F2.pow` (F2.fromInteger 2)) `F2.add` (b `F2.mul` c) `F2.add` (alpha `F2.mul` d)) `F2.reduceBy` p+            x3 = (c `F2.mul` e) `F2.reduceBy` p+            y3 = (((b `F2.add` c) `F2.mul` e) `F2.add` ((a `F2.pow` (F2.fromInteger 2)) `F2.mul` c)) `F2.reduceBy` p+            z3 = (c `F2.mul` d) `F2.reduceBy` 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+        | ((F2.length x1 == F2.length x2) && (x1==x2)),((F2.length y1 == F2.length y2 && F2.length x2 == F2.length y2) && y1==(x2 `F2.add` y2)) = InfpF2+        | (F2.length x1 == F2.length x2) && (F2.length y1 == F2.length 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+            let a = ((y1 `F2.mul` z2) `F2.add` (z1 `F2.mul` y2)) `F2.reduceBy` p+                b = ((x1 `F2.mul` z2)  `F2.add`  (z1 `F2.mul` x2)) `F2.reduceBy` p+                c = (x1 `F2.mul` z1) `F2.reduceBy` p+                d = (c `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p+                e = ((((a `F2.pow` (F2.fromInteger 2)) `F2.add` (a `F2.mul` b) `F2.add` (alpha `F2.mul` c)) `F2.mul` d) `F2.add` (b `F2.mul` c)) `F2.reduceBy` p+                x3 = (b `F2.mul` e) `F2.reduceBy` p+                y3 = (((c `F2.mul` ((a `F2.mul` x1) `F2.add` (y1 `F2.mul` b))) `F2.mul` z2) `F2.add` ((a `F2.add` b) `F2.mul` e)) `F2.reduceBy` p+                z3 = ((b `F2.pow` (F2.fromInteger 3)) `F2.mul` d) `F2.reduceBy` p             in if l==l' && curve==curve' then EPpF2 (l,curve,x3,y3,z3)                else undefined  @@ -484,7 +469,7 @@ montgladderF2 :: (ECPF2 a) => a -> Integer -> a montgladderF2 b k' =   let (ECSC (_,_,p)) = getCurveF2 b-      k = k' `mod` ((f2eToInteger p) - 1)+      k = k' `mod` ((F2.toInteger p) - 1)       ex p1 p2 i         | i < 0 = p1         | not (testBit k i) = ex (pdoubleF2 p1) (paddF2 p1 p2) (i - 1)@@ -497,7 +482,7 @@ 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+            in ((y `F2.pow` (F2.fromInteger 2)) `F2.add` (x `F2.mul` y)) `F2.reduceBy` p == ((x `F2.pow` (F2.fromInteger 3)) `F2.add` (alpha `F2.mul` (x `F2.pow` (F2.fromInteger 2))) `F2.add` beta) `F2.reduceBy` 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))
− src/Codec/Crypto/ECC/F2.hs
@@ -1,196 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Codec.Crypto.ECC.F2--- Copyright   :  (c) Marcel Fourné 2011--- License     :  BSD3--- Maintainer  :  Marcel Fourné (hecc@bitrot.dyndns.org)------ A parallelized 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'---- |a custom XOR for the "bits", True being 1 and False being 0-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--- | the power function, @b@ ^ @k@, atm only specialised for k in {2,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----- | a helper function to fill the representation of @a@ with "0" up towards a length of @n@-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---- | a helper function to shorten @a@ to length @n@-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-                   --- | a helper function to shorten all leading "0" from @a@-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)---- |the binary representation of an Integer-binary :: Integer -> String-binary = flip (showIntAtBase (2::Integer) intToDigit) []---- |conversion helper function-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---- |conversion helper function                      -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---- | test @k@ if bit on position @i@ is set-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)---- |helper function to get the length of @a@-f2eLen a = V.length $ toUnboxed a
src/Codec/Crypto/ECC/StandardCurves.hs view
@@ -9,12 +9,10 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE TypeOperators #-} module Codec.Crypto.ECC.StandardCurves     where -import Codec.Crypto.ECC.F2-import Data.Array.Repa as R+import qualified Data.F2 as F2  data StandardCurve = StandardCurve {stdc_l::Int,stdc_p::Integer,stdc_a::Integer,stdc_b::Integer,stdc_xp::Integer,stdc_yp::Integer} @@ -50,24 +48,24 @@          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}+data StandardCurveF2 = StandardCurveF2 {stdcF_l::Int,stdcF_p::F2.F2,stdcF_a::F2.F2,stdcF_b::F2.F2,stdcF_xp::F2.F2,stdcF_yp::F2.F2}  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+  stdcF_p = F2.fromInteger 15541351137805832567355695254588151253139254712417116170014499277911234281641667989665,+  stdcF_a = F2.fromInteger 0,+  stdcF_b = F2.fromInteger 1,+  stdcF_xp = F2.fromInteger 9737095673315832344313391497449387731784428326114441977662399932694280557468376967222,+  stdcF_yp = F2.fromInteger 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+  stdcF_p = F2.fromInteger 15541351137805832567355695254588151253139254712417116170014499277911234281641667989665,+  stdcF_a = F2.fromInteger 1,+  stdcF_b = F2.fromInteger 4821813576056072374006997780399081180312270030300601270120450341205914644378616963829,+  stdcF_xp = F2.fromInteger 11604587487407003699882500449177537465719784002620028212980871291231978603047872962643,+  stdcF_yp = F2.fromInteger 6612720053854191978412609357563545875491153188501906352980899759345275170452624446196   }
src/bench.hs view
@@ -9,10 +9,9 @@ -- ----------------------------------------------------------------------------- import Codec.Crypto.ECC.Base-import Codec.Crypto.ECC.F2 -- import Data.Array.Repa -- import Examples-import Codec.Crypto.ECC.StandardCurves+-- import Codec.Crypto.ECC.StandardCurves -- import Control.Monad.Random -- import Char @@ -41,7 +40,8 @@     let p = b283point::EPaF2 --        k' = 115792089210356248762697446949407573529996955224135760342422259061068512044368 --        k' = 2-        k' = 3+--        k' = 3+        k' = 2^20 --    print p --    print (pdoubleF2 p) --    print $ modinvF2 (f2eFromInteger 4) (f2eFromInteger 7)