module Crypto.F2 ( F2(..)
, eq
, add
, addr
, shift
, mul
, mulr
, testBit
, redc
, square
, pow
, inv
, fromInteger
, toInteger
)
where
import Prelude (Eq,Show,(==),(&&),Integer,Int,show,Bool(False,True),(++),($),fail,undefined,(+),(),(*),(^),mod,Integral,otherwise,(<),div,not,String,flip,takeWhile,length,iterate,(>),(<=),(>=),maxBound,rem,quot,quotRem,error,(.),max,map,foldl,compare,Ordering(..))
import qualified Prelude as P (toInteger,fromInteger)
import qualified Data.Bits as B (Bits(..),testBit)
import Data.Typeable(Typeable)
import qualified Data.Vector.Unboxed as V
import qualified Data.Word as W (Word)
import Crypto.Common
data F2 = F2 !Int !(V.Vector W.Word)
deriving (Show,Typeable)
eq :: F2 -> F2 -> Bool
eq (F2 la va) (F2 lb vb) = (la == lb) && V.all (== True) (V.zipWith (==) va vb)
add :: F2 -> F2 -> F2
add (F2 la va) (F2 lb vb)
| V.length va == V.length vb = F2 (if la>=lb then la else lb) $ V.zipWith B.xor va vb
| la > lb = let veclendiff = sizeinWords la V.length vb
in F2 la $ V.zipWith B.xor va (vb V.++ V.replicate veclendiff 0)
| otherwise = let veclendiff = sizeinWords lb V.length va
in F2 lb $ V.zipWith B.xor (va V.++ V.replicate veclendiff 0) vb
addr :: F2 -> F2 -> F2 -> F2
addr p a b = redc p $ add a b
shift :: F2 -> Int -> F2
shift (F2 !la !va) !i =
let newbits = la + i
newlen = sizeinWords newbits
realshift = i `rem` wordSize
wordshift = i `quot` wordSize
svec = case compare realshift 0 of
GT -> V.replicate wordshift (0::W.Word) V.++ V.map (`B.shift` realshift) va V.++ zero wordSize
EQ -> V.replicate wordshift (0::W.Word) V.++ va
LT -> V.replicate wordshift (0::W.Word) V.++ V.map (`B.shift` realshift) va
svecr = case compare realshift 0 of
GT -> V.replicate wordshift (0::W.Word) V.++ zero wordSize V.++ V.map (`B.shift` ((wordSize realshift))) va
EQ -> V.replicate wordshift (0::W.Word) V.++ zero la
LT -> V.drop 1 $ V.replicate wordshift (0::W.Word) V.++ (V.map (`B.shift` (wordSize + realshift)) va V.++ zero wordSize)
vec = V.zipWith B.xor svec svecr
in if newbits >= 1
then F2 newbits $ V.take newlen vec
else F2 1 $ V.singleton 0
findindex :: Int -> (Int,Int)
findindex i = i `quotRem` wordSize
testBit :: F2 -> Int -> Bool
testBit (F2 !la !va) !i = (i < la) && (let (index1,index2) = findindex i
in (index1 < V.length va) && B.testBit ((V.!) va index1) index2
)
bleachupper :: Int -> F2 -> F2
bleachupper l (F2 _ v) = let (_,ix2) = findindex (l 1)
in F2 l $ V.take (sizeinWords l 1) v V.++ (V.singleton $ B.shift (B.shift (V.last v) (wordSize (ix2 + 1))) ((wordSize (ix2 + 1))))
redc :: F2 -> F2 -> F2
redc m@(F2 !lm _) f@(F2 !lf _)
| lf >= lm = let null = F2 lm $ zero lm
fun f' i
| i < lm = bleachupper lm f'
| testBit f' (i 1) = fun (add (shift m (i lm)) f') (i 1)
| otherwise = fun (add (shift null (i lm)) f') (i 1)
in fun f lf
| otherwise = bleachupper lm f
mul :: F2 -> F2 -> F2
mul a@(F2 la _) b@(F2 lb _) =
let nullen = F2 (2*la) (zero $ 2*la)
pseudo = F2 lb (zero lb)
fun i b1 | i < la = fun (i + 1) (add b1 (if testBit a i
then shift b i
else shift pseudo i
)
)
| otherwise = b1
in fun 0 nullen
mulr :: F2 -> F2 -> F2 -> F2
mulr p a b = redc p $ mul a b
square :: F2 -> F2
square a = mul a a
pow :: (B.Bits a, Integral a) => F2 -> F2 -> a -> F2
pow !p !a !k | k <= 0 = error "non-positive exponent for the power function on F2"
| otherwise =
let binlog = log2len k
ex p1 p2 i
| i < 0 = p1
| not (B.testBit k i) = ex (redc p $ square p1) (redc p $ mul p1 p2) (i 1)
| otherwise = ex (redc p $ mul p1 p2) (redc p $ square p2) (i 1)
in ex a (redc p $ square a) (binlog 2)
inv :: F2 -> F2 -> F2
inv p a = pow p a (toInteger p 2)
fromInteger :: Int -> Integer -> F2
fromInteger l !i =
let i' = i `rem` (2^l)
binlog = log2len i'
helper a =
if a <= wordMax
then V.singleton $ P.fromInteger a
else let (d,rest) = quotRem a (wordMax + 1)
in V.singleton (P.fromInteger rest) V.++ helper d
filler b = if binlog == l
then helper b
else let lendiff = sizeinWords l sizeinWords binlog
in helper b V.++ V.replicate lendiff 0
in F2 l (filler i')
toInteger :: F2 -> Integer
toInteger (F2 !la !va) =
if la <= wordSize
then P.toInteger $ V.head va
else let len = V.length va
helper r z i =
if i > 1
then helper (V.tail r) (z + B.shift (P.toInteger $ V.head r) ((len i) * wordSize)) (i 1)
else z + B.shift (P.toInteger $ V.head r) ((len i) * wordSize)
in helper va 0 len