{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE OverloadedLists      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module ZkFold.Base.Algebra.EllipticCurve.BLS12_381 where

import           Control.DeepSeq                            (NFData)
import           Control.Monad
import           Data.Bits
import           Data.Foldable
import           Data.Word
import           GHC.Generics                               (Generic)
import           Prelude                                    hiding (Num (..), (/), (^))

import           ZkFold.Base.Algebra.Basic.Class
import           ZkFold.Base.Algebra.Basic.Field
import           ZkFold.Base.Algebra.Basic.Number
import           ZkFold.Base.Algebra.EllipticCurve.Class
import           ZkFold.Base.Algebra.EllipticCurve.Pairing
import           ZkFold.Base.Algebra.Polynomials.Univariate
import           ZkFold.Base.Data.ByteString

-------------------------------- Introducing Fields ----------------------------------

type BLS12_381_Scalar = 0x73eda753299d7d483339d80809a1d80553bda402fffe5bfeffffffff00000001
instance Prime BLS12_381_Scalar

type BLS12_381_Base = 0x1a0111ea397fe69a4b1ba7b6434bacd764774b84f38512bf6730d2a0f6b0f6241eabfffeb153ffffb9feffffffffaaab
instance Prime BLS12_381_Base

type Fr = Zp BLS12_381_Scalar
type Fq = Zp BLS12_381_Base

type IP1 = "IP1"
instance IrreduciblePoly Fq IP1 where
    irreduciblePoly :: Poly Fq
irreduciblePoly = Vector Fq -> Poly Fq
forall c. (Ring c, Eq c) => Vector c -> Poly c
toPoly [Item (Vector Fq)
Fq
1, Item (Vector Fq)
Fq
0, Item (Vector Fq)
Fq
1]
type Fq2 = Ext2 Fq IP1

type IP2 = "IP2"
instance IrreduciblePoly Fq2 IP2 where
    irreduciblePoly :: Poly Fq2
irreduciblePoly =
        let e :: Ext2 Fq e
e = Fq -> Fq -> Ext2 Fq e
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2
                Fq
0xd0088f51cbff34d258dd3db21a5d66bb23ba5c279c2895fb39869507b587b120f55ffff58a9ffffdcff7fffffffd556
                Fq
0xd0088f51cbff34d258dd3db21a5d66bb23ba5c279c2895fb39869507b587b120f55ffff58a9ffffdcff7fffffffd555
        in Vector Fq2 -> Poly Fq2
forall c. (Ring c, Eq c) => Vector c -> Poly c
toPoly [Fq2 -> Fq2
forall a. AdditiveGroup a => a -> a
negate Fq2
forall {e :: Symbol}. Ext2 Fq e
e, Item (Vector Fq2)
Fq2
forall a. AdditiveMonoid a => a
zero, Item (Vector Fq2)
Fq2
forall a. AdditiveMonoid a => a
zero, Item (Vector Fq2)
Fq2
forall a. MultiplicativeMonoid a => a
one]
type Fq6 = Ext3 Fq2 IP2

type IP3 = "IP3"
instance IrreduciblePoly Fq6 IP3 where
    irreduciblePoly :: Poly Fq6
irreduciblePoly =
        let e :: Ext3 Fq2 e
e = Fq2 -> Fq2 -> Fq2 -> Ext3 Fq2 e
forall f (e :: Symbol). f -> f -> f -> Ext3 f e
Ext3 Fq2
forall a. AdditiveMonoid a => a
zero (Fq2 -> Fq2
forall a. AdditiveGroup a => a -> a
negate Fq2
forall a. MultiplicativeMonoid a => a
one) Fq2
forall a. AdditiveMonoid a => a
zero
        in Vector Fq6 -> Poly Fq6
forall c. (Ring c, Eq c) => Vector c -> Poly c
toPoly [Item (Vector Fq6)
Fq6
forall {e :: Symbol}. Ext3 Fq2 e
e, Item (Vector Fq6)
Fq6
forall a. AdditiveMonoid a => a
zero, Item (Vector Fq6)
Fq6
forall a. MultiplicativeMonoid a => a
one]
type Fq12 = Ext2 Fq6 IP3

------------------------------------ BLS12-381 G1 ------------------------------------

data BLS12_381_G1
    deriving ((forall x. BLS12_381_G1 -> Rep BLS12_381_G1 x)
-> (forall x. Rep BLS12_381_G1 x -> BLS12_381_G1)
-> Generic BLS12_381_G1
forall x. Rep BLS12_381_G1 x -> BLS12_381_G1
forall x. BLS12_381_G1 -> Rep BLS12_381_G1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BLS12_381_G1 -> Rep BLS12_381_G1 x
from :: forall x. BLS12_381_G1 -> Rep BLS12_381_G1 x
$cto :: forall x. Rep BLS12_381_G1 x -> BLS12_381_G1
to :: forall x. Rep BLS12_381_G1 x -> BLS12_381_G1
Generic, BLS12_381_G1 -> ()
(BLS12_381_G1 -> ()) -> NFData BLS12_381_G1
forall a. (a -> ()) -> NFData a
$crnf :: BLS12_381_G1 -> ()
rnf :: BLS12_381_G1 -> ()
NFData)

instance EllipticCurve BLS12_381_G1 where
    type ScalarField BLS12_381_G1 = Fr

    type BaseField BLS12_381_G1 = Fq

    inf :: Point BLS12_381_G1
inf = Point BLS12_381_G1
forall {k} (curve :: k). Point curve
Inf

    gen :: Point BLS12_381_G1
gen = BaseField BLS12_381_G1
-> BaseField BLS12_381_G1 -> Point BLS12_381_G1
forall {k} (curve :: k).
BaseField curve -> BaseField curve -> Point curve
Point
        BaseField BLS12_381_G1
Fq
0x17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb
        BaseField BLS12_381_G1
Fq
0x8b3f481e3aaa0f1a09e30ed741d8ae4fcf5e095d5d00af600db18cb2c04b3edd03cc744a2888ae40caa232946c5e7e1

    add :: Point BLS12_381_G1 -> Point BLS12_381_G1 -> Point BLS12_381_G1
add = Point BLS12_381_G1 -> Point BLS12_381_G1 -> Point BLS12_381_G1
forall {k} (curve :: k).
(EllipticCurve curve, Field (BaseField curve),
 Eq (BaseField curve)) =>
Point curve -> Point curve -> Point curve
addPoints

    mul :: ScalarField BLS12_381_G1
-> Point BLS12_381_G1 -> Point BLS12_381_G1
mul = ScalarField BLS12_381_G1
-> Point BLS12_381_G1 -> Point BLS12_381_G1
Fr -> Point BLS12_381_G1 -> Point BLS12_381_G1
forall {k} (curve :: k) s.
(EllipticCurve curve, BinaryExpansion s, Bits s ~ [s], Eq s) =>
s -> Point curve -> Point curve
pointMul

instance StandardEllipticCurve BLS12_381_G1 where
    aParameter :: BaseField BLS12_381_G1
aParameter = BaseField BLS12_381_G1
Fq
forall a. AdditiveMonoid a => a
zero

    bParameter :: BaseField BLS12_381_G1
bParameter = Natural -> Fq
forall a b. FromConstant a b => a -> b
fromConstant (Natural
4 :: Natural)

------------------------------------ BLS12-381 G2 ------------------------------------

data BLS12_381_G2
    deriving ((forall x. BLS12_381_G2 -> Rep BLS12_381_G2 x)
-> (forall x. Rep BLS12_381_G2 x -> BLS12_381_G2)
-> Generic BLS12_381_G2
forall x. Rep BLS12_381_G2 x -> BLS12_381_G2
forall x. BLS12_381_G2 -> Rep BLS12_381_G2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BLS12_381_G2 -> Rep BLS12_381_G2 x
from :: forall x. BLS12_381_G2 -> Rep BLS12_381_G2 x
$cto :: forall x. Rep BLS12_381_G2 x -> BLS12_381_G2
to :: forall x. Rep BLS12_381_G2 x -> BLS12_381_G2
Generic, BLS12_381_G2 -> ()
(BLS12_381_G2 -> ()) -> NFData BLS12_381_G2
forall a. (a -> ()) -> NFData a
$crnf :: BLS12_381_G2 -> ()
rnf :: BLS12_381_G2 -> ()
NFData)

instance EllipticCurve BLS12_381_G2 where

    type ScalarField BLS12_381_G2 = Fr

    type BaseField BLS12_381_G2 = Fq2

    inf :: Point BLS12_381_G2
inf = Point BLS12_381_G2
forall {k} (curve :: k). Point curve
Inf

    gen :: Point BLS12_381_G2
gen = BaseField BLS12_381_G2
-> BaseField BLS12_381_G2 -> Point BLS12_381_G2
forall {k} (curve :: k).
BaseField curve -> BaseField curve -> Point curve
Point
        (Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2
            Fq
0x24aa2b2f08f0a91260805272dc51051c6e47ad4fa403b02b4510b647ae3d1770bac0326a805bbefd48056c8c121bdb8
            Fq
0x13e02b6052719f607dacd3a088274f65596bd0d09920b61ab5da61bbdc7f5049334cf11213945d57e5ac7d055d042b7e)
        (Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2
            Fq
0xce5d527727d6e118cc9cdc6da2e351aadfd9baa8cbdd3a76d429a695160d12c923ac9cc3baca289e193548608b82801
            Fq
0x606c4a02ea734cc32acd2b02bc28b99cb3e287e85a763af267492ab572e99ab3f370d275cec1da1aaa9075ff05f79be)

    add :: Point BLS12_381_G2 -> Point BLS12_381_G2 -> Point BLS12_381_G2
add = Point BLS12_381_G2 -> Point BLS12_381_G2 -> Point BLS12_381_G2
forall {k} (curve :: k).
(EllipticCurve curve, Field (BaseField curve),
 Eq (BaseField curve)) =>
Point curve -> Point curve -> Point curve
addPoints

    mul :: ScalarField BLS12_381_G2
-> Point BLS12_381_G2 -> Point BLS12_381_G2
mul = ScalarField BLS12_381_G2
-> Point BLS12_381_G2 -> Point BLS12_381_G2
Fr -> Point BLS12_381_G2 -> Point BLS12_381_G2
forall {k} (curve :: k) s.
(EllipticCurve curve, BinaryExpansion s, Bits s ~ [s], Eq s) =>
s -> Point curve -> Point curve
pointMul

instance StandardEllipticCurve BLS12_381_G2 where
    aParameter :: BaseField BLS12_381_G2
aParameter = BaseField BLS12_381_G2
Fq2
forall a. AdditiveMonoid a => a
zero

    bParameter :: BaseField BLS12_381_G2
bParameter = Natural -> Fq2
forall a b. FromConstant a b => a -> b
fromConstant (Natural
4 :: Natural)

------------------------------------ Encoding ------------------------------------

-- infinite list of divMod 256's, little endian order
leBytesOf :: Natural -> [(Natural, Word8)]
leBytesOf :: Natural -> [(Natural, Word8)]
leBytesOf Natural
n =
    let
        (Natural
n', Natural
r) = Natural
n Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`Prelude.divMod` Natural
256
    in
        (Natural
n', Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
r) (Natural, Word8) -> [(Natural, Word8)] -> [(Natural, Word8)]
forall a. a -> [a] -> [a]
: Natural -> [(Natural, Word8)]
leBytesOf Natural
n'

-- finite list of bytes, big endian order
bytesOf :: (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf :: forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
n
    = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse
    ([Word8] -> [Word8]) -> (a -> [Word8]) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
n
    ([Word8] -> [Word8]) -> (a -> [Word8]) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Natural, Word8) -> Word8) -> [(Natural, Word8)] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Natural, Word8) -> Word8
