{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Crypto.DSIGN.BLS12381 (
  BLS12381DSIGN,
  BLS12381MinVerKeyDSIGN,
  BLS12381MinSigDSIGN,
  BLS12381CurveConstraints,
  VerKeyDSIGN (..),
  SignKeyDSIGN (..),
  SigDSIGN (..),
  PossessionProofDSIGN (..),
  BLS12381SignContext (..),
) where

#include "blst_util.h"

import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (encodedSizeExpr, toCBOR))
import Cardano.Crypto.DSIGN.Class (
  DSIGNAggregatable (..),
  DSIGNAlgorithm (
    ContextDSIGN,
    KeyGenContextDSIGN,
    SeedSizeDSIGN,
    SigDSIGN,
    SigSizeDSIGN,
    SignKeyDSIGN,
    SignKeySizeDSIGN,
    Signable,
    VerKeyDSIGN,
    VerKeySizeDSIGN,
    algorithmNameDSIGN,
    deriveVerKeyDSIGN,
    genKeyDSIGN,
    genKeyDSIGNWithContext,
    rawDeserialiseSigDSIGN,
    rawDeserialiseSignKeyDSIGN,
    rawDeserialiseVerKeyDSIGN,
    rawSerialiseSigDSIGN,
    rawSerialiseSignKeyDSIGN,
    rawSerialiseVerKeyDSIGN,
    signDSIGN,
    verifyDSIGN
  ),
  decodePossessionProofDSIGN,
  decodeSigDSIGN,
  decodeSignKeyDSIGN,
  decodeVerKeyDSIGN,
  encodePossessionProofDSIGN,
  encodeSigDSIGN,
  encodeSignKeyDSIGN,
  encodeVerKeyDSIGN,
  encodedPossessionProofDSIGNSizeExpr,
  encodedSigDSIGNSizeExpr,
  encodedSignKeyDSIGNSizeExpr,
  encodedVerKeyDSIGNSizeExpr,
  seedSizeDSIGN,
 )
import Cardano.Crypto.EllipticCurve.BLS12_381.Internal (
  BLS (..),
  BLSTError (..),
  CompressedPointSize,
  Curve1,
  Curve2,
  DualCurve,
  Point (..),
  Scalar (..),
  ScalarPtr (..),
  blsAddOrDouble,
  blsCompress,
  blsGenerator,
  blsHash,
  blsIsInf,
  blsMult,
  blsUncompress,
  blsZero,
  c_blst_keygen,
  compressedSizePoint,
  finalVerifyPairs,
  mkBLSTError,
  scalarFromBS,
  scalarToBS,
  scalarToInteger,
  toAffine,
  withAffine,
  withMaybeCStringLen,
  withNewPoint',
  withNewPoint_,
 )
import Cardano.Crypto.Libsodium.C (c_sodium_compare)
import Cardano.Crypto.PinnedSizedBytes (
  psbCreate,
  psbUseAsCPtr,
 )
