{-# 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, toField,
pattern X, pattern X2, pattern X3, pattern Y)
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 _ = X2 + 1
type Fq2 = ExtensionField Fq PolynomialU
data PolynomialV
instance IrreducibleMonic Fq2 PolynomialV where
split _ = X3 - (9 + Y X)
type Fq6 = ExtensionField Fq2 PolynomialV
data PolynomialW
instance IrreducibleMonic Fq6 PolynomialW where
split _ = X2 - Y X
type Fq12 = ExtensionField Fq6 PolynomialW
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 (toField [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 (toField [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 (toField [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 * toField [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 = toField [fromInteger _xiA, fromInteger _xiB]
mulXi :: Fq6 -> Fq6
mulXi w = case fromField w of
[x, y, z] -> toField [z * xi, x, y]
[x, y] -> toField [0, x, y]
[x] -> toField [0, x]
[] -> toField []
_ -> 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] -> toField [y, -z]
[y] -> toField [y]
[] -> 0
_ -> panic "fq2Conj not exhaustive."
fq2ScalarMul :: Fq -> Fq2 -> Fq2
fq2ScalarMul a x = toField [a] * x
fq12Conj :: Fq12 -> Fq12
fq12Conj x = case fromField x of
[y, z] -> toField [y, -z]
[y] -> toField [y]
[] -> 0
_ -> panic "fq12Conj not exhaustive."
construct :: [Fq] -> Fq12
construct [a, b, c, d, e, f, g, h, i, j, k, l] = toField
[ toField [toField [a, b], toField [c, d], toField [e, f]]
, toField [toField [g, h], toField [i, j], toField [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 = toField . map toField