{-# 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.Internal (
  BLS12381DSIGN,
  BLS12381MinVerKeyDSIGN,
  BLS12381MinSigDSIGN,
  BLS12381CurveConstraints,
  VerKeyDSIGN (..),
  SignKeyDSIGN (..),
  SigDSIGN (..),
  PossessionProofDSIGN (..),
  BLS12381SignContext (..),
  minSigPoPDST,
  minVerKeyPoPDST,
) 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,
  blsIsInf,
  blsUncompress,
  c_blst_keygen,
  mkBLSTError,
  scalarFromBS,
  scalarToBS,
  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.Bifunctor (first)
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

-- | The BLS12-381 minimal verification key size variant
type BLS12381MinVerKeyDSIGN = BLS12381DSIGN Curve1

-- | The BLS12-381 minimal signature size variant
type BLS12381MinSigDSIGN = BLS12381DSIGN Curve2

-- | The BLS12381 signing context for the "PoP" based ciphersuite for the minimal signature size variant of bls signatures
minSigPoPDST :: BLS12381SignContext
minSigPoPDST :: BLS12381SignContext
minSigPoPDST = Maybe ByteString -> Maybe ByteString -> BLS12381SignContext
BLS12381SignContext (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_") Maybe ByteString
forall a. Maybe a
Nothing

-- | The BLS12381 signing context for the "PoP" based ciphersuite for the minimal verification key size variant of bls signatures
minVerKeyPoPDST :: BLS12381SignContext
minVerKeyPoPDST :: BLS12381SignContext
minVerKeyPoPDST = Maybe ByteString -> Maybe ByteString -> BLS12381SignContext
BLS12381SignContext (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_") Maybe ByteString
forall a. Maybe a
Nothing

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

-- | This module provides support only for proof-of-possession (PoP) ciphersuite
-- contexts:
--
-- * 'minSigPoPDST'
-- * 'minVerKeyPoPDST'
--
-- even though the underlying signing and verification primitives can be used
-- to realise the Basic (@NUL@) and message-augmentation (@AUG@) schemes as
-- well.
--
-- == Why only the "PoP" ciphersuite is exported
--
-- The main reason is API clarity and safety.
--
-- The IETF BLS draft defines three schemes:
--
-- * __Basic__ (@NUL@): aggregation is safe only when all messages in an
--   aggregate are distinct.
--
-- * __Message augmentation__ (@AUG@): aggregation is made safe by signing
--   @PK || message@ instead of just @message@.
--
-- * __Proof of possession__ (@POP@): aggregation is made safe by requiring a
--   separate proof that each public key owner knows the corresponding secret
--   key.
--
-- In this module, the supported aggregation workflow is the PoP one:
--
-- * create a proof of possession with 'createPossessionProofDSIGN'
-- * verify it with 'verifyPossessionProofDSIGN'
-- * aggregate verification keys with 'uncheckedAggregateVerKeysDSIGN' only
--   after the relevant proofs have been checked
-- * aggregate signatures with 'aggregateSigsDSIGN'
--
-- By contrast, this module does /not/ provide the draft's general
-- @AggregateVerify((PK_1, ..., PK_n), (message_1, ..., message_n), signature)@
-- API for aggregation over different messages.  Exporting predefined Basic and
-- AUG contexts would therefore suggest a broader aggregate-signature API than
-- the module actually offers.
--
-- Restricting the public ciphersuite exports to PoP makes the intended usage
-- explicit: this module supports ordinary BLS signing and verification, plus a
-- PoP-based aggregation story.
--
-- == What the exported contexts mean
--
-- The exported values are standard BLS ciphersuite DSTs from
-- draft-irtf-cfrg-bls-signature-06, Section 4.2:
--
-- * 'minSigPoPDST' selects the __minimal-signature-size__ variant:
--   signatures live in G1 (48 bytes compressed), public keys in G2
--   (96 bytes compressed).
--
-- * 'minVerKeyPoPDST' selects the __minimal-pubkey-size__ variant:
--   public keys live in G1 (48 bytes compressed), signatures in G2
--   (96 bytes compressed).
--
-- The draft recommends the minimal-pubkey-size variant for aggregation,
-- because the size of @(PK_1, ..., PK_n, signature)@ is usually dominated by
-- the public keys. Other protocols, like Leios, might favor minimal-signature-size.
--
-- == Example
--
-- A typical same-message aggregation workflow is:
--
-- -- Minimal-pubkey-size PoP ciphersuite
-- -- Each participant has a signing key and derived verification key
-- -- Each participant proves possession of its secret key
-- >>> :set -XTypeApplications
-- >>> import Cardano.Crypto.Seed (mkSeedFromBytes)
--
-- >>> :{
-- let ctx = minVerKeyPoPDST
--     msg = BS.pack [0, 1, 2, 3]
--     sk1 =
--       genKeyDSIGNWithContext
--         @BLS12381MinVerKeyDSIGN
--         Nothing
--         (mkSeedFromBytes (BS.replicate 32 1))
--     sk2 =
--       genKeyDSIGNWithContext
--         @BLS12381MinVerKeyDSIGN
--         Nothing
--         (mkSeedFromBytes (BS.replicate 32 2))
--     vk1 = deriveVerKeyDSIGN sk1
--     vk2 = deriveVerKeyDSIGN sk2
--     pop1 = createPossessionProofDSIGN ctx sk1
--     pop2 = createPossessionProofDSIGN ctx sk2
-- :}
--
-- >>> verifyPossessionProofDSIGN ctx vk1 pop1
-- Right ()
--
-- >>> verifyPossessionProofDSIGN ctx vk2 pop2
-- Right ()
--
-- -- Once the proofs have been checked, it is safe to aggregate keys
-- >>> Right avk = uncheckedAggregateVerKeysDSIGN [vk1, vk2]
--
-- -- Both participants sign the same message
-- >>> let sig1 = signDSIGN ctx msg sk1
-- >>> let sig2 = signDSIGN ctx msg sk2
--
-- The signatures can be aggregated:
--
-- >>> Right asig = aggregateSigsDSIGN [sig1, sig2]
--
-- -- The aggregate signature can then be checked against the aggregate key:
-- >>> verifyDSIGN ctx avk msg asig
-- Right ()
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 ->
        -- Reject the identity (point at infinity) as a verification key
        if forall curve. BLS curve => Point curve -> Bool
blsIsInf @curve Point curve
vkPsb
          then Maybe (VerKeyDSIGN (BLS12381DSIGN curve))
forall a. Maybe a
Nothing
          else 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 ->
        -- Reject the zero scalar as a signing key
        if (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Scalar -> ByteString
scalarToBS Scalar
skScalar)
          then Maybe (SignKeyDSIGN (BLS12381DSIGN curve))
forall a. Maybe a
Nothing
          else 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 =>
  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)

  newtype PossessionProofDSIGN (BLS12381DSIGN curve) = PossessionProofBLS12381 (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
    let verKeyPoints :: [Point curve]
verKeyPoints = (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
    -- Reject any input verification key that is the infinity point
    if (Point curve -> Bool) -> [Point curve] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall curve. BLS curve => Point curve -> Bool
blsIsInf @curve) [Point curve]
verKeyPoints
      then String -> Either String (VerKeyDSIGN (BLS12381DSIGN curve))
forall a b. a -> Either a b
Left String
"uncheckedAggregateVerKeysDSIGN: input verification key is infinity"
      else case [Point curve]
verKeyPoints of
        [] -> String -> Either String (VerKeyDSIGN (BLS12381DSIGN curve))
forall a b. a -> Either a b
Left String
"uncheckedAggregateVerKeysDSIGN: empty list of verification keys"
        (Point curve
p : [Point curve]
ps) ->
          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 Point curve
p [Point curve]
ps
           in -- 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
"uncheckedAggregateVerKeysDSIGN: 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
    let sigPoints :: [Point (DualCurve curve)]
sigPoints = (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
    -- Reject any input signature that is the infinity point
    if (Point (DualCurve curve) -> Bool)
-> [Point (DualCurve curve)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall curve. BLS curve => Point curve -> Bool
blsIsInf @(DualCurve curve)) [Point (DualCurve curve)]
sigPoints
      then String -> Either String (SigDSIGN (BLS12381DSIGN curve))
forall a b. a -> Either a b
Left String
"aggregateSigsDSIGN: input signature is infinity"
      else case [Point (DualCurve curve)]
sigPoints of
        [] -> String -> Either String (SigDSIGN (BLS12381DSIGN curve))
forall a b. a -> Either a b
Left String
"aggregateSigsDSIGN: empty list of signatures"
        (Point (DualCurve curve)
p : [Point (DualCurve curve)]
ps) ->
          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 Point (DualCurve curve)
p [Point (DualCurve curve)]
ps
           in -- 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 ContextDSIGN (BLS12381DSIGN curve)
ctx SignKeyDSIGN (BLS12381DSIGN curve)
sk =
    let vk :: VerKeyDSIGN (BLS12381DSIGN curve)
vk = SignKeyDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN (BLS12381DSIGN curve)
sk :: VerKeyDSIGN (BLS12381DSIGN curve)
        SigBLS12381 Point (DualCurve curve)
sig = ContextDSIGN (BLS12381DSIGN curve)
-> ByteString
-> SignKeyDSIGN (BLS12381DSIGN curve)
-> SigDSIGN (BLS12381DSIGN curve)
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable (BLS12381DSIGN curve) a, HasCallStack) =>
ContextDSIGN (BLS12381DSIGN curve)
-> a
-> SignKeyDSIGN (BLS12381DSIGN curve)
-> SigDSIGN (BLS12381DSIGN curve)
signDSIGN ContextDSIGN (BLS12381DSIGN curve)
ctx (VerKeyDSIGN (BLS12381DSIGN curve) -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN (BLS12381DSIGN curve)
vk) SignKeyDSIGN (BLS12381DSIGN curve)
sk
     in Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
PossessionProofBLS12381 Point (DualCurve curve)
sig
  {-# INLINE verifyPossessionProofDSIGN #-}
  verifyPossessionProofDSIGN :: HasCallStack =>
ContextDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
-> Either String ()
verifyPossessionProofDSIGN ContextDSIGN (BLS12381DSIGN curve)
ctx VerKeyDSIGN (BLS12381DSIGN curve)
vk (PossessionProofBLS12381 Point (DualCurve curve)
mu1Psb) =
    ShowS -> Either String () -> Either String ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (String -> ShowS
forall a b. a -> b -> a
const String
"verifyPossessionProofDSIGN: BLS12381DSIGN failed to verify.")
      (ContextDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
-> ByteString
-> SigDSIGN (BLS12381DSIGN curve)
-> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable (BLS12381DSIGN curve) a, HasCallStack) =>
ContextDSIGN (BLS12381DSIGN curve)
-> VerKeyDSIGN (BLS12381DSIGN curve)
-> a
-> SigDSIGN (BLS12381DSIGN curve)
-> Either String ()
verifyDSIGN ContextDSIGN (BLS12381DSIGN curve)
ctx VerKeyDSIGN (BLS12381DSIGN curve)
vk (VerKeyDSIGN (BLS12381DSIGN curve) -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN (BLS12381DSIGN curve)
vk) (Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
SigBLS12381 Point (DualCurve curve)
mu1Psb))
  {-# INLINE rawSerialisePossessionProofDSIGN #-}
  rawSerialisePossessionProofDSIGN :: PossessionProofDSIGN (BLS12381DSIGN curve) -> ByteString
rawSerialisePossessionProofDSIGN (PossessionProofBLS12381 Point (DualCurve curve)
mu1Psb) =
    forall curve. BLS curve => Point curve -> ByteString
blsCompress @(DualCurve curve) Point (DualCurve curve)
mu1Psb
  {-# INLINE rawDeserialisePossessionProofDSIGN #-}
  rawDeserialisePossessionProofDSIGN :: ByteString -> Maybe (PossessionProofDSIGN (BLS12381DSIGN curve))
rawDeserialisePossessionProofDSIGN ByteString
bs = 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
bs
    -- Reject the zero point (point at infinity) for both mu1 and mu2
    if forall curve. BLS curve => Point curve -> Bool
blsIsInf @(DualCurve curve) Point (DualCurve curve)
mu1Point
      then Maybe (PossessionProofDSIGN (BLS12381DSIGN curve))
forall a. Maybe a
Nothing
      else 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)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
forall curve.
Point (DualCurve curve)
-> PossessionProofDSIGN (BLS12381DSIGN curve)
PossessionProofBLS12381 Point (DualCurve curve)
mu1Point

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