forall a b. (a, b) -> b
snd
    ([(Natural, Word8)] -> [Word8])
-> (a -> [(Natural, Word8)]) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [(Natural, Word8)]
leBytesOf
    (Natural -> [(Natural, Word8)])
-> (a -> Natural) -> a -> [(Natural, Word8)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Natural
a -> Const a
forall a. ToConstant a => a -> Const a
toConstant

-- big endian decoding
ofBytes :: FromConstant Natural a => [Word8] -> a
ofBytes :: forall a. FromConstant Natural a => [Word8] -> a
ofBytes
  = forall a b. FromConstant a b => a -> b
fromConstant @Natural
  (Natural -> a) -> ([Word8] -> Natural) -> [Word8] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Word8 -> Natural) -> Natural -> [Word8] -> Natural
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Natural
n Word8
w8 -> Natural
n Natural -> Natural -> Natural
forall a. MultiplicativeSemigroup a => a -> a -> a
* Natural
256 Natural -> Natural -> Natural
forall a. AdditiveSemigroup a => a -> a -> a
+ Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) Natural
0

instance Binary (Point BLS12_381_G1) where
    put :: Point BLS12_381_G1 -> Put
put Point BLS12_381_G1
Inf         = (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 (Word8 -> Word8
bitReverse8 (Int -> Word8
forall a. Bits a => Int -> a
bit Int
1) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
95 Word8
0)
    put (Point BaseField BLS12_381_G1
x BaseField BLS12_381_G1
y) = (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 (Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 BaseField BLS12_381_G1
Fq
x [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 BaseField BLS12_381_G1
Fq
y)
    get :: Get (Point BLS12_381_G1)
get = do
        Word8
byte <- Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Get Word8 -> Get Word8
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        let compressed :: Bool
compressed = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
0
            infinite :: Bool
infinite = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
1
        if Bool
infinite then do
            Int -> Get ()
skip (if Bool
compressed then Int
47 else Int
95)
            Point BLS12_381_G1 -> Get (Point BLS12_381_G1)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Point BLS12_381_G1
forall {k} (curve :: k). Point curve
Inf
        else do
            let byteXhead :: Word8
byteXhead = Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
byte Int
0) Int
1) Int
2
            [Word8]
bytesXtail <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
47 Get Word8
getWord8
            let x :: Fq
x = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes (Word8
byteXheadWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
bytesXtail)
                bigY :: Bool
bigY = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
2
            if Bool
compressed then Point BLS12_381_G1 -> Get (Point BLS12_381_G1)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PointCompressed BLS12_381_G1 -> Point BLS12_381_G1
forall {k} (curve :: k).
(StandardEllipticCurve curve, FiniteField (BaseField curve),
 Ord (BaseField curve)) =>
PointCompressed curve -> Point curve
decompress (BaseField BLS12_381_G1 -> Bool -> PointCompressed BLS12_381_G1
forall {k} (curve :: k).
BaseField curve -> Bool -> PointCompressed curve
PointCompressed BaseField BLS12_381_G1
Fq
x Bool
bigY))
            else do
                [Word8]
