{-# LANGUAGE TemplateHaskell #-}

-- TODO

-- Taking square roots and quadratic residuosity tests supported as well.

-- Moreover, (multidimensional) arrays over finite fields are available

-- with operators +,-,*,/ for convenient and efficient NumPy-based

-- vectorized processing next to operator @ for matrix multiplication.

-- Much of the NumPy API can be used to manipulate these arrays as well.


{- |
This module supports finite (Galois) fields.

Function 'gf' creates types implementing finite fields.
-}
module FinFields (FiniteField(..), FiniteFieldMeta(..), gf, toBytes, fromBytes) where

import Hgmp as Hgmp
import Data.Bits
import qualified Data.ByteString as B
import Data.List.Split


-- | Instantiate an object from a field and subsequently apply overloaded

-- operators such as @('+')@, @('-')@, @('*')@, @('/')@ etc., to compute with field elements.

data FiniteField =  FiniteField {FiniteField -> FiniteFieldMeta
meta :: FiniteFieldMeta, FiniteField -> Integer
value :: Integer} 
                    | Literal {value :: Integer} deriving Int -> FiniteField -> ShowS
[FiniteField] -> ShowS
FiniteField -> String
(Int -> FiniteField -> ShowS)
-> (FiniteField -> String)
-> ([FiniteField] -> ShowS)
-> Show FiniteField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FiniteField -> ShowS
showsPrec :: Int -> FiniteField -> ShowS
$cshow :: FiniteField -> String
show :: FiniteField -> String
$cshowList :: [FiniteField] -> ShowS
showList :: [FiniteField] -> ShowS
Show
data FiniteFieldMeta = FiniteFieldMeta {FiniteFieldMeta -> Integer
modulus :: Integer, FiniteFieldMeta -> Int
byteLength :: Int} deriving Int -> FiniteFieldMeta -> ShowS
[FiniteFieldMeta] -> ShowS
FiniteFieldMeta -> String
(Int -> FiniteFieldMeta -> ShowS)
-> (FiniteFieldMeta -> String)
-> ([FiniteFieldMeta] -> ShowS)
-> Show FiniteFieldMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FiniteFieldMeta -> ShowS
showsPrec :: Int -> FiniteFieldMeta -> ShowS
$cshow :: FiniteFieldMeta -> String
show :: FiniteFieldMeta -> String
$cshowList :: [FiniteFieldMeta] -> ShowS
showList :: [FiniteFieldMeta] -> ShowS
Show


-- TODO: irreducible polynomial, also creates corresponding array type.

-- | Create a finite (Galois) field for given modulus (prime number).

gf :: Integer -> FiniteField
gf :: Integer -> FiniteField
gf Integer
modulus = let byteLength :: Int
byteLength = ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> (Integer -> Double) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Integer
modulus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
                in FiniteField{meta :: FiniteFieldMeta
meta = FiniteFieldMeta {modulus :: Integer
modulus = Integer
modulus, byteLength :: Int
byteLength = Int
byteLength}}

-- | Multiplicative inverse, Division.

instance Fractional FiniteField where
    recip :: FiniteField -> FiniteField
recip FiniteField
a = FiniteField
a{value = Hgmp.invert (value a) (modulus $ meta a)}
    / :: FiniteField -> FiniteField -> FiniteField
(/) FiniteField
a FiniteField
b = FiniteField
a FiniteField -> FiniteField -> FiniteField
forall a. Num a => a -> a -> a
* FiniteField -> FiniteField
forall a. Fractional a => a -> a
recip (case FiniteField
b of Literal Integer
val -> FiniteField
a{value = val}; FiniteField
_ -> FiniteField
b)

-- | Equality test.

instance Eq FiniteField where
    == :: FiniteField -> FiniteField -> Bool
(==) FiniteField
f1 FiniteField
f2 = (FiniteField -> Integer
value FiniteField
f1) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (FiniteField -> Integer
value FiniteField
f2)

-- | Addition, Subtraction, Multiplication.

instance Num FiniteField where
    + :: FiniteField -> FiniteField -> FiniteField
(+) = (Integer -> Integer -> Integer)
-> FiniteField -> FiniteField -> FiniteField
_applyOpFF Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
    (-) = (Integer -> Integer -> Integer)
-> FiniteField -> FiniteField -> FiniteField
_applyOpFF (-)
    * :: FiniteField -> FiniteField -> FiniteField
(*) = (Integer -> Integer -> Integer)
-> FiniteField -> FiniteField -> FiniteField
_applyOpFF Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)
    fromInteger :: Integer -> FiniteField
fromInteger Integer
a = Integer -> FiniteField
Literal Integer
a

_applyOpFF :: (Integer -> Integer -> Integer) -> FiniteField -> FiniteField -> FiniteField
_applyOpFF :: (Integer -> Integer -> Integer)
-> FiniteField -> FiniteField -> FiniteField
_applyOpFF Integer -> Integer -> Integer
f (FiniteField FiniteFieldMeta
meta Integer
val1) (FiniteField FiniteFieldMeta
_ Integer
val2) = FiniteFieldMeta -> Integer -> FiniteField
_makeFF FiniteFieldMeta
meta (Integer -> Integer -> Integer
f Integer
val1 Integer
val2)
_applyOpFF Integer -> Integer -> Integer
f (FiniteField FiniteFieldMeta
meta Integer
val1) (Literal Integer
val2) = FiniteFieldMeta -> Integer -> FiniteField
_makeFF FiniteFieldMeta
meta (Integer -> Integer -> Integer
f Integer
val1 Integer
val2)
_applyOpFF Integer -> Integer -> Integer
f (Literal Integer
val1) (FiniteField FiniteFieldMeta
meta Integer
val2) = FiniteFieldMeta -> Integer -> FiniteField
_makeFF FiniteFieldMeta
meta (Integer -> Integer -> Integer
f Integer
val1 Integer
val2)
_applyOpFF Integer -> Integer -> Integer
f (Literal Integer
val1) (Literal Integer
val2) = Integer -> FiniteField
Literal (Integer -> Integer -> Integer
f Integer
val1 Integer
val2)

_makeFF :: FiniteFieldMeta -> Integer -> FiniteField
_makeFF :: FiniteFieldMeta -> Integer -> FiniteField
_makeFF FiniteFieldMeta
meta Integer
val = FiniteFieldMeta -> Integer -> FiniteField
FiniteField FiniteFieldMeta
meta (Integer
val Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` FiniteFieldMeta -> Integer
modulus FiniteFieldMeta
meta)

-- | Return byte string representing the given list/ndarray of integers x.

toBytes :: Int -> [Integer] -> B.ByteString
toBytes :: Int -> [Integer] -> ByteString
toBytes Int
byteLength [Integer]
x = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> [Word8]) -> [Integer] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Integer
a -> (Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Integer
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xFF)) [Int
0..Int
byteLengthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) [Integer]
x

-- | Return the list of integers represented by the given byte string.

fromBytes :: Int -> B.ByteString -> [Integer]
fromBytes :: Int -> ByteString -> [Integer]
fromBytes Int
n ByteString
bytes = ([Word8] -> Integer) -> [[Word8]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ((Word8 -> Integer -> Integer) -> Integer -> [Word8] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> Integer -> Integer
forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a
unstep Integer
0) (Int -> [Word8] -> [[Word8]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
n ([Word8] -> [[Word8]]) -> [Word8] -> [[Word8]]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
bytes)
  where
    unstep :: a -> a -> a
unstep a
b a
a = a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b