{-# LANGUAGE Strict #-}
{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}

-- | Final quadratic extension of the tower:
--
--   * Fq
--   * Fq2 := Fq[u]/u^2 + 1
--   * Fq6 := Fq2[v]/v^3 - (9 + u)
--   * Fq12 := Fq6[w]/w^2 - v
--
-- Implementation follows "Multiplication and Squaring on
-- Pairing-Friendly Fields" by Devigili, hEigeartaigh, Scott and
-- Dahab.
module Pairing.Fq12 (
  Fq12(..),
  new,
  deconstruct,
  fq12inv,
  fq12one,
  fq12zero,
  fq12conj,
  fq12frobenius,
  random
) where

import Protolude
import Crypto.Random (MonadRandom)

import Pairing.Fq (Fq)
import Pairing.Fq6 (Fq6(..))
import qualified Pairing.Fq2 as Fq2
import qualified Pairing.Fq6 as Fq6
import Pairing.CyclicGroup (AsInteger(..), FromX(..))
import Pairing.Params
import Pairing.ByteRepr
import Data.ByteString as B (length, splitAt)

-- | Field extension defined as Fq6[w]/w^2 - v
data Fq12 = Fq12 { fq12x :: Fq6, fq12y :: Fq6 } -- ^ Use @new@ instead
                                                -- of this constructor
  deriving (Eq, Show, Generic, NFData)

instance Num Fq12 where
  (+)         = fq12add
  (*)         = fq12mul
  negate      = fq12neg
  fromInteger = fq12int
  abs         = panic "abs not defined for fq12"
  signum      = panic "signum not defined for fq12"

instance Fractional Fq12 where
  (/) = fq12div
  fromRational (a :% b) = fq12int a / fq12int b

instance ByteRepr Fq12 where
  mkRepr (Fq12 x y) = mkRepr x <> mkRepr y
  fromRepr (Fq12 x _) bs = do
    let (xbs, ybs) = B.splitAt (reprLength x) bs
    x <- fromRepr Fq6.fq6one xbs
    y <- fromRepr Fq6.fq6one ybs
    Just (Fq12 x y)
  reprLength (Fq12 x y)  = reprLength x + reprLength y

-- | Create a new value in @Fq12@ by providing a list of twelve
-- coefficients in @Fq@, should be used instead of the @Fq12@
-- constructor.
new :: [Fq] -> Fq12
new [a,b,c,d,e,f,g,h,i,j,k,l] = Fq12
  (Fq6.new (Fq2.new a b) (Fq2.new c d) (Fq2.new e f))
  (Fq6.new (Fq2.new g h) (Fq2.new i j) (Fq2.new k l))
new _ = panic "Invalid arguments to fq12"

-- | Deconstruct a value in @Fq12@ into a list of twelve coefficients in @Fq@.
deconstruct :: Fq12 -> [Fq]
deconstruct (Fq12
  (Fq6.Fq6 (Fq2.Fq2 a b) (Fq2.Fq2 c d) (Fq2.Fq2 e f))
  (Fq6.Fq6 (Fq2.Fq2 g h) (Fq2.Fq2 i j) (Fq2.Fq2 k l)))
  = [a,b,c,d,e,f,g,h,i,j,k,l]

fq12int :: Integer -> Fq12
fq12int n = new (fromIntegral n : replicate 11 0)

-- | Multiplicative identity
fq12one :: Fq12
fq12one = fq12int 1

-- | Additive identity
fq12zero :: Fq12
fq12zero = fq12int 0

fq12add :: Fq12 -> Fq12 -> Fq12
fq12add (Fq12 x y) (Fq12 a b) = Fq12 (x+a) (y+b)

fq12neg :: Fq12 -> Fq12
fq12neg (Fq12 x y) = Fq12 (negate x) (negate y)

fq12div :: Fq12 -> Fq12 -> Fq12
fq12div a b = a * fq12inv b

fq12mul :: Fq12 -> Fq12 -> Fq12
fq12mul (Fq12 x y) (Fq12 a b) = Fq12 (Fq6.mulXi bb + aa) ((x+y) * (a+b) - aa - bb)
  where
    aa = x*a
    bb = y*b

-- | Multiplicative inverse
{-# INLINEABLE fq12inv #-}
fq12inv :: Fq12 -> Fq12
fq12inv (Fq12 a b) = Fq12 (a*t) (-(b*t))
  where
    t = Fq6.fq6inv (a^2 - Fq6.mulXi (b^2))

-- | Conjugation
fq12conj :: Fq12 -> Fq12
fq12conj (Fq12 x y) = Fq12 x (negate y)

-- | Iterated Frobenius automorphism
fq12frobenius :: Int -> Fq12 -> Fq12
fq12frobenius i a
  | i == 0 = a
  | i == 1 = fastFrobenius1 a
  | i > 1 = let prev = fq12frobenius (i - 1) a
            in fastFrobenius1 prev
  | otherwise = panic "fq12frobenius not defined for negative values of i"

fastFrobenius1 :: Fq12 -> Fq12
fastFrobenius1 (Fq12 (Fq6.Fq6 x0 x1 x2) (Fq6.Fq6 y0 y1 y2)) =
  let
    t1 = Fq2.fq2conj x0
    t2 = Fq2.fq2conj y0
    t3 = Fq2.fq2conj x1
    t4 = Fq2.fq2conj y1
    t5 = Fq2.fq2conj x2
    t6 = Fq2.fq2conj y2
    gamma1 :: Integer -> Fq2.Fq2
    gamma1 i = Fq2.xi ^ ((i * (_q - 1)) `div` 6)
    t11 = t1
    t21 = t2 * gamma1 1
    t31 = t3 * gamma1 2
    t41 = t4 * gamma1 3
    t51 = t5 * gamma1 4
    t61 = t6 * gamma1 5
    c0 = Fq6 t11 t31 t51
    c1 = Fq6 t21 t41 t61
  in Fq12 c0 c1



random :: MonadRandom m => m Fq12
random = do
  x <- Fq6.random
  y <- Fq6.random
  pure (Fq12 x y)