bytesY <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
                let y :: Fq
y = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesY
                Point BLS12_381_G1 -> Get (Point BLS12_381_G1)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseField BLS12_381_G1
-> BaseField BLS12_381_G1 -> Point BLS12_381_G1
forall {k} (curve :: k).
BaseField curve -> BaseField curve -> Point curve
Point BaseField BLS12_381_G1
Fq
x BaseField BLS12_381_G1
Fq
y)

instance Binary (PointCompressed BLS12_381_G1) where
    put :: PointCompressed BLS12_381_G1 -> Put
put PointCompressed BLS12_381_G1
InfCompressed            =
        (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 (Word8 -> Word8
bitReverse8 (Int -> Word8
forall a. Bits a => Int -> a
bit Int
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a. Bits a => Int -> a
bit Int
1) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
47 Word8
0)
    put (PointCompressed BaseField BLS12_381_G1
x Bool
bigY) =
        let
            flags :: Word8
flags = Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ if Bool
bigY then Int -> Word8
forall a. Bits a => Int -> a
bit Int
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a. Bits a => Int -> a
bit Int
2 else Int -> Word8
forall a. Bits a => Int -> a
bit Int
0
            bytes :: [Word8]
bytes = Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 BaseField BLS12_381_G1
Fq
x
        in (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 ((Word8
flags Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. [Word8] -> Word8
forall a. HasCallStack => [a] -> a
head [Word8]
bytes) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
forall a. HasCallStack => [a] -> [a]
tail [Word8]
bytes)
    get :: Get (PointCompressed BLS12_381_G1)
get = do
        Word8
byte <- Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Get Word8 -> Get Word8
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        let compressed :: Bool
compressed = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
0
            infinite :: Bool
infinite = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
1
        if Bool
infinite then do
            Int -> Get ()
skip (if Bool
compressed then Int
47 else Int
95)
            PointCompressed BLS12_381_G1 -> Get (PointCompressed BLS12_381_G1)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PointCompressed BLS12_381_G1
forall {k} (curve :: k). PointCompressed curve
InfCompressed
        else do
            let byteXhead :: Word8
byteXhead = Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
byte Int
0) Int
1) Int
2
            [Word8]
