diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -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 diff --git a/hecc.cabal b/hecc.cabal --- a/hecc.cabal +++ b/hecc.cabal @@ -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 diff --git a/src/Codec/Crypto/ECC/Base.hs b/src/Codec/Crypto/ECC/Base.hs --- a/src/Codec/Crypto/ECC/Base.hs +++ b/src/Codec/Crypto/ECC/Base.hs @@ -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)) diff --git a/src/Codec/Crypto/ECC/F2.hs b/src/Codec/Crypto/ECC/F2.hs deleted file mode 100644 --- a/src/Codec/Crypto/ECC/F2.hs +++ /dev/null @@ -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 diff --git a/src/Codec/Crypto/ECC/StandardCurves.hs b/src/Codec/Crypto/ECC/StandardCurves.hs --- a/src/Codec/Crypto/ECC/StandardCurves.hs +++ b/src/Codec/Crypto/ECC/StandardCurves.hs @@ -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 } diff --git a/src/bench.hs b/src/bench.hs --- a/src/bench.hs +++ b/src/bench.hs @@ -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)