module Morley.Tezos.Crypto.BLS12381
( Bls12381Fr
, Bls12381G1
, Bls12381G2
, CurveObject (..)
, MultiplyPoint (..)
, DeserializationError (..)
, checkPairing
, unsafeReadFromHex
, generateFrom
, g1One
, g2One
) where
import Prelude hiding (negate, one)
import Prelude qualified
import Unsafe qualified (fromIntegral)
import Control.Exception (assert)
import Control.Lens (each, toListOf)
import Control.Monad.Random (MonadRandom, evalRand, getRandom, mkStdGen)
import Data.Bits (bit, complement, setBit, testBit, (.&.))
import Data.ByteString qualified as BS
import Data.Curve qualified as C
import Data.Curve.Weierstrass qualified as CW
import Data.Curve.Weierstrass.BLS12381 qualified as CW.BLS
import Data.Field.Galois qualified as GF
import Data.Pairing.BLS12381 qualified as BLS
import Fmt (Buildable(..))
import Morley.Util.Instances ()
import Morley.Util.Named
import Text.Hex (decodeHex, encodeHex)
import Text.PrettyPrint.Leijen.Text (int, integer, (<+>))
import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDoc, renderAnyBuildable)
class CurveObject a where
zero :: a
negate :: a -> a
add :: a -> a -> a
generate :: MonadRandom m => m a
fromMichelsonBytes :: ByteString -> Either DeserializationError a
toMichelsonBytes :: a -> ByteString
generateFrom :: (CurveObject a) => Int -> a
generateFrom :: forall a. CurveObject a => Int -> a
generateFrom = Rand StdGen a -> StdGen -> a
forall g a. Rand g a -> g -> a
evalRand Rand StdGen a
forall a (m :: * -> *). (CurveObject a, MonadRandom m) => m a
generate (StdGen -> a) -> (Int -> StdGen) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StdGen
mkStdGen
unsafeReadFromHex :: (CurveObject a, HasCallStack) => String -> a
unsafeReadFromHex :: forall a. (CurveObject a, HasCallStack) => String -> a
unsafeReadFromHex String
hex =
let bs :: ByteString
bs = Text -> Maybe ByteString
decodeHex (String -> Text
forall a. ToText a => a -> Text
toText String
hex) Maybe ByteString -> ByteString -> ByteString
forall a. Maybe a -> a -> a
?: Text -> ByteString
forall a. HasCallStack => Text -> a
error Text
"bad hex"
in Either DeserializationError a -> a
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either DeserializationError a -> a)
-> Either DeserializationError a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserializationError a
forall a.
CurveObject a =>
ByteString -> Either DeserializationError a
fromMichelsonBytes ByteString
bs
class MultiplyPoint scalar point where
multiply :: scalar -> point -> point
newtype Bls12381G1 = Bls12381G1 { Bls12381G1 -> G1'
unBls12381G1 :: BLS.G1' }
deriving stock (Int -> Bls12381G1 -> ShowS
[Bls12381G1] -> ShowS
Bls12381G1 -> String
(Int -> Bls12381G1 -> ShowS)
-> (Bls12381G1 -> String)
-> ([Bls12381G1] -> ShowS)
-> Show Bls12381G1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bls12381G1] -> ShowS
$cshowList :: [Bls12381G1] -> ShowS
show :: Bls12381G1 -> String
$cshow :: Bls12381G1 -> String
showsPrec :: Int -> Bls12381G1 -> ShowS
$cshowsPrec :: Int -> Bls12381G1 -> ShowS
Show, Bls12381G1 -> Bls12381G1 -> Bool
(Bls12381G1 -> Bls12381G1 -> Bool)
-> (Bls12381G1 -> Bls12381G1 -> Bool) -> Eq Bls12381G1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bls12381G1 -> Bls12381G1 -> Bool
$c/= :: Bls12381G1 -> Bls12381G1 -> Bool
== :: Bls12381G1 -> Bls12381G1 -> Bool
$c== :: Bls12381G1 -> Bls12381G1 -> Bool
Eq)
deriving newtype (Bls12381G1 -> ()
(Bls12381G1 -> ()) -> NFData Bls12381G1
forall a. (a -> ()) -> NFData a
rnf :: Bls12381G1 -> ()
$crnf :: Bls12381G1 -> ()
NFData)
instance CurveObject Bls12381G1 where
zero :: Bls12381G1
zero = G1' -> Bls12381G1
Bls12381G1 G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r
C.id
negate :: Bls12381G1 -> Bls12381G1
negate (Bls12381G1 G1'
v) = G1' -> Bls12381G1
Bls12381G1 (G1' -> G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> Point f c e q r
C.inv G1'
v)
add :: Bls12381G1 -> Bls12381G1 -> Bls12381G1
add (Bls12381G1 G1'
a) (Bls12381G1 G1'
b) = G1' -> Bls12381G1
Bls12381G1 (G1' -> G1' -> G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> Point f c e q r -> Point f c e q r
C.add G1'
a G1'
b)
generate :: forall (m :: * -> *). MonadRandom m => m Bls12381G1
generate = G1' -> Bls12381G1
Bls12381G1 (G1' -> Bls12381G1) -> m G1' -> m Bls12381G1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r
(m :: * -> *).
(Curve f c e q r, MonadRandom m) =>
m (Point f c e q r)
C.rnd
fromMichelsonBytes :: ByteString -> Either DeserializationError Bls12381G1
fromMichelsonBytes =
let bsToCoord :: ByteString -> Fq
bsToCoord = Natural -> Fq
forall (p :: Nat). KnownNat p => Natural -> Prime p
toPrime (Natural -> Fq) -> (ByteString -> Natural) -> ByteString -> Fq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Natural
fromBigEndian
in (G1' -> Bls12381G1)
-> Either DeserializationError G1'
-> Either DeserializationError Bls12381G1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G1' -> Bls12381G1
Bls12381G1 (Either DeserializationError G1'
-> Either DeserializationError Bls12381G1)
-> (ByteString -> Either DeserializationError G1')
-> ByteString
-> Either DeserializationError Bls12381G1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (ByteString -> Fq)
-> ByteString
-> Either DeserializationError G1'
forall fq.
(WJCurve BLS12381 fq Fr, WACurve BLS12381 fq Fr) =>
Int
-> (ByteString -> fq)
-> ByteString
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
parseJA2WAPoint Int
g1CoordLen ByteString -> Fq
bsToCoord
toMichelsonBytes :: Bls12381G1 -> ByteString
toMichelsonBytes =
let coordToBs :: Fq -> ByteString
coordToBs = Int -> Natural -> ByteString
toBigEndian Int
g1CoordLen (Natural -> ByteString) -> (Fq -> Natural) -> Fq -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fq -> Natural
forall (p :: Nat). KnownNat p => Prime p -> Natural
fromPrime
in Int -> (Fq -> ByteString) -> G1' -> ByteString
forall fq.
(WJCurve BLS12381 fq Fr, WACurve BLS12381 fq Fr) =>
Int -> (fq -> ByteString) -> WAPoint BLS12381 fq Fr -> ByteString
convertWA2JAPoint Int
g1CoordLen Fq -> ByteString
coordToBs (G1' -> ByteString)
-> (Bls12381G1 -> G1') -> Bls12381G1 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bls12381G1 -> G1'
unBls12381G1
instance MultiplyPoint Integer Bls12381G1 where
multiply :: Integer -> Bls12381G1 -> Bls12381G1
multiply Integer
s (Bls12381G1 G1'
p) = G1' -> Bls12381G1
Bls12381G1 (G1' -> Integer -> G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r n.
(Curve f c e q r, Integral n) =>
Point f c e q r -> n -> Point f c e q r
C.mul' G1'
p Integer
s)
newtype Bls12381G2 = Bls12381G2 { Bls12381G2 -> G2'
unBls12381G2 :: BLS.G2' }
deriving stock (Int -> Bls12381G2 -> ShowS
[Bls12381G2] -> ShowS
Bls12381G2 -> String
(Int -> Bls12381G2 -> ShowS)
-> (Bls12381G2 -> String)
-> ([Bls12381G2] -> ShowS)
-> Show Bls12381G2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bls12381G2] -> ShowS
$cshowList :: [Bls12381G2] -> ShowS
show :: Bls12381G2 -> String
$cshow :: Bls12381G2 -> String
showsPrec :: Int -> Bls12381G2 -> ShowS
$cshowsPrec :: Int -> Bls12381G2 -> ShowS
Show, Bls12381G2 -> Bls12381G2 -> Bool
(Bls12381G2 -> Bls12381G2 -> Bool)
-> (Bls12381G2 -> Bls12381G2 -> Bool) -> Eq Bls12381G2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bls12381G2 -> Bls12381G2 -> Bool
$c/= :: Bls12381G2 -> Bls12381G2 -> Bool
== :: Bls12381G2 -> Bls12381G2 -> Bool
$c== :: Bls12381G2 -> Bls12381G2 -> Bool
Eq)
deriving newtype (Bls12381G2 -> ()
(Bls12381G2 -> ()) -> NFData Bls12381G2
forall a. (a -> ()) -> NFData a
rnf :: Bls12381G2 -> ()
$crnf :: Bls12381G2 -> ()
NFData)
instance CurveObject Bls12381G2 where
zero :: Bls12381G2
zero = G2' -> Bls12381G2
Bls12381G2 G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r
C.id
negate :: Bls12381G2 -> Bls12381G2
negate (Bls12381G2 G2'
v) = G2' -> Bls12381G2
Bls12381G2 (G2' -> G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> Point f c e q r
C.inv G2'
v)
add :: Bls12381G2 -> Bls12381G2 -> Bls12381G2
add (Bls12381G2 G2'
a) (Bls12381G2 G2'
b) = G2' -> Bls12381G2
Bls12381G2 (G2' -> G2' -> G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> Point f c e q r -> Point f c e q r
C.add G2'
a G2'
b)
generate :: forall (m :: * -> *). MonadRandom m => m Bls12381G2
generate = G2' -> Bls12381G2
Bls12381G2 (G2' -> Bls12381G2) -> m G2' -> m Bls12381G2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r
(m :: * -> *).
(Curve f c e q r, MonadRandom m) =>
m (Point f c e q r)
C.rnd
fromMichelsonBytes :: ByteString -> Either DeserializationError Bls12381G2
fromMichelsonBytes =
let fromBsPair :: ByteString -> [Natural]
fromBsPair = (ByteString -> Natural) -> [ByteString] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ByteString -> Natural
fromBigEndian ([ByteString] -> [Natural])
-> (ByteString -> [ByteString]) -> ByteString -> [Natural]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [ByteString]) (ByteString, ByteString) ByteString
-> (ByteString, ByteString) -> [ByteString]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf Getting (Endo [ByteString]) (ByteString, ByteString) ByteString
forall s t a b. Each s t a b => Traversal s t a b
each ((ByteString, ByteString) -> [ByteString])
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
g2CoordLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
bsToCoord :: ByteString -> Extension U Fq
bsToCoord = [Fq] -> Extension U Fq
forall k p. IrreducibleMonic p k => [k] -> Extension p k
GF.toE ([Fq] -> Extension U Fq)
-> (ByteString -> [Fq]) -> ByteString -> Extension U Fq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fq] -> [Fq]
forall a. [a] -> [a]
reverse ([Fq] -> [Fq]) -> (ByteString -> [Fq]) -> ByteString -> [Fq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Fq) -> [Natural] -> [Fq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Natural -> Fq
forall (p :: Nat). KnownNat p => Natural -> Prime p
toPrime ([Natural] -> [Fq])
-> (ByteString -> [Natural]) -> ByteString -> [Fq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Natural]
fromBsPair
in (G2' -> Bls12381G2)
-> Either DeserializationError G2'
-> Either DeserializationError Bls12381G2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G2' -> Bls12381G2
Bls12381G2 (Either DeserializationError G2'
-> Either DeserializationError Bls12381G2)
-> (ByteString -> Either DeserializationError G2')
-> ByteString
-> Either DeserializationError Bls12381G2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (ByteString -> Extension U Fq)
-> ByteString
-> Either DeserializationError G2'
forall fq.
(WJCurve BLS12381 fq Fr, WACurve BLS12381 fq Fr) =>
Int
-> (ByteString -> fq)
-> ByteString
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
parseJA2WAPoint Int
g2CoordLen ByteString -> Extension U Fq
bsToCoord
toMichelsonBytes :: Bls12381G2 -> ByteString
toMichelsonBytes =
let toBsPair :: [Natural] -> ByteString
toBsPair = (Element [Natural] -> ByteString) -> [Natural] -> ByteString
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap (Int -> Natural -> ByteString
toBigEndian (Int -> Natural -> ByteString) -> Int -> Natural -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
g2CoordLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
coordToBs :: Extension U Fq -> ByteString
coordToBs = [Natural] -> ByteString
toBsPair ([Natural] -> ByteString)
-> (Extension U Fq -> [Natural]) -> Extension U Fq -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fq -> Natural) -> [Fq] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Fq -> Natural
forall (p :: Nat). KnownNat p => Prime p -> Natural
fromPrime ([Fq] -> [Natural])
-> (Extension U Fq -> [Fq]) -> Extension U Fq -> [Natural]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fq] -> [Fq]
forall a. [a] -> [a]
reverse ([Fq] -> [Fq])
-> (Extension U Fq -> [Fq]) -> Extension U Fq -> [Fq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension U Fq -> [Fq]
forall k l p.
(ExtensionField k, GaloisField l, IrreducibleMonic p l,
k ~ Extension p l) =>
k -> [l]
GF.fromE
in Int -> (Extension U Fq -> ByteString) -> G2' -> ByteString
forall fq.
(WJCurve BLS12381 fq Fr, WACurve BLS12381 fq Fr) =>
Int -> (fq -> ByteString) -> WAPoint BLS12381 fq Fr -> ByteString
convertWA2JAPoint Int
g1CoordLen Extension U Fq -> ByteString
coordToBs (G2' -> ByteString)
-> (Bls12381G2 -> G2') -> Bls12381G2 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bls12381G2 -> G2'
unBls12381G2
instance MultiplyPoint Integer Bls12381G2 where
multiply :: Integer -> Bls12381G2 -> Bls12381G2
multiply Integer
s (Bls12381G2 G2'
p) = G2' -> Bls12381G2
Bls12381G2 (G2' -> Integer -> G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r n.
(Curve f c e q r, Integral n) =>
Point f c e q r -> n -> Point f c e q r
C.mul' G2'
p Integer
s)
newtype Bls12381Fr = Bls12381Fr { Bls12381Fr -> Fr
unBls12381Fr :: BLS.Fr }
deriving stock (Int -> Bls12381Fr -> ShowS
[Bls12381Fr] -> ShowS
Bls12381Fr -> String
(Int -> Bls12381Fr -> ShowS)
-> (Bls12381Fr -> String)
-> ([Bls12381Fr] -> ShowS)
-> Show Bls12381Fr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bls12381Fr] -> ShowS
$cshowList :: [Bls12381Fr] -> ShowS
show :: Bls12381Fr -> String
$cshow :: Bls12381Fr -> String
showsPrec :: Int -> Bls12381Fr -> ShowS
$cshowsPrec :: Int -> Bls12381Fr -> ShowS
Show, Bls12381Fr -> Bls12381Fr -> Bool
(Bls12381Fr -> Bls12381Fr -> Bool)
-> (Bls12381Fr -> Bls12381Fr -> Bool) -> Eq Bls12381Fr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bls12381Fr -> Bls12381Fr -> Bool
$c/= :: Bls12381Fr -> Bls12381Fr -> Bool
== :: Bls12381Fr -> Bls12381Fr -> Bool
$c== :: Bls12381Fr -> Bls12381Fr -> Bool
Eq, Eq Bls12381Fr
Eq Bls12381Fr
-> (Bls12381Fr -> Bls12381Fr -> Ordering)
-> (Bls12381Fr -> Bls12381Fr -> Bool)
-> (Bls12381Fr -> Bls12381Fr -> Bool)
-> (Bls12381Fr -> Bls12381Fr -> Bool)
-> (Bls12381Fr -> Bls12381Fr -> Bool)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> Ord Bls12381Fr
Bls12381Fr -> Bls12381Fr -> Bool
Bls12381Fr -> Bls12381Fr -> Ordering
Bls12381Fr -> Bls12381Fr -> Bls12381Fr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$cmin :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
max :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$cmax :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
>= :: Bls12381Fr -> Bls12381Fr -> Bool
$c>= :: Bls12381Fr -> Bls12381Fr -> Bool
> :: Bls12381Fr -> Bls12381Fr -> Bool
$c> :: Bls12381Fr -> Bls12381Fr -> Bool
<= :: Bls12381Fr -> Bls12381Fr -> Bool
$c<= :: Bls12381Fr -> Bls12381Fr -> Bool
< :: Bls12381Fr -> Bls12381Fr -> Bool
$c< :: Bls12381Fr -> Bls12381Fr -> Bool
compare :: Bls12381Fr -> Bls12381Fr -> Ordering
$ccompare :: Bls12381Fr -> Bls12381Fr -> Ordering
Ord)
deriving newtype (Integer -> Bls12381Fr
Bls12381Fr -> Bls12381Fr
Bls12381Fr -> Bls12381Fr -> Bls12381Fr
(Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr)
-> (Integer -> Bls12381Fr)
-> Num Bls12381Fr
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Bls12381Fr
$cfromInteger :: Integer -> Bls12381Fr
signum :: Bls12381Fr -> Bls12381Fr
$csignum :: Bls12381Fr -> Bls12381Fr
abs :: Bls12381Fr -> Bls12381Fr
$cabs :: Bls12381Fr -> Bls12381Fr
negate :: Bls12381Fr -> Bls12381Fr
$cnegate :: Bls12381Fr -> Bls12381Fr
* :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$c* :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
- :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$c- :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
+ :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$c+ :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
Num, Int -> Bls12381Fr
Bls12381Fr -> Int
Bls12381Fr -> [Bls12381Fr]
Bls12381Fr -> Bls12381Fr
Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
Bls12381Fr -> Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
(Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr)
-> (Int -> Bls12381Fr)
-> (Bls12381Fr -> Int)
-> (Bls12381Fr -> [Bls12381Fr])
-> (Bls12381Fr -> Bls12381Fr -> [Bls12381Fr])
-> (Bls12381Fr -> Bls12381Fr -> [Bls12381Fr])
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr -> [Bls12381Fr])
-> Enum Bls12381Fr
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
$cenumFromThenTo :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
enumFromTo :: Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
$cenumFromTo :: Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
enumFromThen :: Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
$cenumFromThen :: Bls12381Fr -> Bls12381Fr -> [Bls12381Fr]
enumFrom :: Bls12381Fr -> [Bls12381Fr]
$cenumFrom :: Bls12381Fr -> [Bls12381Fr]
fromEnum :: Bls12381Fr -> Int
$cfromEnum :: Bls12381Fr -> Int
toEnum :: Int -> Bls12381Fr
$ctoEnum :: Int -> Bls12381Fr
pred :: Bls12381Fr -> Bls12381Fr
$cpred :: Bls12381Fr -> Bls12381Fr
succ :: Bls12381Fr -> Bls12381Fr
$csucc :: Bls12381Fr -> Bls12381Fr
Enum, Bls12381Fr
Bls12381Fr -> Bls12381Fr -> Bounded Bls12381Fr
forall a. a -> a -> Bounded a
maxBound :: Bls12381Fr
$cmaxBound :: Bls12381Fr
minBound :: Bls12381Fr
$cminBound :: Bls12381Fr
Bounded, Num Bls12381Fr
Ord Bls12381Fr
Num Bls12381Fr
-> Ord Bls12381Fr -> (Bls12381Fr -> Rational) -> Real Bls12381Fr
Bls12381Fr -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Bls12381Fr -> Rational
$ctoRational :: Bls12381Fr -> Rational
Real, Enum Bls12381Fr
Real Bls12381Fr
Real Bls12381Fr
-> Enum Bls12381Fr
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr))
-> (Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr))
-> (Bls12381Fr -> Integer)
-> Integral Bls12381Fr
Bls12381Fr -> Integer
Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr)
Bls12381Fr -> Bls12381Fr -> Bls12381Fr
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Bls12381Fr -> Integer
$ctoInteger :: Bls12381Fr -> Integer
divMod :: Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr)
$cdivMod :: Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr)
quotRem :: Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr)
$cquotRem :: Bls12381Fr -> Bls12381Fr -> (Bls12381Fr, Bls12381Fr)
mod :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$cmod :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
div :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$cdiv :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
rem :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$crem :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
quot :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$cquot :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
Integral, Num Bls12381Fr
Num Bls12381Fr
-> (Bls12381Fr -> Bls12381Fr -> Bls12381Fr)
-> (Bls12381Fr -> Bls12381Fr)
-> (Rational -> Bls12381Fr)
-> Fractional Bls12381Fr
Rational -> Bls12381Fr
Bls12381Fr -> Bls12381Fr
Bls12381Fr -> Bls12381Fr -> Bls12381Fr
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Bls12381Fr
$cfromRational :: Rational -> Bls12381Fr
recip :: Bls12381Fr -> Bls12381Fr
$crecip :: Bls12381Fr -> Bls12381Fr
/ :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
$c/ :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
Fractional, Bls12381Fr -> ()
(Bls12381Fr -> ()) -> NFData Bls12381Fr
forall a. (a -> ()) -> NFData a
rnf :: Bls12381Fr -> ()
$crnf :: Bls12381Fr -> ()
NFData)
instance CurveObject Bls12381Fr where
zero :: Bls12381Fr
zero = Fr -> Bls12381Fr
Bls12381Fr Fr
0
negate :: Bls12381Fr -> Bls12381Fr
negate = Bls12381Fr -> Bls12381Fr
forall a. Num a => a -> a
Prelude.negate
add :: Bls12381Fr -> Bls12381Fr -> Bls12381Fr
add = Bls12381Fr -> Bls12381Fr -> Bls12381Fr
forall a. Num a => a -> a -> a
(+)
generate :: forall (m :: * -> *). MonadRandom m => m Bls12381Fr
generate = Fr -> Bls12381Fr
Bls12381Fr (Fr -> Bls12381Fr) -> m Fr -> m Bls12381Fr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Fr
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
fromMichelsonBytes :: ByteString -> Either DeserializationError Bls12381Fr
fromMichelsonBytes ByteString
bs =
if ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
frLen
then DeserializationError -> Either DeserializationError Bls12381Fr
forall a b. a -> Either a b
Left (DeserializationError -> Either DeserializationError Bls12381Fr)
-> DeserializationError -> Either DeserializationError Bls12381Fr
forall a b. (a -> b) -> a -> b
$ ("limit" :! Int) -> ("given" :! Int) -> DeserializationError
TooLargeLength (("limit" :! Int) -> ("given" :! Int) -> DeserializationError)
-> Param ("limit" :! Int)
-> ("given" :! Int)
-> DeserializationError
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "limit" (Int -> Param ("limit" :! Int))
Int -> Param ("limit" :! Int)
#limit Int
frLen (("given" :! Int) -> DeserializationError)
-> Param ("given" :! Int) -> DeserializationError
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "given" (Int -> Param ("given" :! Int))
Int -> Param ("given" :! Int)
#given (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs)
else
let num :: Natural
num = ByteString -> Natural
fromLittleEndian ByteString
bs
in Natural -> Either ArithException Bls12381Fr
forall a b.
(Integral a, Integral b) =>
a -> Either ArithException b
fromIntegralNoOverflow Natural
num
Either ArithException Bls12381Fr
-> (Either ArithException Bls12381Fr
-> Either DeserializationError Bls12381Fr)
-> Either DeserializationError Bls12381Fr
forall a b. a -> (a -> b) -> b
& (ArithException -> DeserializationError)
-> Either ArithException Bls12381Fr
-> Either DeserializationError Bls12381Fr
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ArithException
_ -> Integer -> DeserializationError
ValueOutsideOfField (Integer -> DeserializationError)
-> Integer -> DeserializationError
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
num)
toMichelsonBytes :: Bls12381Fr -> ByteString
toMichelsonBytes = Int -> Natural -> ByteString
toLittleEndian Int
frLen (Natural -> ByteString)
-> (Bls12381Fr -> Natural) -> Bls12381Fr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fr -> Natural
forall (p :: Nat). KnownNat p => Prime p -> Natural
fromPrime (Fr -> Natural) -> (Bls12381Fr -> Fr) -> Bls12381Fr -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bls12381Fr -> Fr
unBls12381Fr
instance MultiplyPoint Bls12381Fr Bls12381G1 where
multiply :: Bls12381Fr -> Bls12381G1 -> Bls12381G1
multiply (Bls12381Fr Fr
s) (Bls12381G1 G1'
p) = G1' -> Bls12381G1
Bls12381G1 (G1' -> Fr -> G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> r -> Point f c e q r
C.mul G1'
p Fr
s)
instance MultiplyPoint Bls12381Fr Bls12381G2 where
multiply :: Bls12381Fr -> Bls12381G2 -> Bls12381G2
multiply (Bls12381Fr Fr
s) (Bls12381G2 G2'
p) = G2' -> Bls12381G2
Bls12381G2 (G2' -> Fr -> G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> r -> Point f c e q r
C.mul G2'
p Fr
s)
checkPairing :: [(Bls12381G1, Bls12381G2)] -> Bool
checkPairing :: [(Bls12381G1, Bls12381G2)] -> Bool
checkPairing [(Bls12381G1, Bls12381G2)]
pairs =
(Element [(Bls12381G1, Bls12381G2)] -> GT')
-> [(Bls12381G1, Bls12381G2)] -> GT'
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap (Bls12381G1, Bls12381G2) -> GT'
Element [(Bls12381G1, Bls12381G2)] -> GT'
pairing [(Bls12381G1, Bls12381G2)]
pairs GT' -> GT' -> Bool
forall a. Eq a => a -> a -> Bool
== GT'
forall a. Monoid a => a
mempty
where
pairing :: (Bls12381G1, Bls12381G2) -> BLS.GT'
pairing :: (Bls12381G1, Bls12381G2) -> GT'
pairing (Bls12381G1 G1'
g1, Bls12381G2 G2'
g2) =
Integer -> GT BLS12381 -> GT BLS12381
forall e (q :: Nat) (r :: Nat) u v w.
ECPairing e q r u v w =>
Integer -> GT e -> GT e
BLS.finalExponentiationBLS12 Integer
BLS.parameterHex
([Int8] -> G1 BLS12381 -> G2 BLS12381 -> GT BLS12381
forall e (q :: Nat) (r :: Nat) u v w.
ECPairing e q r u v w =>
[Int8] -> G1 e -> G2 e -> GT e
BLS.millerAlgorithmBLS12 [Int8]
BLS.parameterBin G1'
G1 BLS12381
g1 G2'
G2 BLS12381
g2)
data DeserializationError
= CompressedFormIsNotSupported
| UnexpectedLength ("expected" :! Int) ("given" :! Int)
| TooLargeLength ("limit" :! Int) ("given" :! Int)
| ValueOutsideOfField Integer
| PointNotOnCurve ByteString
deriving stock (Int -> DeserializationError -> ShowS
[DeserializationError] -> ShowS
DeserializationError -> String
(Int -> DeserializationError -> ShowS)
-> (DeserializationError -> String)
-> ([DeserializationError] -> ShowS)
-> Show DeserializationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeserializationError] -> ShowS
$cshowList :: [DeserializationError] -> ShowS
show :: DeserializationError -> String
$cshow :: DeserializationError -> String
showsPrec :: Int -> DeserializationError -> ShowS
$cshowsPrec :: Int -> DeserializationError -> ShowS
Show, DeserializationError -> DeserializationError -> Bool
(DeserializationError -> DeserializationError -> Bool)
-> (DeserializationError -> DeserializationError -> Bool)
-> Eq DeserializationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeserializationError -> DeserializationError -> Bool
$c/= :: DeserializationError -> DeserializationError -> Bool
== :: DeserializationError -> DeserializationError -> Bool
$c== :: DeserializationError -> DeserializationError -> Bool
Eq, (forall x. DeserializationError -> Rep DeserializationError x)
-> (forall x. Rep DeserializationError x -> DeserializationError)
-> Generic DeserializationError
forall x. Rep DeserializationError x -> DeserializationError
forall x. DeserializationError -> Rep DeserializationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeserializationError x -> DeserializationError
$cfrom :: forall x. DeserializationError -> Rep DeserializationError x
Generic)
deriving anyclass (DeserializationError -> ()
(DeserializationError -> ()) -> NFData DeserializationError
forall a. (a -> ()) -> NFData a
rnf :: DeserializationError -> ()
$crnf :: DeserializationError -> ()
NFData)
instance Buildable DeserializationError where
build :: DeserializationError -> Builder
build = DeserializationError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc
instance RenderDoc DeserializationError where
renderDoc :: RenderContext -> DeserializationError -> Doc
renderDoc RenderContext
_ = \case
DeserializationError
CompressedFormIsNotSupported ->
Doc
"Compressed form of BLS12-381 point is not supported by Tezos"
UnexpectedLength (Name "expected" -> ("expected" :! Int) -> Int
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "expected" (Name "expected")
Name "expected"
#expected -> Int
expected) (Name "given" -> ("given" :! Int) -> Int
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "given" (Name "given")
Name "given"
#given -> Int
given) ->
Doc
"Unexpected length of BLS12-381 primitive: \
\expected" Doc -> Doc -> Doc
<+> (Int -> Doc
int Int
expected) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
", but given" Doc -> Doc -> Doc
<+> (Int -> Doc
int Int
given)
TooLargeLength (Name "limit" -> ("limit" :! Int) -> Int
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "limit" (Name "limit")
Name "limit"
#limit -> Int
limit) (Name "given" -> ("given" :! Int) -> Int
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "given" (Name "given")
Name "given"
#given -> Int
given) ->
Doc
"Too large length of BLS12-381 primitive: \
\limit is" Doc -> Doc -> Doc
<+> (Int -> Doc
int Int
limit) Doc -> Doc -> Doc
<+> Doc
", but given" Doc -> Doc -> Doc
<+> (Int -> Doc
int Int
given)
ValueOutsideOfField Integer
v ->
Doc
"Value is too large for the given field of values:" Doc -> Doc -> Doc
<+> (Integer -> Doc
integer Integer
v)
PointNotOnCurve ByteString
bs ->
Doc
"Point is not on curve: 0x" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHex ByteString
bs)
data RawPoint
= Infinity
| RawPoint ByteString
parsePointFlags
:: HasCallStack
=> ByteString -> Either DeserializationError RawPoint
parsePointFlags :: HasCallStack => ByteString -> Either DeserializationError RawPoint
parsePointFlags ByteString
bsFull =
case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bsFull of
Maybe (Word8, ByteString)
Nothing -> Text -> Either DeserializationError RawPoint
forall a. HasCallStack => Text -> a
error Text
"Empty byte sequence"
Just (Word8
b, ByteString
bs)
| Word8
b Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
compressionBit ->
DeserializationError -> Either DeserializationError RawPoint
forall a b. a -> Either a b
Left DeserializationError
CompressedFormIsNotSupported
| Word8
b Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
infinityBit ->
RawPoint -> Either DeserializationError RawPoint
forall (m :: * -> *) a. Monad m => a -> m a
return RawPoint
Infinity
| Bool
otherwise -> do
let
b' :: Word8
b' = Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8 -> Word8
forall a. Bits a => a -> a
complement
([Word8] -> Element [Word8]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([Word8] -> Element [Word8]) -> [Word8] -> Element [Word8]
forall a b. (a -> b) -> a -> b
$ (Int -> Word8) -> [Int] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Int -> Word8
forall a. Bits a => Int -> a
bit [Int
compressionBit, Int
infinityBit, Int
flag3Bit])
RawPoint -> Either DeserializationError RawPoint
forall (m :: * -> *) a. Monad m => a -> m a
return (RawPoint -> Either DeserializationError RawPoint)
-> RawPoint -> Either DeserializationError RawPoint
forall a b. (a -> b) -> a -> b
$ ByteString -> RawPoint
RawPoint (Word8 -> ByteString -> ByteString
BS.cons Word8
b' ByteString
bs)
fillPointFlags :: HasCallStack => Int -> RawPoint -> ByteString
fillPointFlags :: HasCallStack => Int -> RawPoint -> ByteString
fillPointFlags Int
0 = Text -> RawPoint -> ByteString
forall a. HasCallStack => Text -> a
error Text
"Coordinates are unexpectedly empty"
fillPointFlags Int
len = \case
RawPoint
Infinity -> Word8 -> ByteString -> ByteString
BS.cons (Word8
0 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
infinityBit) (Int -> Word8 -> ByteString
BS.replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
0)
RawPoint ByteString
bs -> ByteString
bs
splitUncompressedPoint
:: Int -> ByteString -> Either DeserializationError (ByteString, ByteString)
splitUncompressedPoint :: Int
-> ByteString
-> Either DeserializationError (ByteString, ByteString)
splitUncompressedPoint Int
coordLen ByteString
bs
| ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
coordLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 =
DeserializationError
-> Either DeserializationError (ByteString, ByteString)
forall a b. a -> Either a b
Left (DeserializationError
-> Either DeserializationError (ByteString, ByteString))
-> DeserializationError
-> Either DeserializationError (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ("expected" :! Int) -> ("given" :! Int) -> DeserializationError
UnexpectedLength (("expected" :! Int) -> ("given" :! Int) -> DeserializationError)
-> Param ("expected" :! Int)
-> ("given" :! Int)
-> DeserializationError
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "expected" (Int -> Param ("expected" :! Int))
Int -> Param ("expected" :! Int)
#expected (Int
coordLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (("given" :! Int) -> DeserializationError)
-> Param ("given" :! Int) -> DeserializationError
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "given" (Int -> Param ("given" :! Int))
Int -> Param ("given" :! Int)
#given (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bs)
| Bool
otherwise =
(ByteString, ByteString)
-> Either DeserializationError (ByteString, ByteString)
forall a b. b -> Either a b
Right ((ByteString, ByteString)
-> Either DeserializationError (ByteString, ByteString))
-> (ByteString, ByteString)
-> Either DeserializationError (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
coordLen ByteString
bs
parseJA2WAPoint
:: ( CW.BLS.WJCurve CW.BLS.BLS12381 fq BLS.Fr
, CW.BLS.WACurve CW.BLS.BLS12381 fq BLS.Fr
)
=> Int
-> (ByteString -> fq)
-> ByteString
-> Either DeserializationError (CW.BLS.WAPoint CW.BLS.BLS12381 fq BLS.Fr)
parseJA2WAPoint :: forall fq.
(WJCurve BLS12381 fq Fr, WACurve BLS12381 fq Fr) =>
Int
-> (ByteString -> fq)
-> ByteString
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
parseJA2WAPoint Int
coordLen ByteString -> fq
toCoord ByteString
full = do
(ByteString
xRawWithFlags, ByteString
yRaw) <- Int
-> ByteString
-> Either DeserializationError (ByteString, ByteString)
splitUncompressedPoint Int
coordLen ByteString
full
RawPoint
xRawPoint <- HasCallStack => ByteString -> Either DeserializationError RawPoint
ByteString -> Either DeserializationError RawPoint
parsePointFlags ByteString
xRawWithFlags
case RawPoint
xRawPoint of
RawPoint
Infinity -> WAPoint BLS12381 fq Fr
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
forall (m :: * -> *) a. Monad m => a -> m a
return WAPoint BLS12381 fq Fr
forall k (e :: k) q r. Point 'Weierstrass 'Affine e q r
CW.O
RawPoint ByteString
xRaw ->
let point :: WAPoint BLS12381 fq Fr
point = Point 'Weierstrass 'Jacobian BLS12381 fq Fr
-> WAPoint BLS12381 fq Fr
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
(Curve f c e q r, Curve f 'Affine e q r) =>
Point f c e q r -> Point f 'Affine e q r
C.toA (Point 'Weierstrass 'Jacobian BLS12381 fq Fr
-> WAPoint BLS12381 fq Fr)
-> Point 'Weierstrass 'Jacobian BLS12381 fq Fr
-> WAPoint BLS12381 fq Fr
forall a b. (a -> b) -> a -> b
$ fq -> fq -> fq -> Point 'Weierstrass 'Jacobian BLS12381 fq Fr
forall k (e :: k) q r.
q -> q -> q -> Point 'Weierstrass 'Jacobian e q r
CW.J (ByteString -> fq
toCoord ByteString
xRaw) (ByteString -> fq
toCoord ByteString
yRaw) fq
1
in if WAPoint BLS12381 fq Fr -> Bool
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
Curve f c e q r =>
Point f c e q r -> Bool
C.def WAPoint BLS12381 fq Fr
point
then WAPoint BLS12381 fq Fr
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
forall (m :: * -> *) a. Monad m => a -> m a
return WAPoint BLS12381 fq Fr
point
else DeserializationError
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
forall a b. a -> Either a b
Left (DeserializationError
-> Either DeserializationError (WAPoint BLS12381 fq Fr))
-> DeserializationError
-> Either DeserializationError (WAPoint BLS12381 fq Fr)
forall a b. (a -> b) -> a -> b
$ ByteString -> DeserializationError
PointNotOnCurve ByteString
full
convertWA2JAPoint
:: ( CW.BLS.WJCurve CW.BLS.BLS12381 fq BLS.Fr
, CW.BLS.WACurve CW.BLS.BLS12381 fq BLS.Fr
)
=> Int
-> (fq -> ByteString)
-> CW.BLS.WAPoint CW.BLS.BLS12381 fq BLS.Fr
-> ByteString
convertWA2JAPoint :: forall fq.
(WJCurve BLS12381 fq Fr, WACurve BLS12381 fq Fr) =>
Int -> (fq -> ByteString) -> WAPoint BLS12381 fq Fr -> ByteString
convertWA2JAPoint Int
coordLen fq -> ByteString
toRawCoord WAPoint BLS12381 fq Fr
point =
let
rawPoint :: RawPoint
rawPoint = case WAPoint BLS12381 fq Fr
point of
WAPoint BLS12381 fq Fr
R:PointkWeierstrassAffineeqr (*) BLS12381 fq Fr
CW.O -> RawPoint
Infinity
p :: WAPoint BLS12381 fq Fr
p@CW.A{} -> ByteString -> RawPoint
RawPoint (ByteString -> RawPoint) -> ByteString -> RawPoint
forall a b. (a -> b) -> a -> b
$
let CW.J fq
x fq
y fq
z = WAPoint BLS12381 fq Fr
-> Point 'Weierstrass 'Jacobian BLS12381 fq Fr
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
(Curve f c e q r, Curve f 'Affine e q r) =>
Point f 'Affine e q r -> Point f c e q r
C.fromA WAPoint BLS12381 fq Fr
p
in Bool -> ByteString -> ByteString
forall a. HasCallStack => Bool -> a -> a
assert (fq
z fq -> fq -> Bool
forall a. Eq a => a -> a -> Bool
== fq
1) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
fq -> ByteString
toRawCoord fq
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> fq -> ByteString
toRawCoord fq
y
in HasCallStack => Int -> RawPoint -> ByteString
Int -> RawPoint -> ByteString
fillPointFlags (Int
coordLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) RawPoint
rawPoint
fromBigEndian :: ByteString -> Natural
fromBigEndian :: ByteString -> Natural
fromBigEndian ByteString
bs =
(Natural -> Element [Word8] -> Natural)
-> Natural -> [Word8] -> Natural
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl' (\Natural
acc Element [Word8]
byte -> Natural
acc Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
0x100 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral @Word8 @Natural Word8
Element [Word8]
byte) Natural
0 ([Word8] -> Natural) -> [Word8] -> Natural
forall a b. (a -> b) -> a -> b
$
ByteString -> [Word8]
BS.unpack ByteString
bs
fromLittleEndian :: ByteString -> Natural
fromLittleEndian :: ByteString -> Natural
fromLittleEndian ByteString
bs =
[Natural] -> Natural
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([Natural] -> Natural)
-> ([Word8] -> [Natural]) -> [Word8] -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> Natural)
-> [Natural] -> [Natural] -> [Natural]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(*) ((Natural -> Natural) -> Natural -> [Natural]
forall a. (a -> a) -> a -> [a]
iterate (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
0x100) Natural
1) ([Natural] -> [Natural])
-> ([Word8] -> [Natural]) -> [Word8] -> [Natural]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Natural) -> [Word8] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral @Word8 @Natural) ([Word8] -> Natural) -> [Word8] -> Natural
forall a b. (a -> b) -> a -> b
$
ByteString -> [Word8]
BS.unpack ByteString
bs
toBigEndian :: Int -> Natural -> ByteString
toBigEndian :: Int -> Natural -> ByteString
toBigEndian Int
len Natural
num =
[Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$
let
(Natural
remainder, [Word8]
bytes) = (Natural -> Int -> (Natural, Word8))
-> Natural -> [Int] -> (Natural, [Word8])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR
(\Natural
x Int
_ -> (Natural -> Word8) -> (Natural, Natural) -> (Natural, Word8)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word8) ((Natural, Natural) -> (Natural, Word8))
-> (Natural, Natural) -> (Natural, Word8)
forall a b. (a -> b) -> a -> b
$ Natural
x Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Natural
0x100)
Natural
num [Int
1 .. Int
len]
in Bool -> [Word8] -> [Word8]
forall a. HasCallStack => Bool -> a -> a
assert (Natural
remainder Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0) [Word8]
bytes
toLittleEndian :: Int -> Natural -> ByteString
toLittleEndian :: Int -> Natural -> ByteString
toLittleEndian Int
len Natural
num =
[Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$
let
(Natural
remainder, [Word8]
bytes) = (Natural -> Int -> (Natural, Word8))
-> Natural -> [Int] -> (Natural, [Word8])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
(\Natural
x Int
_ -> (Natural -> Word8) -> (Natural, Natural) -> (Natural, Word8)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word8) ((Natural, Natural) -> (Natural, Word8))
-> (Natural, Natural) -> (Natural, Word8)
forall a b. (a -> b) -> a -> b
$ Natural
x Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Natural
0x100)
Natural
num [Int
1 .. Int
len]
in Bool -> [Word8] -> [Word8]
forall a. HasCallStack => Bool -> a -> a
assert (Natural
remainder Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0) [Word8]
bytes
fromPrime :: forall p. KnownNat p => GF.Prime p -> Natural
fromPrime :: forall (p :: Nat). KnownNat p => Prime p -> Natural
fromPrime Prime p
p =
Bool -> Natural -> Natural
forall a. HasCallStack => Bool -> a -> a
assert (Prime p
p Prime p -> Prime p -> Bool
forall a. Ord a => a -> a -> Bool
>= Prime p
0) (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @(GF.Prime p) @Natural Prime p
p
toPrime :: KnownNat p => Natural -> GF.Prime p
toPrime :: forall (p :: Nat). KnownNat p => Natural -> Prime p
toPrime = Natural -> Prime p
forall a b. (Integral a, Num b) => a -> b
fromIntegralOverflowing
g1CoordLen, g2CoordLen :: Int
g1CoordLen :: Int
g1CoordLen = Int
48
g2CoordLen :: Int
g2CoordLen = Int
96
frLen :: Int
frLen :: Int
frLen = Int
32
compressionBit :: Int
compressionBit :: Int
compressionBit = Int
7
infinityBit :: Int
infinityBit :: Int
infinityBit = Int
6
flag3Bit :: Int
flag3Bit :: Int
flag3Bit = Int
5
g1One :: Bls12381G1
g1One :: Bls12381G1
g1One = G1' -> Bls12381G1
Bls12381G1 (G1' -> Bls12381G1) -> G1' -> Bls12381G1
forall a b. (a -> b) -> a -> b
$ Point 'Weierstrass 'Jacobian BLS12381 Fq Fr -> G1'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
(Curve f c e q r, Curve f 'Affine e q r) =>
Point f c e q r -> Point f 'Affine e q r
CW.toA (Point 'Weierstrass 'Jacobian BLS12381 Fq Fr -> G1')
-> Point 'Weierstrass 'Jacobian BLS12381 Fq Fr -> G1'
forall a b. (a -> b) -> a -> b
$ Fq -> Fq -> Fq -> Point 'Weierstrass 'Jacobian BLS12381 Fq Fr
forall k (e :: k) q r.
q -> q -> q -> Point 'Weierstrass 'Jacobian e q r
CW.J
Fq
3685416753713387016781088315183077757961620795782546409894578378688607592378376318836054947676345821548104185464507
Fq
1339506544944476473020471379941921221584933875938349620426543736416511423956333506472724655353366534992391756441569
Fq
1
g2One :: Bls12381G2
g2One :: Bls12381G2
g2One = G2' -> Bls12381G2
Bls12381G2 (G2' -> Bls12381G2) -> G2' -> Bls12381G2
forall a b. (a -> b) -> a -> b
$ Point 'Weierstrass 'Jacobian BLS12381 (Extension U Fq) Fr -> G2'
forall {k} (f :: Form) (c :: Coordinates) (e :: k) q r.
(Curve f c e q r, Curve f 'Affine e q r) =>
Point f c e q r -> Point f 'Affine e q r
CW.toA (Point 'Weierstrass 'Jacobian BLS12381 (Extension U Fq) Fr -> G2')
-> Point 'Weierstrass 'Jacobian BLS12381 (Extension U Fq) Fr -> G2'
forall a b. (a -> b) -> a -> b
$ Extension U Fq
-> Extension U Fq
-> Extension U Fq
-> Point 'Weierstrass 'Jacobian BLS12381 (Extension U Fq) Fr
forall k (e :: k) q r.
q -> q -> q -> Point 'Weierstrass 'Jacobian e q r
CW.J
([Fq] -> Extension U Fq
forall k p. IrreducibleMonic p k => [k] -> Extension p k
GF.toE
[ Fq
352701069587466618187139116011060144890029952792775240219908644239793785735715026873347600343865175952761926303160
, Fq
3059144344244213709971259814753781636986470325476647558659373206291635324768958432433509563104347017837885763365758
])
([Fq] -> Extension U Fq
forall k p. IrreducibleMonic p k => [k] -> Extension p k
GF.toE
[ Fq
1985150602287291935568054521177171638300868978215655730859378665066344726373823718423869104263333984641494340347905
, Fq
927553665492332455747201965776037880757740193453592970025027978793976877002675564980949289727957565575433344219582
])
([Fq] -> Extension U Fq
forall k p. IrreducibleMonic p k => [k] -> Extension p k
GF.toE [Fq
1, Fq
0])