bytesXtail <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
47 Get Word8
getWord8
            let x :: Fq
x = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes (Word8
byteXheadWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
bytesXtail)
                bigY :: Bool
bigY = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
2
            if Bool
compressed then PointCompressed BLS12_381_G1 -> Get (PointCompressed BLS12_381_G1)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseField BLS12_381_G1 -> Bool -> PointCompressed BLS12_381_G1
forall {k} (curve :: k).
BaseField curve -> Bool -> PointCompressed curve
PointCompressed BaseField BLS12_381_G1
Fq
x Bool
bigY)
            else do
                [Word8]
bytesY <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
                let Fq
y :: Fq = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesY
                    bigY' :: Bool
bigY' = Fq
y Fq -> Fq -> Bool
forall a. Ord a => a -> a -> Bool
> Fq -> Fq
forall a. AdditiveGroup a => a -> a
negate Fq
y
                PointCompressed BLS12_381_G1 -> Get (PointCompressed BLS12_381_G1)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseField BLS12_381_G1 -> Bool -> PointCompressed BLS12_381_G1
forall {k} (curve :: k).
BaseField curve -> Bool -> PointCompressed curve
PointCompressed BaseField BLS12_381_G1
Fq
x Bool
bigY')

instance Binary (Point BLS12_381_G2) where
    put :: Point BLS12_381_G2 -> Put