import Cardano.Crypto.Seed (getBytesFromSeedT)
import Cardano.Crypto.Util (SignableRepresentation (getSignableRepresentation))
import Control.DeepSeq (NFData)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Data (Typeable)
import qualified Data.Foldable as F (foldl')
import Data.Kind (Type)
import Data.Proxy (Proxy (Proxy))
import Foreign.C.Types
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import GHC.TypeNats (KnownNat, type (+))
import NoThunks.Class (NoThunks)
import System.IO.Unsafe (unsafeDupablePerformIO)

data BLS12381DSIGN curve

-- Making sure different 'Signature schemes are not 'Coercible', which would ruin the
-- intended type safety:
type role BLS12381DSIGN nominal

-- | Two versions of BLS12-381 DSIGN: one optimized for minimal verification key size,
-- the other for minimal signature size.
type BLS12381MinVerKeyDSIGN = BLS12381DSIGN Curve1

type BLS12381MinSigDSIGN = BLS12381DSIGN Curve2

type family CurveVariant (c :: Type) :: Symbol where
  CurveVariant Curve1 = "BLS-Signature-Mininimal-Verification-Key-Size"
  CurveVariant Curve2 = "BLS-Signature-Mininimal-Signature-Size"

data BLS12381SignContext = BLS12381SignContext
  { BLS12381SignContext -> Maybe ByteString
blsSignContextDst :: !(Maybe ByteString)
  , BLS12381SignContext -> Maybe ByteString
blsSignContextAug :: !(Maybe ByteString)
  }
  deriving stock (Int -> BLS12381SignContext -> ShowS
[BLS12381SignContext] -> ShowS
BLS12381SignContext -> String
(Int -> BLS12381SignContext -> ShowS)
-> (BLS12381SignContext -> String)
-> ([BLS12381SignContext] -> ShowS)
-> Show BLS12381SignContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BLS12381SignContext -> ShowS
showsPrec :: Int -> BLS12381SignContext -> ShowS
$cshow :: BLS12381SignContext -> String
show :: BLS12381SignContext -> String
$cshowList :: [BLS12381SignContext] -> ShowS
showList :: [BLS12381SignContext] -> ShowS
Show, BLS12381SignContext -> BLS12381SignContext -> Bool
(BLS12381SignContext -> BLS12381SignContext -> Bool)
-> (BLS12381SignContext -> BLS12381SignContext -> Bool)
-> Eq BLS12381SignContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BLS12381SignContext -> BLS12381SignContext -> Bool
== :: BLS12381SignContext -> BLS12381SignContext -> Bool
$c/= :: BLS12381SignContext -> BLS12381SignContext -> Bool
/= :: BLS12381SignContext -> BLS12381SignContext -> Bool
Eq, (forall x. BLS12381SignContext -> Rep BLS12381SignContext x)
-> (forall x. Rep BLS12381SignContext x -> BLS12381SignContext)
-> Generic BLS12381SignContext
forall x. Rep BLS12381SignContext x -> BLS12381SignContext
forall x. BLS12381SignContext -> Rep BLS12381SignContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BLS12381SignContext -> Rep BLS12381SignContext x
from :: forall x. BLS12381SignContext -> Rep BLS12381SignContext x
$cto :: forall x. Rep BLS12381SignContext x -> BLS12381SignContext
to :: forall x. Rep BLS12381SignContext x -> BLS12381SignContext
Generic)
  deriving anyclass (BLS12381SignContext -> ()
(BLS12381SignContext -> ()) -> NFData BLS12381SignContext
forall a. (a -> ()) -> NFData a
$crnf :: BLS12381SignContext -> ()
rnf :: BLS12381SignContext -> ()
NFData, Context -> BLS12381SignContext -> IO (Maybe ThunkInfo)
Proxy BLS12381SignContext -> String
(Context -> BLS12381SignContext -> IO (Maybe ThunkInfo))
-> (Context -> BLS12381SignContext -> IO (Maybe ThunkInfo))
-> (Proxy BLS12381SignContext -> String)
-> NoThunks BLS12381SignContext
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BLS12381SignContext -> IO (Maybe ThunkInfo)
noThunks :: Context -> BLS12381SignContext -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BLS12381SignContext -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BLS12381SignContext -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BLS12381SignContext -> String
showTypeOf :: Proxy BLS12381SignContext -> String
NoThunks)

type BLS12381CurveConstraints curve =
  ( BLS curve
  , BLS (DualCurve curve)
  , KnownSymbol (CurveVariant curve)
  , KnownNat (CompressedPointSize curve)
  , KnownNat (CompressedPointSize (DualCurve curve))
  , Typeable curve
  )

instance
  BLS12381CurveConstraints curve =>
  DSIGNAlgorithm (BLS12381DSIGN curve)
  where
  type SeedSizeDSIGN (BLS12381DSIGN curve) = CARDANO_BLST_SCALAR_SIZE
  type SignKeySizeDSIGN (BLS12381DSIGN curve) = CARDANO_BLST_SCALAR_SIZE

  -- These *Sizes* are used in the serialization/deserialization
  -- so these use the compressed sizes of the BLS12-381 `Point curve`
  type VerKeySizeDSIGN (BLS12381DSIGN curve) = CompressedPointSize curve
  type SigSizeDSIGN (BLS12381DSIGN curve) = CompressedPointSize (DualCurve curve)
  type Signable (BLS12381DSIGN curve) = SignableRepresentation

  -- Context can hold domain separation tag and/or augmentation data for signatures
  type ContextDSIGN (BLS12381DSIGN curve) = BLS12381SignContext
  type KeyGenContextDSIGN (BLS12381DSIGN curve) = Maybe ByteString

  newtype VerKeyDSIGN (BLS12381DSIGN curve)
    = -- Note that the internal representation is the uncompressed point size
      VerKeyBLS12381 (Point curve)
    deriving newtype (VerKeyDSIGN (BLS12381DSIGN curve) -> ()
(VerKeyDSIGN (BLS12381DSIGN curve) -> ())
-> NFData (VerKeyDSIGN (BLS12381DSIGN curve))
forall curve. VerKeyDSIGN (BLS12381DSIGN curve) -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall curve. VerKeyDSIGN (BLS12381DSIGN curve) -> ()
rnf :: VerKeyDSIGN (BLS12381DSIGN curve) -> ()
NFData)
    deriving stock (Int -> VerKeyDSIGN (BLS12381DSIGN curve) -> ShowS
[VerKeyDSIGN (BLS12381DSIGN curve)] -> ShowS
VerKeyDSIGN (BLS12381DSIGN curve) -> String
(Int -> VerKeyDSIGN (BLS12381DSIGN curve) -> ShowS)
-> (VerKeyDSIGN (BLS12381DSIGN curve) -> String)
-> ([VerKeyDSIGN (BLS12381DSIGN curve)] -> ShowS)
-> Show (VerKeyDSIGN (BLS12381DSIGN curve))
forall curve. Int -> VerKeyDSIGN (BLS12381DSIGN curve) -> ShowS
forall curve. [VerKeyDSIGN (BLS12381DSIGN curve)] -> ShowS
forall curve. VerKeyDSIGN (BLS12381DSIGN curve) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall curve. Int -> VerKeyDSIGN (BLS12381DSIGN curve) -> ShowS
showsPrec :: Int -> VerKeyDSIGN (BLS12381DSIGN curve) -> ShowS
$cshow :: forall curve. VerKeyDSIGN (BLS12381DSIGN curve) -> String
show :: VerKeyDSIGN (BLS12381DSIGN curve) -> String
$cshowList :: forall curve. [VerKeyDSIGN (BLS12381DSIGN curve)] -> ShowS
showList :: [VerKeyDSIGN (BLS12381DSIGN curve)] -> ShowS
Show, (forall x.
 VerKeyDSIGN (BLS12381DSIGN curve)
 -> Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x)
-> (forall x.
    Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
    -> VerKeyDSIGN (BLS12381DSIGN curve))
-> Generic (VerKeyDSIGN (BLS12381DSIGN curve))
forall x.
Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
-> VerKeyDSIGN (BLS12381DSIGN curve)
forall x.
VerKeyDSIGN (BLS12381DSIGN curve)
-> Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall curve x.
Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
-> VerKeyDSIGN (BLS12381DSIGN curve)
forall curve x.
VerKeyDSIGN (BLS12381DSIGN curve)
-> Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
$cfrom :: forall curve x.
VerKeyDSIGN (BLS12381DSIGN curve)
-> Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
from :: forall x.
VerKeyDSIGN (BLS12381DSIGN curve)
-> Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
$cto :: forall curve x.
Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
-> VerKeyDSIGN (BLS12381DSIGN curve)
to :: forall x.
Rep (VerKeyDSIGN (BLS12381DSIGN curve)) x
-> VerKeyDSIGN (BLS12381DSIGN curve)
Generic)
    deriving anyclass (Context
-> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> String
(Context
 -> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo))
-> (Context
    -> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo))
-> (Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> String)
-> NoThunks (VerKeyDSIGN (BLS12381DSIGN curve))
forall curve.
Context
-> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
forall curve. Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall curve.
Context
-> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall curve.
Context
-> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> VerKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall curve. Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> String
showTypeOf :: Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> String
NoThunks)

  newtype SignKeyDSIGN (BLS12381DSIGN curve)
    = SignKeyBLS12381 Scalar
    deriving newtype (SignKeyDSIGN (BLS12381DSIGN curve) -> ()
(SignKeyDSIGN (BLS12381DSIGN curve) -> ())
-> NFData (SignKeyDSIGN (BLS12381DSIGN curve))
forall curve. SignKeyDSIGN (BLS12381DSIGN curve) -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall curve. SignKeyDSIGN (BLS12381DSIGN curve) -> ()
rnf :: SignKeyDSIGN (BLS12381DSIGN curve) -> ()
NFData)
    deriving stock ((forall x.
 SignKeyDSIGN (BLS12381DSIGN curve)
 -> Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x)
-> (forall x.
    Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
    -> SignKeyDSIGN (BLS12381DSIGN curve))
-> Generic (SignKeyDSIGN (BLS12381DSIGN curve))
forall x.
Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
-> SignKeyDSIGN (BLS12381DSIGN curve)
forall x.
SignKeyDSIGN (BLS12381DSIGN curve)
-> Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall curve x.
Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
-> SignKeyDSIGN (BLS12381DSIGN curve)
forall curve x.
SignKeyDSIGN (BLS12381DSIGN curve)
-> Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
$cfrom :: forall curve x.
SignKeyDSIGN (BLS12381DSIGN curve)
-> Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
from :: forall x.
SignKeyDSIGN (BLS12381DSIGN curve)
-> Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
$cto :: forall curve x.
Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
-> SignKeyDSIGN (BLS12381DSIGN curve)
to :: forall x.
Rep (SignKeyDSIGN (BLS12381DSIGN curve)) x
-> SignKeyDSIGN (BLS12381DSIGN curve)
Generic)
    deriving anyclass (Context
-> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> String
(Context
 -> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo))
-> (Context
    -> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo))
