{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
module PlutusCore.Crypto.BLS12_381.Pairing
(
MlResult (..),
millerLoop,
mulMlResult,
finalVerify,
mlResultMemSizeBytes,
identityMlResult
) where
import Cardano.Crypto.EllipticCurve.BLS12_381 qualified as BlstBindings
import Cardano.Crypto.EllipticCurve.BLS12_381.Internal qualified as BlstBindings.Internal
import PlutusCore.Crypto.BLS12_381.G1 qualified as G1
import PlutusCore.Crypto.BLS12_381.G2 qualified as G2
import PlutusCore.Pretty.PrettyConst (ConstConfig)
import Text.PrettyBy (PrettyBy, prettyBy)
import Control.DeepSeq (NFData, rnf)
import Data.Coerce (coerce)
import Data.Hashable
import Flat
import Prettyprinter
newtype MlResult = MlResult { MlResult -> PT
unMlResult :: BlstBindings.PT }
deriving newtype (MlResult -> MlResult -> Bool
(MlResult -> MlResult -> Bool)
-> (MlResult -> MlResult -> Bool) -> Eq MlResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MlResult -> MlResult -> Bool
== :: MlResult -> MlResult -> Bool
$c/= :: MlResult -> MlResult -> Bool
/= :: MlResult -> MlResult -> Bool
Eq)
instance Show MlResult where
show :: MlResult -> String
show MlResult
_ = String
"<opaque>"
instance Pretty MlResult where
pretty :: forall ann. MlResult -> Doc ann
pretty = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (MlResult -> String) -> MlResult -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MlResult -> String
forall a. Show a => a -> String
show
instance PrettyBy ConstConfig MlResult where
prettyBy :: forall ann. ConstConfig -> MlResult -> Doc ann
prettyBy ConstConfig
_ = MlResult -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MlResult -> Doc ann
pretty
instance Flat MlResult where
decode :: Get MlResult
decode = String -> Get MlResult
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Flat decoding is not supported for objects of type bls12_381_mlresult"
encode :: MlResult -> Encoding
encode = String -> MlResult -> Encoding
forall a. HasCallStack => String -> a
error String
"Flat encoding is not supported for objects of type bls12_381_mlresult"
size :: MlResult -> Int -> Int
size MlResult
_ = Int -> Int
forall a. a -> a
id
instance NFData MlResult where
rnf :: MlResult -> ()
rnf MlResult
_ = ()
instance Hashable MlResult where
hashWithSalt :: Int -> MlResult -> Int
hashWithSalt Int
salt = Int -> MlResult -> Int
forall a b. a -> b -> a
const Int
salt
millerLoop :: G1.Element -> G2.Element -> MlResult
millerLoop :: Element -> Element -> MlResult
millerLoop = (Point1 -> Point2 -> PT) -> Element -> Element -> MlResult
forall a b. Coercible a b => a -> b
coerce Point1 -> Point2 -> PT
BlstBindings.millerLoop
mulMlResult :: MlResult -> MlResult -> MlResult
mulMlResult :: MlResult -> MlResult -> MlResult
mulMlResult = (PT -> PT -> PT) -> MlResult -> MlResult -> MlResult
forall a b. Coercible a b => a -> b
coerce PT -> PT -> PT
BlstBindings.ptMult
finalVerify :: MlResult -> MlResult -> Bool
finalVerify :: MlResult -> MlResult -> Bool
finalVerify = (PT -> PT -> Bool) -> MlResult -> MlResult -> Bool
forall a b. Coercible a b => a -> b
coerce PT -> PT -> Bool
BlstBindings.ptFinalVerify
mlResultMemSizeBytes :: Int
mlResultMemSizeBytes :: Int
mlResultMemSizeBytes = Int
BlstBindings.Internal.sizePT
identityMlResult :: MlResult
identityMlResult :: MlResult
identityMlResult = Element -> Element -> MlResult
millerLoop Element
G1.offchain_zero Element
G2.offchain_zero