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 == c' = c Prelude.== c'
bxor :: Bool -> Bool -> Bool
bxor a b | a Prelude.== False = b
| a Prelude.== True = not b
| otherwise = undefined
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
f2eBitshift :: Array U DIM1 Bool -> Int -> Array U DIM1 Bool
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))
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
then fun (V.tail a) (f2eAdd b (fillTo (f2eBitshift a2 ltemp) lz))
else fun (V.tail a) (f2eAdd b (fillTo (f2eBitshift pseudo ltemp) lz))
| otherwise = b
in elimFalses $ fun (toUnboxed $ fillTo a1 l) nullen
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
then fun (V.tail (V.zipWith (bxor) z (toUnboxed $ fillTo (f2eBitshift r (ltemplr)) ltemp)))
else fun (V.tail (V.zipWith (bxor) z (toUnboxed $ fillTo (f2eBitshift pseudo (ltemplr)) ltemp)))
| otherwise = z
ergtemp = fun va
pre = fromUnboxed (Z :. (V.length) ergtemp) ergtemp
in elimFalses pre
f2ePow :: Array U DIM1 Bool -> Integer -> Array U DIM1 Bool
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 (nl) 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^(len1))
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
modinvF2 :: Array U DIM1 Bool
-> Array U DIM1 Bool
-> Array U DIM1 Bool
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