put Point BLS12_381_G2
Inf                               =
        (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 (Word8 -> Word8
bitReverse8 (Int -> Word8
forall a. Bits a => Int -> a
bit Int
1) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
191  Word8
0)
    put (Point (Ext2 Fq
x0 Fq
x1) (Ext2 Fq
y0 Fq
y1)) =
        let
            bytes :: [Word8]
bytes = Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 Fq
x1
              [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 Fq
x0
              [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 Fq
y1
              [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 Fq
y0
        in
            (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 [Word8]
bytes
    get :: Get (Point BLS12_381_G2)
get = do
        Word8
byte <- Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Get Word8 -> Get Word8
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        let compressed :: Bool
compressed = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
0
            infinite :: Bool
infinite = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
1
        if Bool
infinite then do
            Int -> Get ()
skip (if Bool
compressed then Int
95 else Int
191)
            Point BLS12_381_G2 -> Get (Point BLS12_381_G2)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Point BLS12_381_G2
forall {k} (curve :: k). Point curve
Inf
        else do
            let byteX1head :: Word8
byteX1head = Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
byte Int
0) Int
1) Int
2
            [Word8]
bytesX1tail <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
47 Get Word8
getWord8
            [Word8]
bytesX0 <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
            let x1 :: Fq
x1 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes (Word8
byteX1headWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
bytesX1tail)
                x0 :: Fq
x0 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesX0
                bigY :: Bool
bigY = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
2
            if Bool
compressed then Point BLS12_381_G2 -> Get (Point BLS12_381_G2)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PointCompressed BLS12_381_G2 -> Point BLS12_381_G2
forall {k} (curve :: k).
(StandardEllipticCurve curve, FiniteField (BaseField curve),
 Ord (BaseField curve)) =>
PointCompressed curve -> Point curve
decompress (BaseField BLS12_381_G2 -> Bool -> PointCompressed BLS12_381_G2
forall {k} (curve :: k).
BaseField curve -> Bool -> PointCompressed curve
PointCompressed (Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2 Fq
x0 Fq
x1) Bool
bigY))
            else do
                [Word8]
bytesY1 <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
                [Word8]
bytesY0 <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
                let y0 :: Fq
y0 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesY0
                    y1 :: Fq
y1 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesY1
                Point BLS12_381_G2 -> Get (Point BLS12_381_G2)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseField BLS12_381_G2
-> BaseField BLS12_381_G2 -> Point BLS12_381_G2
forall {k} (curve :: k).
BaseField curve -> BaseField curve -> Point curve
Point (Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2 Fq
x0 Fq
x1) (Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2 Fq
y0 Fq
y1))

instance Binary (PointCompressed BLS12_381_G2) where
    put :: PointCompressed BLS12_381_G2 -> Put
put PointCompressed BLS12_381_G2
InfCompressed = (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 (Word8 -> Word8
bitReverse8 (Int -> Word8
forall a. Bits a => Int -> a
bit Int
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a. Bits a => Int -> a
bit Int
1) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
95 Word8
0)
    put (PointCompressed (Ext2 Fq
x0 Fq
x1) Bool
bigY) =
        let
            flags :: Word8
flags = Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ if Bool
bigY then Int -> Word8
forall a. Bits a => Int -> a
bit Int
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a. Bits a => Int -> a
bit Int
2 else Int -> Word8
forall a. Bits a => Int -> a
bit Int
0
            bytes :: [Word8]
bytes = Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 Fq
x1 [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Int -> Fq -> [Word8]
forall a. (ToConstant a, Const a ~ Natural) => Int -> a -> [Word8]
bytesOf Int
48 Fq
x0
        in
            (Word8 -> Put) -> [Word8] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> Put
putWord8 ((Word8
flags Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. [Word8] -> Word8
forall a. HasCallStack => [a] -> a
head [Word8]
bytes) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
forall a. HasCallStack => [a] -> [a]
tail [Word8]
bytes)
    get :: Get (PointCompressed BLS12_381_G2)
get = do
        Word8
byte <- Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Get Word8 -> Get Word8
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
        let compressed :: Bool
compressed = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
0
            infinite :: Bool
infinite = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
1
        if Bool
infinite then do
            Int -> Get ()
skip (if Bool
compressed then Int
95 else Int
191)
            PointCompressed BLS12_381_G2 -> Get (PointCompressed BLS12_381_G2)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PointCompressed BLS12_381_G2
forall {k} (curve :: k). PointCompressed curve
InfCompressed
        else do
            let byteX1head :: Word8
byteX1head = Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
byte Int
0) Int
1) Int
2
            [Word8]
bytesX1tail <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
47 Get Word8
getWord8
            [Word8]
bytesX0 <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
            let x1 :: Fq
x1 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes (Word8
byteX1headWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
bytesX1tail)
                x0 :: Fq
x0 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesX0
                x :: Fq2
x = Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2 Fq
x0 Fq
x1
                bigY :: Bool
bigY = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
2
            if Bool
compressed then PointCompressed BLS12_381_G2 -> Get (PointCompressed BLS12_381_G2)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseField BLS12_381_G2 -> Bool -> PointCompressed BLS12_381_G2
forall {k} (curve :: k).
BaseField curve -> Bool -> PointCompressed curve
PointCompressed (Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2 Fq
x0 Fq
x1) Bool
bigY)
            else do
                [Word8]