-> (Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> String)
-> NoThunks (SignKeyDSIGN (BLS12381DSIGN curve))
forall curve.
Context
-> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
forall curve. Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall curve.
Context
-> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall curve.
Context
-> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> SignKeyDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall curve. Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> String
showTypeOf :: Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> String
NoThunks)

  newtype SigDSIGN (BLS12381DSIGN curve)
    = -- Note that the internal representation is the uncompressed point size
      SigBLS12381 (Point (DualCurve curve))
    deriving newtype (SigDSIGN (BLS12381DSIGN curve) -> ()
(SigDSIGN (BLS12381DSIGN curve) -> ())
-> NFData (SigDSIGN (BLS12381DSIGN curve))
forall curve. SigDSIGN (BLS12381DSIGN curve) -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall curve. SigDSIGN (BLS12381DSIGN curve) -> ()
rnf :: SigDSIGN (BLS12381DSIGN curve) -> ()
NFData)
    deriving stock (Int -> SigDSIGN (BLS12381DSIGN curve) -> ShowS
[SigDSIGN (BLS12381DSIGN curve)] -> ShowS
SigDSIGN (BLS12381DSIGN curve) -> String
(Int -> SigDSIGN (BLS12381DSIGN curve) -> ShowS)
-> (SigDSIGN (BLS12381DSIGN curve) -> String)
-> ([SigDSIGN (BLS12381DSIGN curve)] -> ShowS)
-> Show (SigDSIGN (BLS12381DSIGN curve))
forall curve. Int -> SigDSIGN (BLS12381DSIGN curve) -> ShowS
forall curve. [SigDSIGN (BLS12381DSIGN curve)] -> ShowS
forall curve. SigDSIGN (BLS12381DSIGN curve) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall curve. Int -> SigDSIGN (BLS12381DSIGN curve) -> ShowS
showsPrec :: Int -> SigDSIGN (BLS12381DSIGN curve) -> ShowS
$cshow :: forall curve. SigDSIGN (BLS12381DSIGN curve) -> String
show :: SigDSIGN (BLS12381DSIGN curve) -> String
$cshowList :: forall curve. [SigDSIGN (BLS12381DSIGN curve)] -> ShowS
showList :: [SigDSIGN (BLS12381DSIGN curve)] -> ShowS
Show, (forall x.
 SigDSIGN (BLS12381DSIGN curve)
 -> Rep (SigDSIGN (BLS12381DSIGN curve)) x)
-> (forall x.
    Rep (SigDSIGN (BLS12381DSIGN curve)) x
    -> SigDSIGN (BLS12381DSIGN curve))
-> Generic (SigDSIGN (BLS12381DSIGN curve))
forall x.
Rep (SigDSIGN (BLS12381DSIGN curve)) x
-> SigDSIGN (BLS12381DSIGN curve)
forall x.
SigDSIGN (BLS12381DSIGN curve)
-> Rep (SigDSIGN (BLS12381DSIGN curve)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall curve x.
Rep (SigDSIGN (BLS12381DSIGN curve)) x
-> SigDSIGN (BLS12381DSIGN curve)
forall curve x.
SigDSIGN (BLS12381DSIGN curve)
-> Rep (SigDSIGN (BLS12381DSIGN curve)) x
$cfrom :: forall curve x.
SigDSIGN (BLS12381DSIGN curve)
-> Rep (SigDSIGN (BLS12381DSIGN curve)) x
from :: forall x.
SigDSIGN (BLS12381DSIGN curve)
-> Rep (SigDSIGN (BLS12381DSIGN curve)) x
$cto :: forall curve x.
Rep (SigDSIGN (BLS12381DSIGN curve)) x
-> SigDSIGN (BLS12381DSIGN curve)
to :: forall x.
Rep (SigDSIGN (BLS12381DSIGN curve)) x
-> SigDSIGN (BLS12381DSIGN curve)
Generic)
    deriving anyclass (Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
Proxy (SigDSIGN (BLS12381DSIGN curve)) -> String
(Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo))
-> (Context
    -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo))
-> (Proxy (SigDSIGN (BLS12381DSIGN curve)) -> String)
-> NoThunks (SigDSIGN (BLS12381DSIGN curve))
forall curve.
Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
forall curve. Proxy (SigDSIGN (BLS12381DSIGN curve)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall curve.
Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall curve.
Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SigDSIGN (BLS12381DSIGN curve) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall curve. Proxy (SigDSIGN (BLS12381DSIGN curve)) -> String
showTypeOf :: Proxy (SigDSIGN (BLS12381DSIGN curve)) -> String
NoThunks)

  algorithmNameDSIGN :: forall (proxy :: * -> *). proxy (BLS12381DSIGN curve) -> String
algorithmNameDSIGN proxy (BLS12381DSIGN curve)
_ = String
"bls12-381-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy (CurveVariant curve) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(CurveVariant curve))

  {-# INLINE deriveVerKeyDSIGN #-}
  deriveVerKeyDSIGN :: SignKeyDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
deriveVerKeyDSIGN (SignKeyBLS12381 (Scalar PinnedSizedBytes 32
skPsb)) = do
    Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
forall curve. Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
VerKeyBLS12381 (Point curve -> VerKeyDSIGN (BLS12381DSIGN curve))
-> Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
forall a b. (a -> b) -> a -> b
$ IO (Point curve) -> Point curve
forall a. IO a -> a
unsafeDupablePerformIO (IO (Point curve) -> Point curve)
-> ((Ptr Word8 -> IO (Point curve)) -> IO (Point curve))
-> (Ptr Word8 -> IO (Point curve))
-> Point curve
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes 32
-> (Ptr Word8 -> IO (Point curve)) -> IO (Point curve)
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes 32
skPsb ((Ptr Word8 -> IO (Point curve)) -> Point curve)
-> (Ptr Word8 -> IO (Point curve)) -> Point curve
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
skp ->
      forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' @curve ((PointPtr curve -> IO ()) -> IO (Point curve))
-> (PointPtr curve -> IO ()) -> IO (Point curve)
forall a b. (a -> b) -> a -> b
$ \PointPtr curve
vkPtp -> do
        forall curve. BLS curve => PointPtr curve -> ScalarPtr -> IO ()
c_blst_sk_to_pk @curve PointPtr curve
vkPtp (Ptr Word8 -> ScalarPtr
ScalarPtr Ptr Word8
skp)

  {-# INLINE signDSIGN #-}
  signDSIGN :: forall a.
(Signable (BLS12381DSIGN curve) a, HasCallStack) =>
ContextDSIGN (BLS12381DSIGN curve)
-> a
-> SignKeyDSIGN (BLS12381DSIGN curve)
-> SigDSIGN (BLS12381DSIGN curve)
signDSIGN BLS12381SignContext {blsSignContextDst :: BLS12381SignContext -> Maybe ByteString
blsSignContextDst = Maybe ByteString
dst, blsSignContextAug :: BLS12381SignContext -> Maybe ByteString
blsSignContextAug = Maybe ByteString
aug} a
msg (SignKeyBLS12381 (Scalar PinnedSizedBytes 32
skPsb)) =
    Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
SigBLS12381 (Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve))
-> Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
forall a b. (a -> b) -> a -> b
$ IO (Point (DualCurve curve)) -> Point (DualCurve curve)
forall a. IO a -> a
unsafeDupablePerformIO (IO (Point (DualCurve curve)) -> Point (DualCurve curve))
-> IO (Point (DualCurve curve)) -> Point (DualCurve curve)
forall a b. (a -> b) -> a -> b
$ do
      PinnedSizedBytes 32
-> (Ptr Word8 -> IO (Point (DualCurve curve)))
-> IO (Point (DualCurve curve))
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes 32
skPsb ((Ptr Word8 -> IO (Point (DualCurve curve)))
 -> IO (Point (DualCurve curve)))
-> (Ptr Word8 -> IO (Point (DualCurve curve)))
-> IO (Point (DualCurve curve))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
skPtp -> do
        forall curve a. BLS curve => (PointPtr curve -> IO a) -> IO a
withNewPoint_ @(DualCurve curve) ((PointPtr (DualCurve curve) -> IO (Point (DualCurve curve)))
 -> IO (Point (DualCurve curve)))
-> (PointPtr (DualCurve curve) -> IO (Point (DualCurve curve)))
-> IO (Point (DualCurve curve))
forall a b. (a -> b) -> a -> b
$ \PointPtr (DualCurve curve)
hashPtr -> do
          Maybe ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
dst ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
dstPtr, Int
dstLen) ->
            Maybe ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
