{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ViewPatterns #-}
module Pairing.Fq
( Fq
, Fq2
, Fq6
, Fq12
, fqSqrt
, fq2Sqrt
, fqYforX
, fq2YforX
, fqNqr
, xi
, mulXi
, fq2Conj
, fq2ScalarMul
, construct
, deconstruct
, fq12Conj
, fq12Frobenius
) where
import Protolude
import Data.ByteString as B (splitAt, length)
import ExtensionField (ExtensionField, IrreducibleMonic(..), fromField, fromList, t, x)
import GaloisField (GaloisField(..))
import Math.NumberTheory.Moduli.Class (powMod)
import PrimeField (PrimeField, toInt)
import Pairing.ByteRepr
import Pairing.CyclicGroup
import Pairing.Modular
import Pairing.Params
type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583
data PolynomialU
instance IrreducibleMonic Fq PolynomialU where
split _ = x^2 + 1
type Fq2 = ExtensionField Fq PolynomialU
data PolynomialV
instance IrreducibleMonic Fq2 PolynomialV where
split _ = x^3 - (9 + t x)
type Fq6 = ExtensionField Fq2 PolynomialV
data PolynomialW
instance IrreducibleMonic Fq6 PolynomialW where
split _ = x^2 - t x
type Fq12 = ExtensionField Fq6 PolynomialW
instance Ord Fq where
compare = on compare toInt
instance Ord Fq2 where
compare = on compare fromField
instance FromX Fq where
yFromX = fqYforX
isOdd y = odd (toInt y)
instance FromX Fq2 where
yFromX = fq2YforX
isOdd a = case fromField a of
(x : xs) -> isOdd x
[] -> False
instance ByteRepr Fq where
mkRepr bo = toPaddedBytes bo <$> toInt
fromRepr bo _ bs = Just (fromInteger (fromBytesToInteger (byteOrder bo) bs))
calcReprLength _ n = n
instance ByteRepr Fq2 where
mkRepr bo f2 = do
bites <- fq2Bytes f2
(foldl' (<>) mempty . map (mkRepr bo)) bites
fromRepr bo fq2 bs = do
let
blen = calcReprLength (1 :: Fq) $ lenPerElement bo
(xbs, ybs) = B.splitAt blen bs
x <- fromRepr bo (1 :: Fq) xbs
y <- fromRepr bo (1 :: Fq) ybs
return (fromList [x, y])
calcReprLength _ n = 2 * calcReprLength (1 :: Fq) n
instance ByteRepr Fq6 where
mkRepr bo f6 = do
bites <- fq6Bytes f6
(foldl' (<>) mempty . map (mkRepr bo)) bites
fromRepr bo fq6 bs = do
let
blen = calcReprLength (1 :: Fq2) $ lenPerElement bo
(xbs, yzbs) = B.splitAt blen bs
(ybs, zbs) = B.splitAt blen yzbs
x <- fromRepr bo (1 :: Fq2) xbs
y <- fromRepr bo (1 :: Fq2) ybs
z <- fromRepr bo (1 :: Fq2) zbs
return (fromList [x, y, z])
calcReprLength _ n = 3 * calcReprLength (1 :: Fq2) n
instance ByteRepr Fq12 where
mkRepr bo f12= do
bites <- fq12Bytes f12
(foldl' (<>) mempty . map (mkRepr bo)) bites
fromRepr bo fq12 bs = do
let
blen = calcReprLength (1 :: Fq6) $ lenPerElement bo
(xbs, ybs) = B.splitAt blen bs
x <- fromRepr bo (1 :: Fq6) xbs
y <- fromRepr bo (1 :: Fq6) ybs
return (fromList [x, y])
calcReprLength _ n = 2 * calcReprLength (1 :: Fq6) n
fqSqrt :: (Fq -> Fq -> Fq) -> Fq -> Maybe Fq
fqSqrt ysel a = case withQM (modUnOpMTup (toInt a) bothSqrtOf) of
Just (y1, y2) -> Just (ysel (fromInteger y1) (fromInteger y2))
Nothing -> Nothing
fq2Sqrt :: Fq2 -> Maybe Fq2
fq2Sqrt a = do
let a1 = pow a qm3by4
let alpha = pow a1 2 * a
let a0 = pow alpha _q * alpha
if a0 == -1 then Nothing else do
let x0 = a1 * a
if alpha == -1 then Just (a1 * fromList [0, 1]) else do
let b = pow (alpha + 1) qm1by2
Just (b * x0)
where
qm3by4 = withQ (modBinOp (_q -3) 4 (/))
qm1by2 = withQ (modBinOp (_q -1) 2 (/))
fqYforX :: Fq -> (Fq -> Fq -> Fq) -> Maybe Fq
fqYforX x ysel = fqSqrt ysel (pow x 3 + fromInteger _b)
fq2YforX :: Fq2 -> (Fq2 -> Fq2 -> Fq2) -> Maybe Fq2
fq2YforX x ly = do
y <- newy
pure (ly y (negate y))
where
newy = fq2Sqrt (pow x 3 + fromInteger _b / xi)
fqNqr :: Fq
fqNqr = fromInteger _nqr
{-# INLINE fqNqr #-}
xi :: Fq2
xi = fromList [fromInteger _xiA, fromInteger _xiB]
mulXi :: Fq6 -> Fq6
mulXi w = case fromField w of
[x, y, z] -> fromList [z * xi, x, y]
[x, y] -> fromList [0, x, y]
[x] -> fromList [0, x]
[] -> fromList []
_ -> panic "mulXi not exhaustive."
{-# INLINE mulXi #-}
fq2Bytes :: Fq2 -> Maybe [Fq]
fq2Bytes w = case fromField w of
[x, y] -> Just [x, y]
[x] -> Just [x, 0]
[] -> Just [0, 0]
_ -> Nothing
fq6Bytes :: Fq6 -> Maybe [Fq2]
fq6Bytes w = case fromField w of
[x, y, z] -> Just [x, y, z]
[x, y] -> Just [x, y, 0]
[x] -> Just [x, 0, 0]
[] -> Just [0, 0, 0]
_ -> Nothing
fq12Bytes :: Fq12 -> Maybe [Fq6]
fq12Bytes w = case fromField w of
[x, y] -> Just [x, y]
[x] -> Just [x, 0]
[] -> Just [0, 0]
_ -> Nothing
fq2Conj :: Fq2 -> Fq2
fq2Conj x = case fromField x of
[y, z] -> fromList [y, -z]
[y] -> fromList [y]
[] -> 0
_ -> panic "fq2Conj not exhaustive."
fq2ScalarMul :: Fq -> Fq2 -> Fq2
fq2ScalarMul a x = fromList [a] * x
fq12Conj :: Fq12 -> Fq12
fq12Conj x = case fromField x of
[y, z] -> fromList [y, -z]
[y] -> fromList [y]
[] -> 0
_ -> panic "fq12Conj not exhaustive."
construct :: [Fq] -> Fq12
construct [a, b, c, d, e, f, g, h, i, j, k, l] = fromList
[ fromList [fromList [a, b], fromList [c, d], fromList [e, f]]
, fromList [fromList [g, h], fromList [i, j], fromList [k, l]] ]
construct _ = panic "Invalid arguments to fq12"
deconstruct :: Fq12 -> [Fq]
deconstruct = concatMap fromField . concatMap fromField . fromField
fq12Frobenius :: Int -> Fq12 -> Fq12
fq12Frobenius i a
| i == 0 = a
| i == 1 = fastFrobenius a
| i > 1 = let prev = fq12Frobenius (i - 1) a
in fastFrobenius prev
| otherwise = panic "fq12Frobenius not defined for negative values of i"
fastFrobenius :: Fq12 -> Fq12
fastFrobenius = collapse . convert [[0,2,4],[1,3,5]] . conjugate
where
conjugate :: Fq12 -> [[Fq2]]
conjugate = map (map fq2Conj . fromField) . fromField
convert :: [[Integer]] -> [[Fq2]] -> [[Fq2]]
convert = zipWith (zipWith (\x y -> pow xi ((x * (_q - 1)) `div` 6) * y))
collapse :: [[Fq2]] -> Fq12
collapse = fromList . map fromList