bytesY1 <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
                [Word8]
bytesY0 <- Int -> Get Word8 -> Get [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
48 Get Word8
getWord8
                let y0 :: Fq
y0 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesY0
                    y1 :: Fq
y1 = [Word8] -> Fq
forall a. FromConstant Natural a => [Word8] -> a
ofBytes [Word8]
bytesY1
                    Fq2
y :: Fq2 = Fq -> Fq -> Fq2
forall f (e :: Symbol). f -> f -> Ext2 f e
Ext2 Fq
y0 Fq
y1
                    bigY' :: Bool
bigY' = Fq2
y Fq2 -> Fq2 -> Bool
forall a. Ord a => a -> a -> Bool
> Fq2 -> Fq2
forall a. AdditiveGroup a => a -> a
negate Fq2
y
                PointCompressed BLS12_381_G2 -> Get (PointCompressed BLS12_381_G2)
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseField BLS12_381_G2 -> Bool -> PointCompressed BLS12_381_G2
forall {k} (curve :: k).
BaseField curve -> Bool -> PointCompressed curve
PointCompressed BaseField BLS12_381_G2
Fq2
x Bool
bigY')

--------------------------------------- Pairing ---------------------------------------

-- | An image of a pairing is a cyclic multiplicative subgroup of @'Fq12'@
-- of order @'BLS12_381_Scalar'@.
newtype BLS12_381_GT = BLS12_381_GT Fq12
    deriving newtype (BLS12_381_GT -> BLS12_381_GT -> Bool
(BLS12_381_GT -> BLS12_381_GT -> Bool)
-> (BLS12_381_GT -> BLS12_381_GT -> Bool) -> Eq BLS12_381_GT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BLS12_381_GT -> BLS12_381_GT -> Bool
== :: BLS12_381_GT -> BLS12_381_GT -> Bool
$c/= :: BLS12_381_GT -> BLS12_381_GT -> Bool
/= :: BLS12_381_GT -> BLS12_381_GT -> Bool
Eq, Int -> BLS12_381_GT -> ShowS
[BLS12_381_GT] -> ShowS
BLS12_381_GT -> String
(Int -> BLS12_381_GT -> ShowS)
-> (BLS12_381_GT -> String)
-> ([BLS12_381_GT] -> ShowS)
-> Show BLS12_381_GT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BLS12_381_GT -> ShowS
showsPrec :: Int -> BLS12_381_GT -> ShowS
$cshow :: BLS12_381_GT -> String
show :: BLS12_381_GT -> String
$cshowList :: [BLS12_381_GT] -> ShowS
showList :: [BLS12_381_GT] -> ShowS
Show, Scale BLS12_381_GT BLS12_381_GT
FromConstant BLS12_381_GT BLS12_381_GT
(FromConstant BLS12_381_GT BLS12_381_GT,
 Scale BLS12_381_GT BLS12_381_GT) =>
(BLS12_381_GT -> BLS12_381_GT -> BLS12_381_GT)
-> MultiplicativeSemigroup BLS12_381_GT
BLS12_381_GT -> BLS12_381_GT -> BLS12_381_GT
forall a.
(FromConstant a a, Scale a a) =>
(a -> a -> a) -> MultiplicativeSemigroup a
$c* :: BLS12_381_GT -> BLS12_381_GT -> BLS12_381_GT
* :: BLS12_381_GT -> BLS12_381_GT -> BLS12_381_GT
MultiplicativeSemigroup, Exponent BLS12_381_GT Natural
MultiplicativeSemigroup BLS12_381_GT
BLS12_381_GT
(MultiplicativeSemigroup BLS12_381_GT,
 Exponent BLS12_381_GT Natural) =>
BLS12_381_GT -> MultiplicativeMonoid BLS12_381_GT
forall a.
(MultiplicativeSemigroup a, Exponent a Natural) =>
a -> MultiplicativeMonoid a
$cone :: BLS12_381_GT
one :: BLS12_381_GT
MultiplicativeMonoid)

instance Exponent BLS12_381_GT Natural where
    BLS12_381_GT Fq12
a ^ :: BLS12_381_GT -> Natural -> BLS12_381_GT
^ Natural
p = Fq12 -> BLS12_381_GT
BLS12_381_GT (Fq12
a Fq12 -> Natural -> Fq12
forall a b. Exponent a b => a -> b -> a
^ Natural
p)

instance Exponent BLS12_381_GT Integer where
    BLS12_381_GT Fq12
a ^ :: BLS12_381_GT -> Integer -> BLS12_381_GT
^ Integer
p = Fq12 -> BLS12_381_GT
BLS12_381_GT (Fq12
a Fq12 -> Integer -> Fq12
forall a b. Exponent a b => a -> b -> a
^ Integer
p)

deriving via (NonZero Fq12) instance MultiplicativeGroup BLS12_381_GT

instance Finite BLS12_381_GT where
    type Order BLS12_381_GT = BLS12_381_Scalar

instance Pairing BLS12_381_G1 BLS12_381_G2 where
    type TargetGroup BLS12_381_G1 BLS12_381_G2 = BLS12_381_GT
    pairing :: Point BLS12_381_G1
-> Point BLS12_381_G2 -> TargetGroup BLS12_381_G1 BLS12_381_G2
pairing Point BLS12_381_G1
a Point BLS12_381_G2
b
      = Fq12 -> BLS12_381_GT
BLS12_381_GT
      (Fq12 -> BLS12_381_GT) -> Fq12 -> BLS12_381_GT
forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) g (i :: Symbol) (j :: Symbol).
(Finite (ScalarField c), Finite (BaseField c), g ~ Untwisted c i j,
 Exponent g Natural) =>
