Group.hs

{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Definitions of the groups the pairing is defined on
module Pairing.Group (
  CyclicGroup(..),
  G1,
  G2,
  GT,
  isOnCurveG1,
  isOnCurveG2,
  isInGT,
  g1,
  g2,
  b1,
  b2,
  hashToG1,
  randomG1,
  randomG2
) where

import Protolude
import Data.Semigroup

import Pairing.Fq as Fq
import Pairing.Fq2 as Fq2
import Pairing.Fq12 as Fq12
import Pairing.Point
import Pairing.Params
import Pairing.CyclicGroup
import Test.QuickCheck
import Pairing.Hash
import Crypto.Random (MonadRandom)

-- | G1 is E(Fq) defined by y^2 = x^3 + b
type G1 = Point Fq

-- | G2 is E'(Fq2) defined by y^2 = x^3 + b / xi
type G2 = Point Fq2

-- | GT is subgroup of _r-th roots of unity of the multiplicative
-- group of Fq12
type GT = Fq12

instance Semigroup G1 where
  (<>) = gAdd

instance Semigroup G2 where
  (<>) = gAdd

instance Semigroup GT where
  (<>) = (*)

instance Monoid G1 where
  mappend = gAdd
  mempty = Infinity

instance CyclicGroup G1 where
  generator = g1
  order _ = _r
  expn a b = gMul a (asInteger b)
  inverse = gNeg

instance Monoid G2 where
  mappend = gAdd
  mempty = Infinity

instance CyclicGroup G2 where
  generator = g2
  order _ = _r
  expn a b = gMul a (asInteger b)
  inverse = gNeg

instance Monoid GT where
  mappend = (*)
  mempty = 1

instance CyclicGroup GT where
  generator = notImplemented -- this should be the _r-th primitive root of unity
  order = notImplemented -- should be a factor of _r
  expn a b = a ^ asInteger b
  inverse = recip

-- | Generator for G1
g1 :: G1
g1 = Point 1 2

-- | Generator for G2
g2 :: G2
g2 = Point x y
  where
    x = Fq2
      10857046999023057135944570762232829481370756359578518086990519993285655852781
      11559732032986387107991004021392285783925812861821192530917403151452391805634

    y = Fq2
      8495653923123431417604973247489272438418190587263600148770280649306958101930
      4082367875863433681332203403145435568316851327593401208105741076214120093531

-- | Test whether a value in G1 satisfies the corresponding curve
-- equation
isOnCurveG1 :: G1 -> Bool
isOnCurveG1 Infinity
  = True
isOnCurveG1 (Point x y)
  = (y ^ 2 == x ^ 3 + Fq _b)

-- | Test whether a value in G2 satisfies the corresponding curve
-- equation
isOnCurveG2 :: G2 -> Bool
isOnCurveG2 Infinity
  = True
isOnCurveG2 (Point x y)
  = (y ^ 2 == x ^ 3 + (Fq2 (b * inv_xi_a) (b * inv_xi_b)))
  where
    (Fq2 inv_xi_a inv_xi_b) = Fq2.fq2inv Fq2.xi
    b = Fq _b

-- | Test whether a value is an _r-th root of unity
isInGT :: GT -> Bool
isInGT f =  f ^ _r == Fq12.fq12one

-- | Parameter for curve on Fq
b1 :: Fq
b1 = Fq.new _b

-- | Parameter for twisted curve over Fq2
b2 :: Fq2
b2 = Fq2 b1 0 / Fq2.xi

-------------------------------------------------------------------------------
-- Generators
-------------------------------------------------------------------------------

instance Arbitrary (Point Fq) where -- G1
  arbitrary = gMul g1 . abs <$> (arbitrary :: Gen Integer)

instance Arbitrary (Point Fq2) where -- G2
  arbitrary = gMul g2 . abs <$> (arbitrary :: Gen Integer)

hashToG1 :: (MonadIO m, MonadRandom m) => ByteString -> m G1
hashToG1 = swEncBN

randomG1 :: (MonadIO m, MonadRandom m) => m G1
randomG1 = do
  Fq r <- Fq.random
  pure (gMul g1 r)

randomG2 :: (MonadIO m, MonadRandom m) => m G2
randomG2 = do
  Fq r <- Fq.random
  pure (gMul g2 r)