{-# 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
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
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)
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)
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'
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
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')
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
]