aug ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
augPtr, Int
augLen) ->
              ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen (a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
msg) ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
msgPtr, Int
msgLen) ->
                forall curve.
BLS curve =>
PointPtr curve
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO ()
c_blst_hash @(DualCurve curve)
                  PointPtr (DualCurve curve)
hashPtr
                  Ptr CChar
msgPtr
                  (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
msgLen)
                  Ptr CChar
dstPtr
                  (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
dstLen)
                  Ptr CChar
augPtr
                  (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
augLen)
          forall curve a.
BLS curve =>
(PointPtr curve -> IO a) -> IO (Point curve)
withNewPoint' @(DualCurve curve) ((PointPtr (DualCurve curve) -> IO ())
 -> IO (Point (DualCurve curve)))
-> (PointPtr (DualCurve curve) -> IO ())
-> IO (Point (DualCurve curve))
forall a b. (a -> b) -> a -> b
$ \PointPtr (DualCurve curve)
sigPtr -> do
            forall curve.
BLS curve =>
PointPtr (DualCurve curve)
-> PointPtr (DualCurve curve) -> ScalarPtr -> IO ()
c_blst_sign @curve PointPtr (DualCurve curve)
sigPtr PointPtr (DualCurve curve)
hashPtr (Ptr Word8 -> ScalarPtr
ScalarPtr Ptr Word8
skPtp)

  {-# INLINE verifyDSIGN #-}
  -- Context can hold domain separation tag and/or augmentation data for signatures
  verifyDSIGN :: forall a.
(Signable (BLS12381DSIGN curve) a, HasCallStack) =>
ContextDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
-> a
-> SigDSIGN (BLS12381DSIGN curve)
-> Either String ()
verifyDSIGN BLS12381SignContext {blsSignContextDst :: BLS12381SignContext -> Maybe ByteString
blsSignContextDst = Maybe ByteString
dst, blsSignContextAug :: BLS12381SignContext -> Maybe ByteString
blsSignContextAug = Maybe ByteString
aug} (VerKeyBLS12381 Point curve
pbPsb) a
msg (SigBLS12381 Point (DualCurve curve)
sigPsb) =
    IO (Either String ()) -> Either String ()
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String ()) -> Either String ())
-> IO (Either String ()) -> Either String ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe ByteString
-> (CStringLen -> IO (Either String ())) -> IO (Either String ())
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
dst ((CStringLen -> IO (Either String ())) -> IO (Either String ()))
-> (CStringLen -> IO (Either String ())) -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
dstPtr, Int
dstLen) -> do
        Affine curve
-> (AffinePtr curve -> IO (Either String ()))
-> IO (Either String ())
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine (forall curve. BLS curve => Point curve -> Affine curve
toAffine @curve Point curve
pbPsb) ((AffinePtr curve -> IO (Either String ()))
 -> IO (Either String ()))
-> (AffinePtr curve -> IO (Either String ()))
-> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \AffinePtr curve
pkAff ->
          Affine (DualCurve curve)
-> (AffinePtr (DualCurve curve) -> IO (Either String ()))
-> IO (Either String ())
forall a curve. Affine curve -> (AffinePtr curve -> IO a) -> IO a
withAffine (forall curve. BLS curve => Point curve -> Affine curve
toAffine @(DualCurve curve) Point (DualCurve curve)
sigPsb) ((AffinePtr (DualCurve curve) -> IO (Either String ()))
 -> IO (Either String ()))
-> (AffinePtr (DualCurve curve) -> IO (Either String ()))
-> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \AffinePtr (DualCurve curve)
sigAff ->
            Maybe ByteString
-> (CStringLen -> IO (Either String ())) -> IO (Either String ())
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
aug ((CStringLen -> IO (Either String ())) -> IO (Either String ()))
-> (CStringLen -> IO (Either String ())) -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
augPtr, Int
augLen) ->
              ByteString
-> (CStringLen -> IO (Either String ())) -> IO (Either String ())
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen (a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
msg) ((CStringLen -> IO (Either String ())) -> IO (Either String ()))
-> (CStringLen -> IO (Either String ())) -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
msgPtr, Int
msgLen) -> do
                CInt
err <-
                  forall curve.
BLS curve =>
AffinePtr curve
-> AffinePtr (DualCurve curve)
-> Bool
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> IO CInt
c_blst_core_verify @curve
                    AffinePtr curve
pkAff
                    AffinePtr (DualCurve curve)
sigAff
                    Bool
True
                    Ptr CChar
msgPtr
                    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
msgLen)
                    Ptr CChar
dstPtr
                    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
dstLen)
                    Ptr CChar
augPtr
                    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
augLen)
                Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$! case CInt -> BLSTError
mkBLSTError CInt
err of
                  BLSTError
BLST_SUCCESS -> () -> Either String ()
forall a b. b -> Either a b
Right ()
                  BLSTError
_ -> String -> Either String ()
forall a b. a -> Either a b
Left String
"verifyDSIGN: BLS12381DSIGN signature failed to verify"

  {-# INLINE genKeyDSIGN #-}
  genKeyDSIGN :: Seed -> SignKeyDSIGN (BLS12381DSIGN curve)
genKeyDSIGN = KeyGenContextDSIGN (BLS12381DSIGN curve)
-> Seed -> SignKeyDSIGN (BLS12381DSIGN curve)
forall v.
DSIGNAlgorithm v =>
KeyGenContextDSIGN v -> Seed -> SignKeyDSIGN v
genKeyDSIGNWithContext Maybe ByteString
KeyGenContextDSIGN (BLS12381DSIGN curve)
forall a. Maybe a
Nothing

  {-# INLINE genKeyDSIGNWithContext #-}
  -- Generate a signing key from a seed and optional key info
  -- as per the IETF bls signature draft 05
  genKeyDSIGNWithContext :: KeyGenContextDSIGN (BLS12381DSIGN curve)
-> Seed -> SignKeyDSIGN (BLS12381DSIGN curve)
genKeyDSIGNWithContext KeyGenContextDSIGN (BLS12381DSIGN curve)
keyInfo Seed
seed =
    Scalar -> SignKeyDSIGN (BLS12381DSIGN curve)
forall curve. Scalar -> SignKeyDSIGN (BLS12381DSIGN curve)
SignKeyBLS12381 (Scalar -> SignKeyDSIGN (BLS12381DSIGN curve))
-> (PinnedSizedBytes 32 -> Scalar)
-> PinnedSizedBytes 32
-> SignKeyDSIGN (BLS12381DSIGN curve)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes 32 -> Scalar
Scalar (PinnedSizedBytes 32 -> SignKeyDSIGN (BLS12381DSIGN curve))
-> PinnedSizedBytes 32 -> SignKeyDSIGN (BLS12381DSIGN curve)
forall a b. (a -> b) -> a -> b
$
      let (ByteString
bs, Seed
_) = Word -> Seed -> (ByteString, Seed)
getBytesFromSeedT (Proxy (BLS12381DSIGN curve) -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(BLS12381DSIGN curve))) Seed
seed
       in IO (PinnedSizedBytes 32) -> PinnedSizedBytes 32
forall a. IO a -> a
unsafeDupablePerformIO (IO (PinnedSizedBytes 32) -> PinnedSizedBytes 32)
-> IO (PinnedSizedBytes 32) -> PinnedSizedBytes 32
forall a b. (a -> b) -> a -> b
$ do
            Maybe ByteString
-> (CStringLen -> IO (PinnedSizedBytes 32))
-> IO (PinnedSizedBytes 32)
forall a. Maybe ByteString -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe ByteString
KeyGenContextDSIGN (BLS12381DSIGN curve)
keyInfo ((CStringLen -> IO (PinnedSizedBytes 32))
 -> IO (PinnedSizedBytes 32))
-> (CStringLen -> IO (PinnedSizedBytes 32))
-> IO (PinnedSizedBytes 32)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
infoPtr, Int
infoLen) ->
              ByteString
