{-# 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

{- | This type represents the result of computing a pairing using the Miller
   loop.  Values of this type are ephemeral, only created during script
   execution.  We do not provide any means of serialising, deserialising,
   printing, or parsing MlResult values. -}
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
-- We need a Flat instance to get everything to build properly; however we'll
-- never want MlResult values in serialised scripts, so the decoding and
-- encoding functions just raise errors.
instance Flat MlResult where
    -- This might happen on the chain, so `fail` rather than `error`.
    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"
    -- This will be a Haskell runtime error, but encoding doesn't happen on chain,
    -- so it's not too bad.
    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


-- Not exposed as builtins

-- | Memory usage of an MlResult point (576 bytes)
mlResultMemSizeBytes :: Int
mlResultMemSizeBytes :: Int
mlResultMemSizeBytes = Int
BlstBindings.Internal.sizePT

-- | For some of the tests we need a small element of the MlResult type.  We can
-- get the identity element by pairing the zero elements of G1 and G2.
identityMlResult :: MlResult
identityMlResult :: MlResult
identityMlResult = Element -> Element -> MlResult
millerLoop Element
G1.offchain_zero Element
G2.offchain_zero