g -> g
forall c g (i :: Symbol) (j :: Symbol).
(Finite (ScalarField c), Finite (BaseField c), g ~ Untwisted c i j,
 Exponent g Natural) =>
g -> g
finalExponentiation @BLS12_381_G2
      (Fq12 -> Fq12) -> Fq12 -> Fq12
forall a b. (a -> b) -> a -> b
$ [Int8] -> Point BLS12_381_G1 -> Point BLS12_381_G2 -> Fq12
forall {k1} {k2} (c :: k1) (d :: k2) (i :: Symbol) (j :: Symbol) g.
(Field (BaseField c), Scale (BaseField c) (BaseField d),
 Field (BaseField d), Eq (BaseField d), EllipticCurve d,
 Untwisted d i j ~ g, Field g) =>
[Int8] -> Point c -> Point d -> g
millerAlgorithmBLS12 [Int8]
param Point BLS12_381_G1
a Point BLS12_381_G2
b
      where
        param :: [Int8]
param = [-Item [Int8]
1
          ,-Item [Int8]
1, Item [Int8]
0,-Item [Int8]
1, Item [Int8]
0, Item [Int8]
0,-Item [Int8]
1, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0,-Item [Int8]
1, Item [Int8]
0
          , Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0
          , Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0,-Item [Int8]
1, Item [Int8]
0
          , Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0, Item [Int8]
0
          ]