-> (CStringLen -> IO (PinnedSizedBytes 32))
-> IO (PinnedSizedBytes 32)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (PinnedSizedBytes 32))
 -> IO (PinnedSizedBytes 32))
-> (CStringLen -> IO (PinnedSizedBytes 32))
-> IO (PinnedSizedBytes 32)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ikmPtr, Int
ikmLen) ->
                (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes 32)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m ()) -> m (PinnedSizedBytes n)
psbCreate ((Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes 32))
-> (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes 32)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
skPtr ->
                  ScalarPtr -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()
c_blst_keygen
                    (Ptr Word8 -> ScalarPtr
ScalarPtr Ptr Word8
skPtr)
                    Ptr CChar
ikmPtr
                    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
ikmLen)
                    Ptr CChar
infoPtr
                    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
infoLen)

  -- Note that this also compresses the signature according to the ZCash standard
  {-# INLINE rawSerialiseSigDSIGN #-}
  rawSerialiseSigDSIGN :: SigDSIGN (BLS12381DSIGN curve) -> ByteString
rawSerialiseSigDSIGN (SigBLS12381 Point (DualCurve curve)
sigPSB) = forall curve. BLS curve => Point curve -> ByteString
blsCompress @(DualCurve curve) Point (DualCurve curve)
sigPSB

  {-# INLINE rawSerialiseVerKeyDSIGN #-}
  -- Note that this also compresses the verification key according to the ZCash standard
  rawSerialiseVerKeyDSIGN :: VerKeyDSIGN (BLS12381DSIGN curve) -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyBLS12381 Point curve
vkPSB) = forall curve. BLS curve => Point curve -> ByteString
blsCompress @curve Point curve
vkPSB

  {-# INLINE rawSerialiseSignKeyDSIGN #-}
  rawSerialiseSignKeyDSIGN :: SignKeyDSIGN (BLS12381DSIGN curve) -> ByteString
rawSerialiseSignKeyDSIGN (SignKeyBLS12381 Scalar
skPSB) = Scalar -> ByteString
scalarToBS Scalar
skPSB

  {-# INLINE rawDeserialiseVerKeyDSIGN #-}
  rawDeserialiseVerKeyDSIGN :: ByteString -> Maybe (VerKeyDSIGN (BLS12381DSIGN curve))
rawDeserialiseVerKeyDSIGN ByteString
bs =
    -- Note that this also performs a group membership check.
    -- That is, the deserialised point is in the subgroup of Curve1/Curve2.
    case forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsUncompress @curve ByteString
bs of
      Left BLSTError
_ -> Maybe (VerKeyDSIGN (BLS12381DSIGN curve))
forall a. Maybe a
Nothing
      Right Point curve
vkPsb -> VerKeyDSIGN (BLS12381DSIGN curve)
-> Maybe (VerKeyDSIGN (BLS12381DSIGN curve))
forall a. a -> Maybe a
Just (Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
forall curve. Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
VerKeyBLS12381 Point curve
vkPsb)

  {-# INLINE rawDeserialiseSignKeyDSIGN #-}
  rawDeserialiseSignKeyDSIGN :: ByteString -> Maybe (SignKeyDSIGN (BLS12381DSIGN curve))
rawDeserialiseSignKeyDSIGN ByteString
bs =
    -- A signing key is strictly a BE integer mod the curve order.
    -- The `DSIGN` interface via PSB would ensure at the type level that
    -- they are of size 32 bytes (256 bits). But we must even ensure
    -- they are valid Scalars, i.e., less than the curve order (255 bits).
    case ByteString -> Either BLSTError Scalar
scalarFromBS ByteString
bs of
      Left BLSTError
_ -> Maybe (SignKeyDSIGN (BLS12381DSIGN curve))
forall a. Maybe a
Nothing
      Right Scalar
skScalar -> SignKeyDSIGN (BLS12381DSIGN curve)
-> Maybe (SignKeyDSIGN (BLS12381DSIGN curve))
forall a. a -> Maybe a
Just (Scalar -> SignKeyDSIGN (BLS12381DSIGN curve)
forall curve. Scalar -> SignKeyDSIGN (BLS12381DSIGN curve)
SignKeyBLS12381 Scalar
skScalar)

  {-# INLINE rawDeserialiseSigDSIGN #-}
  rawDeserialiseSigDSIGN :: ByteString -> Maybe (SigDSIGN (BLS12381DSIGN curve))
rawDeserialiseSigDSIGN ByteString
bs =
    -- Note that this also performs a group membership check.
    -- That is, the deserialised point is in the subgroup of Curve1/Curve2.
    case forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsUncompress @(DualCurve curve) ByteString
bs of
      Left BLSTError
_ -> Maybe (SigDSIGN (BLS12381DSIGN curve))
forall a. Maybe a
Nothing
      Right Point (DualCurve curve)
sigPsb -> SigDSIGN (BLS12381DSIGN curve)
-> Maybe (SigDSIGN (BLS12381DSIGN curve))
forall a. a -> Maybe a
Just (Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
SigBLS12381 Point (DualCurve curve)
sigPsb)

deriving stock instance
  BLS curve =>
  Eq (VerKeyDSIGN (BLS12381DSIGN curve))

deriving stock instance
  BLS (DualCurve curve) =>
  Eq (SigDSIGN (BLS12381DSIGN curve))

-- Constant-time equality for signing keys
instance Eq (SignKeyDSIGN (BLS12381DSIGN curve)) where
  SignKeyBLS12381 (Scalar PinnedSizedBytes 32
sk1Psb) == :: SignKeyDSIGN (BLS12381DSIGN curve)
-> SignKeyDSIGN (BLS12381DSIGN curve) -> Bool
== SignKeyBLS12381 (Scalar PinnedSizedBytes 32
sk2Psb) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      PinnedSizedBytes 32 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes 32
sk1Psb ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sk1Ptr ->
        PinnedSizedBytes 32 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes 32
sk2Psb ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sk2Ptr -> do
          Int
res <- Ptr Word8 -> Ptr Word8 -> CSize -> IO Int
forall a. Ptr a -> Ptr a -> CSize -> IO Int
c_sodium_compare Ptr Word8
sk1Ptr Ptr Word8
sk2Ptr CSize
size
          Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
res Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    where
      size :: CSize
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize CARDANO_BLST_SCALAR_SIZE

instance Show (SignKeyDSIGN (BLS12381DSIGN curve)) where
  show :: SignKeyDSIGN (BLS12381DSIGN curve) -> String
show SignKeyDSIGN (BLS12381DSIGN curve)
_ = String
"BLS12381DSIGN:<secret>"

instance
  BLS12381CurveConstraints curve =>
  ToCBOR (VerKeyDSIGN (BLS12381DSIGN curve))
  where
  toCBOR :: VerKeyDSIGN (BLS12381DSIGN curve) -> Encoding
toCBOR = VerKeyDSIGN (BLS12381DSIGN curve) -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (VerKeyDSIGN (BLS12381DSIGN curve)) -> Size
forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size
encodedVerKeyDSIGNSizeExpr

instance
  BLS12381CurveConstraints curve =>
  FromCBOR (VerKeyDSIGN (BLS12381DSIGN curve))
  where
  fromCBOR :: forall s. Decoder s (VerKeyDSIGN (BLS12381DSIGN curve))
fromCBOR = Decoder s (VerKeyDSIGN (BLS12381DSIGN curve))
forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN

instance
  BLS12381CurveConstraints curve =>
  ToCBOR (SignKeyDSIGN (BLS12381DSIGN curve))
  where
  toCBOR :: SignKeyDSIGN (BLS12381DSIGN curve) -> Encoding
toCBOR = SignKeyDSIGN (BLS12381DSIGN curve) -> Encoding
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (SignKeyDSIGN (BLS12381DSIGN curve)) -> Size
forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size
encodedSignKeyDSIGNSizeExpr

instance
  BLS12381CurveConstraints curve =>
  FromCBOR (SignKeyDSIGN (BLS12381DSIGN curve))
  where
  fromCBOR :: forall s. Decoder s (SignKeyDSIGN (BLS12381DSIGN curve))
fromCBOR = Decoder s (SignKeyDSIGN (BLS12381DSIGN curve))
forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN

instance
  BLS12381CurveConstraints curve =>
  ToCBOR (SigDSIGN (BLS12381DSIGN curve))
  where
  toCBOR :: SigDSIGN (BLS12381DSIGN curve) -> Encoding
toCBOR = SigDSIGN (BLS12381DSIGN curve) -> Encoding
forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigDSIGN (BLS12381DSIGN curve)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (SigDSIGN (BLS12381DSIGN curve)) -> Size
forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr

-- | Helper functions to extract the internal Point representation
verKeyToPoint :: VerKeyDSIGN (BLS12381DSIGN curve) -> Point curve
verKeyToPoint :: forall curve. VerKeyDSIGN (BLS12381DSIGN curve) -> Point curve
verKeyToPoint (VerKeyBLS12381 Point curve
p) = Point curve
p

-- | Helper functions to extract the internal Point representation
sigToPoint :: SigDSIGN (BLS12381DSIGN curve) -> Point (DualCurve curve)
sigToPoint :: forall curve.
SigDSIGN (BLS12381DSIGN curve) -> Point (DualCurve curve)
sigToPoint (SigBLS12381 Point (DualCurve curve)
p) = Point (DualCurve curve)
p

instance
  BLS12381CurveConstraints curve =>
  FromCBOR (SigDSIGN (BLS12381DSIGN curve))
  where
  fromCBOR :: forall s. Decoder s (SigDSIGN (BLS12381DSIGN curve))
fromCBOR = Decoder s (SigDSIGN (BLS12381DSIGN curve))
forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN

instance
  ( BLS12381CurveConstraints curve
  , KnownNat (CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve))
  ) =>
  DSIGNAggregatable (BLS12381DSIGN curve)
  where
  type
    -- Sizes used in serialization/deserialization
    -- so these use the compressed sizes of the BLS12-381 `Point curve`
    PossessionProofSizeDSIGN (BLS12381DSIGN curve) =
      CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve)

  data PossessionProofDSIGN (BLS12381DSIGN curve) = PossessionProofBLS12381
    { forall curve.
PossessionProofDSIGN (BLS12381DSIGN curve)
-> Point (DualCurve curve)
mu1 :: !(Point (DualCurve curve))
    , forall curve.
PossessionProofDSIGN (BLS12381DSIGN curve)
-> Point (DualCurve curve)
mu2 :: !(Point (DualCurve curve))
    }
    deriving stock (Int -> PossessionProofDSIGN (BLS12381DSIGN curve) -> ShowS
[PossessionProofDSIGN (BLS12381DSIGN curve)] -> ShowS
PossessionProofDSIGN (BLS12381DSIGN curve) -> String
(Int -> PossessionProofDSIGN (BLS12381DSIGN curve) -> ShowS)
-> (PossessionProofDSIGN (BLS12381DSIGN curve) -> String)
-> ([PossessionProofDSIGN (BLS12381DSIGN curve)] -> ShowS)
-> Show (PossessionProofDSIGN (BLS12381DSIGN curve))
forall curve.
Int -> PossessionProofDSIGN (BLS12381DSIGN curve) -> ShowS
forall curve. [PossessionProofDSIGN (BLS12381DSIGN curve)] -> ShowS
forall curve. PossessionProofDSIGN (BLS12381DSIGN curve) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall curve.
Int -> PossessionProofDSIGN (BLS12381DSIGN curve) -> ShowS
showsPrec :: Int -> PossessionProofDSIGN (BLS12381DSIGN curve) -> ShowS
$cshow :: forall curve. PossessionProofDSIGN (BLS12381DSIGN curve) -> String
show :: PossessionProofDSIGN (BLS12381DSIGN curve) -> String
$cshowList :: forall curve. [PossessionProofDSIGN (BLS12381DSIGN curve)] -> ShowS
showList :: [PossessionProofDSIGN (BLS12381DSIGN curve)] -> ShowS
Show, (forall x.
 PossessionProofDSIGN (BLS12381DSIGN curve)
 -> Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x)
-> (forall x.
    Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
    -> PossessionProofDSIGN (BLS12381DSIGN curve))
-> Generic (PossessionProofDSIGN (BLS12381DSIGN curve))
forall x.
Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall x.
PossessionProofDSIGN (BLS12381DSIGN curve)
-> Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall curve x.
Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall curve x.
PossessionProofDSIGN (BLS12381DSIGN curve)
-> Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
$cfrom :: forall curve x.
PossessionProofDSIGN (BLS12381DSIGN curve)
-> Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
from :: forall x.
PossessionProofDSIGN (BLS12381DSIGN curve)
-> Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
$cto :: forall curve x.
Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
-> PossessionProofDSIGN (BLS12381DSIGN curve)
to :: forall x.
Rep (PossessionProofDSIGN (BLS12381DSIGN curve)) x
-> PossessionProofDSIGN (BLS12381DSIGN curve)
Generic)
    deriving anyclass (Context
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (Maybe ThunkInfo)
Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> String
(Context
 -> PossessionProofDSIGN (BLS12381DSIGN curve)
 -> IO (Maybe ThunkInfo))
-> (Context
    -> PossessionProofDSIGN (BLS12381DSIGN curve)
    -> IO (Maybe ThunkInfo))
-> (Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> String)
-> NoThunks (PossessionProofDSIGN (BLS12381DSIGN curve))
forall curve.
Context
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (Maybe ThunkInfo)
forall curve.
Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall curve.
Context
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (Maybe ThunkInfo)
noThunks :: Context
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (Maybe ThunkInfo)
$cwNoThunks :: forall curve.
Context
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall curve.
Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> String
showTypeOf :: Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> String
NoThunks)
    deriving anyclass (PossessionProofDSIGN (BLS12381DSIGN curve) -> ()
(PossessionProofDSIGN (BLS12381DSIGN curve) -> ())
-> NFData (PossessionProofDSIGN (BLS12381DSIGN curve))
forall curve. PossessionProofDSIGN (BLS12381DSIGN curve) -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall curve. PossessionProofDSIGN (BLS12381DSIGN curve) -> ()
rnf :: PossessionProofDSIGN (BLS12381DSIGN curve) -> ()
NFData)

  {-# INLINE uncheckedAggregateVerKeysDSIGN #-}
  uncheckedAggregateVerKeysDSIGN :: HasCallStack =>
[VerKeyDSIGN (BLS12381DSIGN curve)]
-> Either String (VerKeyDSIGN (BLS12381DSIGN curve))
uncheckedAggregateVerKeysDSIGN [VerKeyDSIGN (BLS12381DSIGN curve)]
verKeys = do
    -- Sum the verification keys as curve points
    let aggrPoint :: Point curve
aggrPoint =
          (Point curve -> Point curve -> Point curve)
-> Point curve -> [Point curve] -> Point curve
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
blsAddOrDouble (forall curve. BLS curve => Point curve
blsZero @curve) ((VerKeyDSIGN (BLS12381DSIGN curve) -> Point curve)
-> [VerKeyDSIGN (BLS12381DSIGN curve)] -> [Point curve]
forall a b. (a -> b) -> [a] -> [b]
map VerKeyDSIGN (BLS12381DSIGN curve) -> Point curve
forall curve. VerKeyDSIGN (BLS12381DSIGN curve) -> Point curve
verKeyToPoint [VerKeyDSIGN (BLS12381DSIGN curve)]
verKeys)
    -- Unlikely case, but best to reject infinity as an aggregate verification
    -- key. This happens if, for every secret/verification key pair, the inverse
    -- of each secret key (and thus also the verification key) is also present
    -- in the list.
    if forall curve. BLS curve => Point curve -> Bool
blsIsInf @curve Point curve
aggrPoint
      then String -> Either String (VerKeyDSIGN (BLS12381DSIGN curve))
forall a b. a -> Either a b
Left String
"aggregateVerKeysDSIGN: aggregated verification key is infinity"
      else VerKeyDSIGN (BLS12381DSIGN curve)
-> Either String (VerKeyDSIGN (BLS12381DSIGN curve))
forall a b. b -> Either a b
Right (VerKeyDSIGN (BLS12381DSIGN curve)
 -> Either String (VerKeyDSIGN (BLS12381DSIGN curve)))
-> VerKeyDSIGN (BLS12381DSIGN curve)
-> Either String (VerKeyDSIGN (BLS12381DSIGN curve))
forall a b. (a -> b) -> a -> b
$ Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
forall curve. Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
VerKeyBLS12381 Point curve
aggrPoint

  {-# INLINE aggregateSigsDSIGN #-}
  aggregateSigsDSIGN :: HasCallStack =>
[SigDSIGN (BLS12381DSIGN curve)]
-> Either String (SigDSIGN (BLS12381DSIGN curve))
aggregateSigsDSIGN [SigDSIGN (BLS12381DSIGN curve)]
sigs = do
    -- Sum the signatures as curve points
    let aggrPoint :: Point (DualCurve curve)
aggrPoint =
          (Point (DualCurve curve)
 -> Point (DualCurve curve) -> Point (DualCurve curve))
-> Point (DualCurve curve)
-> [Point (DualCurve curve)]
-> Point (DualCurve curve)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Point (DualCurve curve)
-> Point (DualCurve curve) -> Point (DualCurve curve)
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
blsAddOrDouble (forall curve. BLS curve => Point curve
blsZero @(DualCurve curve)) ((SigDSIGN (BLS12381DSIGN curve) -> Point (DualCurve curve))
-> [SigDSIGN (BLS12381DSIGN curve)] -> [Point (DualCurve curve)]
forall a b. (a -> b) -> [a] -> [b]
map SigDSIGN (BLS12381DSIGN curve) -> Point (DualCurve curve)
forall curve.
SigDSIGN (BLS12381DSIGN curve) -> Point (DualCurve curve)
sigToPoint [SigDSIGN (BLS12381DSIGN curve)]
sigs)
    -- Unlikely case, but best to reject infinity as an aggregate signature
    if forall curve. BLS curve => Point curve -> Bool
blsIsInf @(DualCurve curve) Point (DualCurve curve)
aggrPoint
      then String -> Either String (SigDSIGN (BLS12381DSIGN curve))
forall a b. a -> Either a b
Left String
"aggregateSigsDSIGN: aggregated signature is infinity"
      else SigDSIGN (BLS12381DSIGN curve)
-> Either String (SigDSIGN (BLS12381DSIGN curve))
forall a b. b -> Either a b
Right (SigDSIGN (BLS12381DSIGN curve)
 -> Either String (SigDSIGN (BLS12381DSIGN curve)))
-> SigDSIGN (BLS12381DSIGN curve)
-> Either String (SigDSIGN (BLS12381DSIGN curve))
forall a b. (a -> b) -> a -> b
$ Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
SigBLS12381 Point (DualCurve curve)
aggrPoint

  {-# INLINE createPossessionProofDSIGN #-}
  createPossessionProofDSIGN :: HasCallStack =>
ContextDSIGN (BLS12381DSIGN curve)
-> SignKeyDSIGN (BLS12381DSIGN curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
createPossessionProofDSIGN BLS12381SignContext {blsSignContextDst :: BLS12381SignContext -> Maybe ByteString
blsSignContextDst = Maybe ByteString
dst, blsSignContextAug :: BLS12381SignContext -> Maybe ByteString
blsSignContextAug = Maybe ByteString
aug} (SignKeyBLS12381 Scalar
skScalar) =
    IO (PossessionProofDSIGN (BLS12381DSIGN curve))
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall a. IO a -> a
unsafeDupablePerformIO (IO (PossessionProofDSIGN (BLS12381DSIGN curve))
 -> PossessionProofDSIGN (BLS12381DSIGN curve))
-> IO (PossessionProofDSIGN (BLS12381DSIGN curve))
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall a b. (a -> b) -> a -> b
$ do
      Integer
skAsInteger <- Scalar -> IO Integer
scalarToInteger Scalar
skScalar
      let VerKeyBLS12381 Point curve
vkPsb =
            SignKeyDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (Scalar -> SignKeyDSIGN (BLS12381DSIGN curve)
forall curve. Scalar -> SignKeyDSIGN (BLS12381DSIGN curve)
SignKeyBLS12381 Scalar
skScalar) ::
              VerKeyDSIGN (BLS12381DSIGN curve)
          vk :: ByteString
vk = forall curve. BLS curve => Point curve -> ByteString
blsCompress @curve Point curve
vkPsb
          mu1Psb :: Point (DualCurve curve)
mu1Psb =
            Point (DualCurve curve) -> Integer -> Point (DualCurve curve)
forall curve. BLS curve => Point curve -> Integer -> Point curve
blsMult (forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
blsHash @(DualCurve curve) ByteString
vk Maybe ByteString
dst Maybe ByteString
aug) Integer
skAsInteger
          mu2Psb :: Point (DualCurve curve)
mu2Psb =
            Point (DualCurve curve) -> Integer -> Point (DualCurve curve)
forall curve. BLS curve => Point curve -> Integer -> Point curve
blsMult (forall curve. BLS curve => Point curve
blsGenerator @(DualCurve curve)) Integer
skAsInteger
      PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (PossessionProofDSIGN (BLS12381DSIGN curve))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PossessionProofDSIGN (BLS12381DSIGN curve)
 -> IO (PossessionProofDSIGN (BLS12381DSIGN curve)))
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> IO (PossessionProofDSIGN (BLS12381DSIGN curve))
forall a b. (a -> b) -> a -> b
$ Point (DualCurve curve)
-> Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve)
-> Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
PossessionProofBLS12381 Point (DualCurve curve)
mu1Psb Point (DualCurve curve)
mu2Psb
  {-# INLINE verifyPossessionProofDSIGN #-}
  verifyPossessionProofDSIGN :: HasCallStack =>
ContextDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> Either String ()
verifyPossessionProofDSIGN BLS12381SignContext {blsSignContextDst :: BLS12381SignContext -> Maybe ByteString
blsSignContextDst = Maybe ByteString
dst, blsSignContextAug :: BLS12381SignContext -> Maybe ByteString
blsSignContextAug = Maybe ByteString
aug} (VerKeyBLS12381 Point curve
vk) (PossessionProofBLS12381 Point (DualCurve curve)
mu1Psb Point (DualCurve curve)
mu2Psb) =
    let check1 :: Bool
check1 =
          forall curve.
BLS curve =>
PairingSide curve -> PairingSide curve -> Bool
finalVerifyPairs @curve (Point curve
forall curve. BLS curve => Point curve
blsGenerator, Point (DualCurve curve)
mu1Psb) (Point curve
vk, ByteString
-> Maybe ByteString -> Maybe ByteString -> Point (DualCurve curve)
forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
blsHash (Point curve -> ByteString
forall curve. BLS curve => Point curve -> ByteString
blsCompress Point curve
vk) Maybe ByteString
dst Maybe ByteString
aug)
        check2 :: Bool
check2 = forall curve.
BLS curve =>
PairingSide curve -> PairingSide curve -> Bool
finalVerifyPairs @curve (Point curve
vk, Point (DualCurve curve)
forall curve. BLS curve => Point curve
blsGenerator) (Point curve
forall curve. BLS curve => Point curve
blsGenerator, Point (DualCurve curve)
mu2Psb)
     in if Bool
check1 Bool -> Bool -> Bool
&& Bool
check2
          then () -> Either String ()
forall a b. b -> Either a b
Right ()
          else String -> Either String ()
forall a b. a -> Either a b
Left String
"verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify."
  {-# INLINE rawSerialisePossessionProofDSIGN #-}
  rawSerialisePossessionProofDSIGN :: PossessionProofDSIGN (BLS12381DSIGN curve) -> ByteString
rawSerialisePossessionProofDSIGN (PossessionProofBLS12381 Point (DualCurve curve)
mu1Psb Point (DualCurve curve)
mu2Psb) =
    forall curve. BLS curve => Point curve -> ByteString
blsCompress @(DualCurve curve) Point (DualCurve curve)
mu1Psb ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> forall curve. BLS curve => Point curve -> ByteString
blsCompress @(DualCurve curve) Point (DualCurve curve)
mu2Psb
  {-# INLINE rawDeserialisePossessionProofDSIGN #-}
  rawDeserialisePossessionProofDSIGN :: ByteString -> Maybe (PossessionProofDSIGN (BLS12381DSIGN curve))
rawDeserialisePossessionProofDSIGN ByteString
bs =
    let chunkSize :: Int
chunkSize = Proxy (DualCurve curve) -> Int
forall curve. BLS curve => Proxy curve -> Int
compressedSizePoint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(DualCurve curve))
        (ByteString
mu1Bs, ByteString
mu2Bs) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
chunkSize ByteString
bs
     in do
          -- Note that these also perform group membership and size checks.
          -- It will also ensure that all of the supplied `ByteString` is consumed
          -- through the size checks.
          Right Point (DualCurve curve)
mu1Point <- Either BLSTError (Point (DualCurve curve))
-> Maybe (Either BLSTError (Point (DualCurve curve)))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BLSTError (Point (DualCurve curve))
 -> Maybe (Either BLSTError (Point (DualCurve curve))))
-> Either BLSTError (Point (DualCurve curve))
-> Maybe (Either BLSTError (Point (DualCurve curve)))
forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsUncompress @(DualCurve curve) ByteString
mu1Bs
          Right Point (DualCurve curve)
mu2Point <- Either BLSTError (Point (DualCurve curve))
-> Maybe (Either BLSTError (Point (DualCurve curve)))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BLSTError (Point (DualCurve curve))
 -> Maybe (Either BLSTError (Point (DualCurve curve))))
-> Either BLSTError (Point (DualCurve curve))
-> Maybe (Either BLSTError (Point (DualCurve curve)))
forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
blsUncompress @(DualCurve curve) ByteString
mu2Bs
          PossessionProofDSIGN (BLS12381DSIGN curve)
-> Maybe (PossessionProofDSIGN (BLS12381DSIGN curve))
forall a. a -> Maybe a
Just (PossessionProofDSIGN (BLS12381DSIGN curve)
 -> Maybe (PossessionProofDSIGN (BLS12381DSIGN curve)))
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> Maybe (PossessionProofDSIGN (BLS12381DSIGN curve))
forall a b. (a -> b) -> a -> b
$ Point (DualCurve curve)
-> Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve)
-> Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
PossessionProofBLS12381 Point (DualCurve curve)
mu1Point Point (DualCurve curve)
mu2Point

deriving stock instance
  BLS (DualCurve curve) =>
  Eq (PossessionProofDSIGN (BLS12381DSIGN curve))

instance
  ( BLS12381CurveConstraints curve
  , KnownNat (CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve))
  ) =>
  ToCBOR (PossessionProofDSIGN (BLS12381DSIGN curve))
  where
  toCBOR :: PossessionProofDSIGN (BLS12381DSIGN curve) -> Encoding
toCBOR = PossessionProofDSIGN (BLS12381DSIGN curve) -> Encoding
forall v. DSIGNAggregatable v => PossessionProofDSIGN v -> Encoding
encodePossessionProofDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (PossessionProofDSIGN (BLS12381DSIGN curve)) -> Size
forall v.
DSIGNAggregatable v =>
Proxy (PossessionProofDSIGN v) -> Size
encodedPossessionProofDSIGNSizeExpr

instance
  ( BLS12381CurveConstraints curve
  , KnownNat (CompressedPointSize (DualCurve curve) + CompressedPointSize (DualCurve curve))
  ) =>
  FromCBOR (PossessionProofDSIGN (BLS12381DSIGN curve))
  where
  fromCBOR :: forall s. Decoder s (PossessionProofDSIGN (BLS12381DSIGN curve))
fromCBOR = Decoder s (PossessionProofDSIGN (BLS12381DSIGN curve))
forall v s.
DSIGNAggregatable v =>
Decoder s (PossessionProofDSIGN v)
decodePossessionProofDSIGN