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 +1/−1
- hecc.cabal +3/−10
- src/Codec/Crypto/ECC/Base.hs +55/−70
- src/Codec/Crypto/ECC/F2.hs +0/−196
- src/Codec/Crypto/ECC/StandardCurves.hs +12/−14
- src/bench.hs +3/−3
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)