module Crypto.Number.F2m (
BinaryPolynomial,
addF2m,
mulF2m,
squareF2m',
squareF2m,
powF2m,
modF2m,
sqrtF2m,
invF2m,
divF2m,
quadraticF2m,
) where
import Crypto.Internal.WordArray
import Crypto.Number.Basic
import Data.Bits (
setBit,
shift,
shiftL,
shiftR,
testBit,
unsafeShiftR,
xor,
(.&.),
(.|.),
)
import qualified Data.List as L
import Data.Word (Word32)
type BinaryPolynomial = Integer
addF2m
:: Integer
-> Integer
-> Integer
addF2m :: Integer -> Integer -> Integer
addF2m = Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
xor
{-# INLINE addF2m #-}
modF2m
:: BinaryPolynomial
-> Integer
-> Integer
modF2m :: Integer -> Integer -> Integer
modF2m Integer
fx Integer
i
| Integer
fx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 =
[Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"modF2m: negative number represent no binary polynomial"
| Integer
fx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"modF2m: cannot divide by zero polynomial"
| Integer
fx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer
0
| Bool
otherwise = case Integer -> Maybe [Int]
tailExponents Integer
fx of
Just [Int]
es -> [Int] -> Integer -> Integer
forall {t :: * -> *}. Foldable t => t Int -> Integer -> Integer
fold [Int]
es Integer
i
Maybe [Int]
Nothing -> Integer -> Integer
go Integer
i
where
lfx :: Int
lfx = Integer -> Int
log2 Integer
fx
go :: Integer -> Integer
go Integer
n
| Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer
n Integer -> Integer -> Integer
`addF2m` Integer
fx
| Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Integer
n
| Bool
otherwise = Integer -> Integer
go (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
`addF2m` Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
fx Int
s
where
s :: Int
s = Integer -> Int
log2 Integer
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lfx
mask :: Integer
mask = (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
lfx) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
fold :: t Int -> Integer -> Integer
fold t Int
es Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mask = Integer
n
| Bool
otherwise =
t Int -> Integer -> Integer
fold
t Int
es
((Integer -> Int -> Integer) -> Integer -> t Int -> Integer
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\Integer
acc Int
e -> Integer
acc Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` (Integer
hi Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
e)) (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask) t Int
es)
where
hi :: Integer
hi = Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
lfx
{-# INLINE modF2m #-}
tailExponents :: BinaryPolynomial -> Maybe [Int]
tailExponents :: Integer -> Maybe [Int]
tailExponents Integer
fx = Int -> Int -> [Int] -> Maybe [Int]
go (Integer -> Int
log2 Integer
fx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0 []
where
go :: Int -> Int -> [Int] -> Maybe [Int]
go Int
i Int
n [Int]
acc
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int]
acc
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
16 = Maybe [Int]
forall a. Maybe a
Nothing
| Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
fx Int
i = Int -> Int -> [Int] -> Maybe [Int]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int) (Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc)
| Bool
otherwise = Int -> Int -> [Int] -> Maybe [Int]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
n [Int]
acc
mulF2m
:: BinaryPolynomial
-> Integer
-> Integer
-> Integer
mulF2m :: Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
n1 Integer
n2
| Integer
fx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
Bool -> Bool -> Bool
|| Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
Bool -> Bool -> Bool
|| Integer
n2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 =
[Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"mulF2m: negative number represent no binary polynomial"
| Integer
fx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"mulF2m: cannot multiply modulo zero polynomial"
| Bool
otherwise = Integer -> Integer -> Integer
modF2m Integer
fx (Integer -> Int -> Integer -> Integer
forall {a}. (Num a, Bits a) => a -> Int -> Integer -> Integer
go Integer
n2 Int
0 Integer
0)
where
go :: a -> Int -> Integer -> Integer
go a
0 Int
_ Integer
acc = Integer
acc
go a
v Int
sh Integer
acc =
a -> Int -> Integer -> Integer
go (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) (Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Integer
acc Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` (a -> Integer
forall {a}. (Eq a, Num a) => a -> Integer
multiple (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xf) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
sh))
m2 :: Integer
m2 = Integer
n1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
m4 :: Integer
m4 = Integer
n1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
m8 :: Integer
m8 = Integer
n1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
m3 :: Integer
m3 = Integer
m2 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
m5 :: Integer
m5 = Integer
m4 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
m6 :: Integer
m6 = Integer
m4 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
m2
m7 :: Integer
m7 = Integer
m6 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
m9 :: Integer
m9 = Integer
m8 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
m10 :: Integer
m10 = Integer
m8 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
m2
m11 :: Integer
m11 = Integer
m10 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
m12 :: Integer
m12 = Integer
m8 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
m4
m13 :: Integer
m13 = Integer
m12 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
m14 :: Integer
m14 = Integer
m12 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
m2
m15 :: Integer
m15 = Integer
m14 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
n1
multiple :: a -> Integer
multiple a
1 = Integer
n1
multiple a
2 = Integer
m2
multiple a
3 = Integer
m3
multiple a
4 = Integer
m4
multiple a
5 = Integer
m5
multiple a
6 = Integer
m6
multiple a
7 = Integer
m7
multiple a
8 = Integer
m8
multiple a
9 = Integer
m9
multiple a
10 = Integer
m10
multiple a
11 = Integer
m11
multiple a
12 = Integer
m12
multiple a
13 = Integer
m13
multiple a
14 = Integer
m14
multiple a
15 = Integer
m15
multiple a
_ = Integer
0
{-# INLINEABLE mulF2m #-}
squareF2m
:: BinaryPolynomial
-> Integer
-> Integer
squareF2m :: Integer -> Integer -> Integer
squareF2m Integer
fx = Integer -> Integer -> Integer
modF2m Integer
fx (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
squareF2m'
{-# INLINE squareF2m #-}
squareF2m'
:: Integer
-> Integer
squareF2m' :: Integer -> Integer
squareF2m' Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"mulF2m: negative number represent no binary polynomial"
| Bool
otherwise = Integer -> Int -> Integer -> Integer
forall {a} {t}.
(Bits a, Bits t, Num t, Integral a) =>
a -> Int -> t -> t
go Integer
n Int
0 Integer
0
where
go :: a -> Int -> t -> t
go a
0 Int
_ t
acc = t
acc
go a
v Int
sh t
acc =
a -> Int -> t -> t
go
(a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
(Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16)
( t
acc
t -> t -> t
forall a. Bits a => a -> a -> a
.|. (Word32 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array32 -> Int -> Word32
arrayRead32 Array32
spreadTable (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xff))) t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
sh)
)
spreadTable :: Array32
spreadTable :: Array32
spreadTable = Int -> [Word32] -> Array32
array32 Int
256 [Int -> Word32
spread Int
b | Int
b <- [Int
0 .. Int
255]]
where
spread :: Int -> Word32
spread :: Int -> Word32
spread Int
b =
(Word32 -> Int -> Word32) -> Word32 -> [Int] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\Word32
acc Int
i -> if Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
b Int
i then Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
setBit Word32
acc (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) else Word32
acc) Word32
0 [Int
0 .. Int
7]
{-# NOINLINE spreadTable #-}
{-# INLINE squareF2m' #-}
powF2m
:: BinaryPolynomial
-> Integer
-> Integer
-> Integer
powF2m :: Integer -> Integer -> Integer -> Integer
powF2m Integer
fx Integer
a Integer
b
| Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"powF2m: negative exponents disallowed"
| Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = if Integer
fx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 then Integer
1 else Integer
0
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
b = Integer -> Integer -> Integer
squareF2m Integer
fx Integer
x
| Bool
otherwise = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
a (Integer -> Integer
squareF2m' Integer
x)
where
x :: Integer
x = Integer -> Integer -> Integer -> Integer
powF2m Integer
fx Integer
a (Integer
b Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2)
sqrtF2m
:: BinaryPolynomial
-> Integer
-> Integer
sqrtF2m :: Integer -> Integer -> Integer
sqrtF2m Integer
fx Integer
a = Int -> Integer -> Integer
forall {t}. (Eq t, Num t) => t -> Integer -> Integer
go (Integer -> Int
log2 Integer
fx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Integer
a
where
go :: t -> Integer -> Integer
go t
0 Integer
x = Integer
x
go t
n Integer
x = t -> Integer -> Integer
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Integer -> Integer -> Integer
squareF2m Integer
fx Integer
x)
gcdF2m
:: Integer
-> Integer
-> (Integer, Integer, Integer)
gcdF2m :: Integer -> Integer -> (Integer, Integer, Integer)
gcdF2m Integer
a Integer
b = (Integer, Integer, Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer)
go (Integer
a, Integer
b, Integer
1, Integer
0, Integer
0, Integer
1)
where
go :: (Integer, Integer, Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer)
go (Integer
g, Integer
0, Integer
u, Integer
_, Integer
v, Integer
_) =
(Integer
g, Integer
u, Integer
v)
go (Integer
r0, Integer
r1, Integer
s0, Integer
s1, Integer
t0, Integer
t1) =
(Integer, Integer, Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer)
go
( Integer
r1
, Integer
r0 Integer -> Integer -> Integer
`addF2m` Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
r1 Int
j
, Integer
s1
, Integer
s0 Integer -> Integer -> Integer
`addF2m` Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
s1 Int
j
, Integer
t1
, Integer
t0 Integer -> Integer -> Integer
`addF2m` Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
t1 Int
j
)
where
j :: Int
j = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Integer -> Int
log2 Integer
r0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
log2 Integer
r1)
invF2m
:: BinaryPolynomial
-> Integer
-> Maybe Integer
invF2m :: Integer -> Integer -> Maybe Integer
invF2m Integer
fx Integer
n = if Integer
g Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Integer -> Integer
modF2m Integer
fx Integer
u) else Maybe Integer
forall a. Maybe a
Nothing
where
(Integer
g, Integer
u, Integer
_) = Integer -> Integer -> (Integer, Integer, Integer)
gcdF2m Integer
n Integer
fx
{-# INLINEABLE invF2m #-}
divF2m
:: BinaryPolynomial
-> Integer
-> Integer
-> Maybe Integer
divF2m :: Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx Integer
n1 Integer
n2 = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
n1 (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Maybe Integer
invF2m Integer
fx Integer
n2
{-# INLINE divF2m #-}
traceF2m :: BinaryPolynomial -> Integer -> Integer
traceF2m :: Integer -> Integer -> Integer
traceF2m Integer
fx = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
addF2m Integer
0 ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
log2 Integer
fx) ([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
squareF2m Integer
fx)
{-# INLINE traceF2m #-}
halfTraceF2m :: BinaryPolynomial -> Integer -> Integer
halfTraceF2m :: Integer -> Integer -> Integer
halfTraceF2m Integer
fx =
(Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
addF2m Integer
0
([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Integer -> Int
log2 Integer
fx Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1)
([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
squareF2m Integer
fx (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
squareF2m Integer
fx)
{-# INLINE halfTraceF2m #-}
quadraticF2m :: BinaryPolynomial -> Integer -> Maybe Integer
quadraticF2m :: Integer -> Integer -> Maybe Integer
quadraticF2m Integer
fx Integer
a
| Integer -> Integer -> Integer
traceF2m Integer
fx Integer
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
halfTraceF2m Integer
fx Integer
a
| Bool
otherwise = Maybe Integer
forall a. Maybe a
Nothing
{-# INLINEABLE quadraticF2m #-}