{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeData #-}
{-# LANGUAGE TypeFamilies #-}

-- | BLS crypto helpers to instantiate voting committees.
--
-- NOTE: this module is meant to be imported qualified.
module Ouroboros.Consensus.Committee.Crypto.BLS
  ( -- * BLS crypto helpers to instantiate voting committees
    KeyRole (..)
  , KeyScope
  , PrivateKey
  , rawDeserialisePrivateKey
  , rawSerialisePrivateKey
  , coercePrivateKey
  , derivePublicKey
  , PublicKey
  , rawDeserialisePublicKey
  , rawSerialisePublicKey
  , coercePublicKey
  , Signature
  , ProofOfPossession
  , HasBLSContext (..)
  , signWithRole
  , verifyWithRole
  , createProofOfPossession
  , verifyProofOfPossession

    -- * Aggregate keys and signatures
  , aggregatePublicKeys
  , aggregateSignatures

    -- * VRF signature manipulation
  , signatureNatural
  , signatureNaturalMax
  , toNormalizedVRFOutput

    -- * Linearized VRF output verification
  , linearizeAndVerifyVRFs
  ) where

import Cardano.Binary (FromCBOR, ToCBOR)
import Cardano.Crypto.DSIGN
  ( BLS12381MinSigDSIGN
  , BLS12381SignContext (..)
  , DSIGNAggregatable (..)
  , DSIGNAlgorithm (..)
  , SigDSIGN (..)
  , VerKeyDSIGN (..)
  )
import Cardano.Crypto.EllipticCurve.BLS12_381 (blsIsInf, blsMSM)
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Crypto.Util (SignableRepresentation, bytesToNatural)
import Cardano.Ledger.Hashes (HASH, KeyHash (..), StakePool)
import Control.Monad (when)
import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import Data.Containers.NonEmpty (HasNonEmpty (..))
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy (Proxy (..))
import GHC.Natural (Natural)
import Ouroboros.Consensus.Committee.Crypto (NormalizedVRFOutput (..))

-- * BLS crypto helpers to instantiate voting committees

-- | Key roles
type data KeyRole
  = -- | Key role for signing votes
    SIGN
  | -- | Key role for local sortition in elections
    VRF
  | -- | Key role for Proof of Possession
    POP

-- | Key scope, later instantiated with usage and network id (e.g. PERAS/MAINNET)
type KeyScope = ByteString

-- | BLS private key type, parameterized by key role
type PrivateKey :: KeyRole -> Type
data PrivateKey r = PrivateKey
  { forall (r :: KeyRole).
PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
unPrivateKey :: !(SignKeyDSIGN BLS12381MinSigDSIGN)
  , forall (r :: KeyRole). PrivateKey r -> ByteString
privateKeyScope :: !KeyScope
  }
  deriving stock (PrivateKey r -> PrivateKey r -> Bool
(PrivateKey r -> PrivateKey r -> Bool)
-> (PrivateKey r -> PrivateKey r -> Bool) -> Eq (PrivateKey r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (r :: KeyRole). PrivateKey r -> PrivateKey r -> Bool
$c== :: forall (r :: KeyRole). PrivateKey r -> PrivateKey r -> Bool
== :: PrivateKey r -> PrivateKey r -> Bool
$c/= :: forall (r :: KeyRole). PrivateKey r -> PrivateKey r -> Bool
/= :: PrivateKey r -> PrivateKey r -> Bool
Eq, Int -> PrivateKey r -> ShowS
[PrivateKey r] -> ShowS
PrivateKey r -> String
(Int -> PrivateKey r -> ShowS)
-> (PrivateKey r -> String)
-> ([PrivateKey r] -> ShowS)
-> Show (PrivateKey r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (r :: KeyRole). Int -> PrivateKey r -> ShowS
forall (r :: KeyRole). [PrivateKey r] -> ShowS
forall (r :: KeyRole). PrivateKey r -> String
$cshowsPrec :: forall (r :: KeyRole). Int -> PrivateKey r -> ShowS
showsPrec :: Int -> PrivateKey r -> ShowS
$cshow :: forall (r :: KeyRole). PrivateKey r -> String
show :: PrivateKey r -> String
$cshowList :: forall (r :: KeyRole). [PrivateKey r] -> ShowS
showList :: [PrivateKey r] -> ShowS
Show)

rawDeserialisePrivateKey ::
  KeyScope ->
  ByteString ->
  Maybe (PrivateKey r)
rawDeserialisePrivateKey :: forall (r :: KeyRole).
ByteString -> ByteString -> Maybe (PrivateKey r)
rawDeserialisePrivateKey ByteString
scope ByteString
bs = do
  key <- ByteString -> Maybe (SignKeyDSIGN BLS12381MinSigDSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
bs
  pure $
    PrivateKey
      { unPrivateKey = key
      , privateKeyScope = scope
      }

rawSerialisePrivateKey ::
  PrivateKey r ->
  ByteString
rawSerialisePrivateKey :: forall (r :: KeyRole). PrivateKey r -> ByteString
rawSerialisePrivateKey =
  SignKeyDSIGN BLS12381MinSigDSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN (SignKeyDSIGN BLS12381MinSigDSIGN -> ByteString)
-> (PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN)
-> PrivateKey r
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
unPrivateKey

coercePrivateKey ::
  forall r2 r1.
  PrivateKey r1 ->
  PrivateKey r2
coercePrivateKey :: forall (r2 :: KeyRole) (r1 :: KeyRole).
PrivateKey r1 -> PrivateKey r2
coercePrivateKey = PrivateKey r1 -> PrivateKey r2
forall a b. Coercible a b => a -> b
coerce

derivePublicKey ::
  PrivateKey r ->
  PublicKey r
derivePublicKey :: forall (r :: KeyRole). PrivateKey r -> PublicKey r
derivePublicKey PrivateKey r
sk =
  PublicKey
    { unPublicKey :: VerKeyDSIGN BLS12381MinSigDSIGN
unPublicKey = SignKeyDSIGN BLS12381MinSigDSIGN -> VerKeyDSIGN BLS12381MinSigDSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
unPrivateKey PrivateKey r
sk)
    , publicKeyScope :: ByteString
publicKeyScope = PrivateKey r -> ByteString
forall (r :: KeyRole). PrivateKey r -> ByteString
privateKeyScope PrivateKey r
sk
    }

-- | BLS public key type, parameterized by key role
type PublicKey :: KeyRole -> Type
data PublicKey r = PublicKey
  { forall (r :: KeyRole).
PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
unPublicKey :: !(VerKeyDSIGN BLS12381MinSigDSIGN)
  , forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope :: !(KeyScope)
  }
  deriving stock (PublicKey r -> PublicKey r -> Bool
(PublicKey r -> PublicKey r -> Bool)
-> (PublicKey r -> PublicKey r -> Bool) -> Eq (PublicKey r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (r :: KeyRole). PublicKey r -> PublicKey r -> Bool
$c== :: forall (r :: KeyRole). PublicKey r -> PublicKey r -> Bool
== :: PublicKey r -> PublicKey r -> Bool
$c/= :: forall (r :: KeyRole). PublicKey r -> PublicKey r -> Bool
/= :: PublicKey r -> PublicKey r -> Bool
Eq, Int -> PublicKey r -> ShowS
[PublicKey r] -> ShowS
PublicKey r -> String
(Int -> PublicKey r -> ShowS)
-> (PublicKey r -> String)
-> ([PublicKey r] -> ShowS)
-> Show (PublicKey r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (r :: KeyRole). Int -> PublicKey r -> ShowS
forall (r :: KeyRole). [PublicKey r] -> ShowS
forall (r :: KeyRole). PublicKey r -> String
$cshowsPrec :: forall (r :: KeyRole). Int -> PublicKey r -> ShowS
showsPrec :: Int -> PublicKey r -> ShowS
$cshow :: forall (r :: KeyRole). PublicKey r -> String
show :: PublicKey r -> String
$cshowList :: forall (r :: KeyRole). [PublicKey r] -> ShowS
showList :: [PublicKey r] -> ShowS
Show)

rawDeserialisePublicKey ::
  KeyScope ->
  ByteString ->
  Maybe (PublicKey r)
rawDeserialisePublicKey :: forall (r :: KeyRole).
ByteString -> ByteString -> Maybe (PublicKey r)
rawDeserialisePublicKey ByteString
scope ByteString
bs = do
  key <- ByteString -> Maybe (VerKeyDSIGN BLS12381MinSigDSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN ByteString
bs
  pure $
    PublicKey
      { unPublicKey = key
      , publicKeyScope = scope
      }

rawSerialisePublicKey ::
  PublicKey r ->
  ByteString
rawSerialisePublicKey :: forall (r :: KeyRole). PublicKey r -> ByteString
rawSerialisePublicKey =
  VerKeyDSIGN BLS12381MinSigDSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyDSIGN BLS12381MinSigDSIGN -> ByteString)
-> (PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN)
-> PublicKey r
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
unPublicKey

coercePublicKey ::
  forall r2 r1.
  PublicKey r1 ->
  PublicKey r2
coercePublicKey :: forall (r2 :: KeyRole) (r1 :: KeyRole).
PublicKey r1 -> PublicKey r2
coercePublicKey = PublicKey r1 -> PublicKey r2
forall a b. Coercible a b => a -> b
coerce

-- | BLS signature type, parameterized by key role
type Signature :: KeyRole -> Type
newtype Signature r = Signature
  { forall (r :: KeyRole). Signature r -> SigDSIGN BLS12381MinSigDSIGN
unSignature :: SigDSIGN BLS12381MinSigDSIGN
  }
  deriving stock (Signature r -> Signature r -> Bool
(Signature r -> Signature r -> Bool)
-> (Signature r -> Signature r -> Bool) -> Eq (Signature r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (r :: KeyRole). Signature r -> Signature r -> Bool
$c== :: forall (r :: KeyRole). Signature r -> Signature r -> Bool
== :: Signature r -> Signature r -> Bool
$c/= :: forall (r :: KeyRole). Signature r -> Signature r -> Bool
/= :: Signature r -> Signature r -> Bool
Eq, Int -> Signature r -> ShowS
[Signature r] -> ShowS
Signature r -> String
(Int -> Signature r -> ShowS)
-> (Signature r -> String)
-> ([Signature r] -> ShowS)
-> Show (Signature r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (r :: KeyRole). Int -> Signature r -> ShowS
forall (r :: KeyRole). [Signature r] -> ShowS
forall (r :: KeyRole). Signature r -> String
$cshowsPrec :: forall (r :: KeyRole). Int -> Signature r -> ShowS
showsPrec :: Int -> Signature r -> ShowS
$cshow :: forall (r :: KeyRole). Signature r -> String
show :: Signature r -> String
$cshowList :: forall (r :: KeyRole). [Signature r] -> ShowS
showList :: [Signature r] -> ShowS
Show)
  deriving newtype (Typeable (Signature r)
Typeable (Signature r) =>
(forall s. Decoder s (Signature r))
-> (Proxy (Signature r) -> Text) -> FromCBOR (Signature r)
Proxy (Signature r) -> Text
forall s. Decoder s (Signature r)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall (r :: KeyRole). Typeable r => Typeable (Signature r)
forall (r :: KeyRole). Typeable r => Proxy (Signature r) -> Text
forall (r :: KeyRole) s. Typeable r => Decoder s (Signature r)
$cfromCBOR :: forall (r :: KeyRole) s. Typeable r => Decoder s (Signature r)
fromCBOR :: forall s. Decoder s (Signature r)
$clabel :: forall (r :: KeyRole). Typeable r => Proxy (Signature r) -> Text
label :: Proxy (Signature r) -> Text
FromCBOR, Typeable (Signature r)
Typeable (Signature r) =>
(Signature r -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Signature r) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Signature r] -> Size)
-> ToCBOR (Signature r)
Signature r -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature r] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature r) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall (r :: KeyRole). Typeable r => Typeable (Signature r)
forall (r :: KeyRole). Typeable r => Signature r -> Encoding
forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature r] -> Size
forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature r) -> Size
$ctoCBOR :: forall (r :: KeyRole). Typeable r => Signature r -> Encoding
toCBOR :: Signature r -> Encoding
$cencodedSizeExpr :: forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature r) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature r) -> Size
$cencodedListSizeExpr :: forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature r] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature r] -> Size
ToCBOR)

-- | BLS proof of possession type
newtype ProofOfPossession = ProofOfPossession
  { ProofOfPossession -> PossessionProofDSIGN BLS12381MinSigDSIGN
unProofOfPossession :: PossessionProofDSIGN BLS12381MinSigDSIGN
  }
  deriving stock (ProofOfPossession -> ProofOfPossession -> Bool
(ProofOfPossession -> ProofOfPossession -> Bool)
-> (ProofOfPossession -> ProofOfPossession -> Bool)
-> Eq ProofOfPossession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProofOfPossession -> ProofOfPossession -> Bool
== :: ProofOfPossession -> ProofOfPossession -> Bool
$c/= :: ProofOfPossession -> ProofOfPossession -> Bool
/= :: ProofOfPossession -> ProofOfPossession -> Bool
Eq, Int -> ProofOfPossession -> ShowS
[ProofOfPossession] -> ShowS
ProofOfPossession -> String
(Int -> ProofOfPossession -> ShowS)
-> (ProofOfPossession -> String)
-> ([ProofOfPossession] -> ShowS)
-> Show ProofOfPossession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProofOfPossession -> ShowS
showsPrec :: Int -> ProofOfPossession -> ShowS
$cshow :: ProofOfPossession -> String
show :: ProofOfPossession -> String
$cshowList :: [ProofOfPossession] -> ShowS
showList :: [ProofOfPossession] -> ShowS
Show)
  deriving newtype (Typeable ProofOfPossession
Typeable ProofOfPossession =>
(forall s. Decoder s ProofOfPossession)
-> (Proxy ProofOfPossession -> Text) -> FromCBOR ProofOfPossession
Proxy ProofOfPossession -> Text
forall s. Decoder s ProofOfPossession
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s ProofOfPossession
fromCBOR :: forall s. Decoder s ProofOfPossession
$clabel :: Proxy ProofOfPossession -> Text
label :: Proxy ProofOfPossession -> Text
FromCBOR, Typeable ProofOfPossession
Typeable ProofOfPossession =>
(ProofOfPossession -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy ProofOfPossession -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [ProofOfPossession] -> Size)
-> ToCBOR ProofOfPossession
ProofOfPossession -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ProofOfPossession] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProofOfPossession -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: ProofOfPossession -> Encoding
toCBOR :: ProofOfPossession -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProofOfPossession -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProofOfPossession -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ProofOfPossession] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ProofOfPossession] -> Size
ToCBOR)

-- TODO: get these contexts directly from @cardano-base@ after
-- https://github.com/IntersectMBO/cardano-base/pull/635
-- is merged.

-- Basic over G1:
-- https://www.ietf.org/archive/id/draft-irtf-cfrg-bls-signature-06.html#section-4.2.1-1
minSigSignatureDST :: BLS12381SignContext
minSigSignatureDST :: BLS12381SignContext
minSigSignatureDST =
  BLS12381SignContext
    { blsSignContextDst :: Maybe ByteString
blsSignContextDst = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_NUL_"
    , blsSignContextAug :: Maybe ByteString
blsSignContextAug = Maybe ByteString
forall a. Maybe a
Nothing
    }

-- PoP over G1:
-- https://www.ietf.org/archive/id/draft-irtf-cfrg-bls-signature-06.html#section-4.2.3-1
minSigPoPDST :: BLS12381SignContext
minSigPoPDST :: BLS12381SignContext
minSigPoPDST =
  BLS12381SignContext
    { blsSignContextDst :: Maybe ByteString
blsSignContextDst = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_"
    , blsSignContextAug :: Maybe ByteString
blsSignContextAug = Maybe ByteString
forall a. Maybe a
Nothing
    }

-- | Role-separated BLS contexts for  signatures
class HasBLSContext (r :: KeyRole) where
  blsCtx :: Proxy r -> KeyScope -> BLS12381SignContext

instance HasBLSContext SIGN where
  blsCtx :: Proxy SIGN -> ByteString -> BLS12381SignContext
blsCtx Proxy SIGN
_ ByteString
keyScope =
    BLS12381SignContext
minSigSignatureDST
      { blsSignContextAug =
          Just ("VOTE:" <> keyScope <> ":V0")
      }

instance HasBLSContext VRF where
  blsCtx :: Proxy VRF -> ByteString -> BLS12381SignContext
blsCtx Proxy VRF
_ ByteString
keyScope =
    BLS12381SignContext
minSigSignatureDST
      { blsSignContextAug =
          Just ("VRF:" <> keyScope <> ":V0")
      }

instance HasBLSContext POP where
  blsCtx :: Proxy POP -> ByteString -> BLS12381SignContext
blsCtx Proxy POP
_ ByteString
keyScope =
    BLS12381SignContext
minSigPoPDST
      { blsSignContextAug =
          Just ("POP:" <> keyScope <> ":V0")
      }

-- | Sign a message with a  private key, producing a  signature
signWithRole ::
  forall r msg.
  ( SignableRepresentation msg
  , HasBLSContext r
  ) =>
  PrivateKey r ->
  msg ->
  Signature r
signWithRole :: forall (r :: KeyRole) msg.
(SignableRepresentation msg, HasBLSContext r) =>
PrivateKey r -> msg -> Signature r
signWithRole PrivateKey r
sk msg
msg =
  Signature
    { unSignature :: SigDSIGN BLS12381MinSigDSIGN
unSignature =
        ContextDSIGN BLS12381MinSigDSIGN
-> msg
-> SignKeyDSIGN BLS12381MinSigDSIGN
-> SigDSIGN BLS12381MinSigDSIGN
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable BLS12381MinSigDSIGN a, HasCallStack) =>
ContextDSIGN BLS12381MinSigDSIGN
-> a
-> SignKeyDSIGN BLS12381MinSigDSIGN
-> SigDSIGN BLS12381MinSigDSIGN
signDSIGN
          (Proxy r -> ByteString -> BLS12381SignContext
forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> ByteString -> BLS12381SignContext
blsCtx (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @r) (PrivateKey r -> ByteString
forall (r :: KeyRole). PrivateKey r -> ByteString
privateKeyScope PrivateKey r
sk))
          msg
msg
          (PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
unPrivateKey PrivateKey r
sk)
    }

-- | Verify a  signature on a message with a  public key
verifyWithRole ::
  forall r msg.
  ( SignableRepresentation msg
  , HasBLSContext r
  ) =>
  PublicKey r ->
  msg ->
  Signature r ->
  Either String ()
verifyWithRole :: forall (r :: KeyRole) msg.
(SignableRepresentation msg, HasBLSContext r) =>
PublicKey r -> msg -> Signature r -> Either String ()
verifyWithRole PublicKey r
pk msg
msg (Signature SigDSIGN BLS12381MinSigDSIGN
sig) =
  ContextDSIGN BLS12381MinSigDSIGN
-> VerKeyDSIGN BLS12381MinSigDSIGN
-> msg
-> SigDSIGN BLS12381MinSigDSIGN
-> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable BLS12381MinSigDSIGN a, HasCallStack) =>
ContextDSIGN BLS12381MinSigDSIGN
-> VerKeyDSIGN BLS12381MinSigDSIGN
-> a
-> SigDSIGN BLS12381MinSigDSIGN
-> Either String ()
verifyDSIGN
    (Proxy r -> ByteString -> BLS12381SignContext
forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> ByteString -> BLS12381SignContext
blsCtx (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @r) (PublicKey r -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope PublicKey r
pk))
    (PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
unPublicKey PublicKey r
pk)
    msg
msg
    SigDSIGN BLS12381MinSigDSIGN
sig

-- | Create a proof of possession signature for a  private key
createProofOfPossession ::
  PrivateKey POP ->
  KeyHash StakePool ->
  ProofOfPossession
createProofOfPossession :: PrivateKey POP -> KeyHash StakePool -> ProofOfPossession
createProofOfPossession PrivateKey POP
sk KeyHash StakePool
stakePoolHash =
  ProofOfPossession
    { unProofOfPossession :: PossessionProofDSIGN BLS12381MinSigDSIGN
unProofOfPossession =
        ContextDSIGN BLS12381MinSigDSIGN
-> SignKeyDSIGN BLS12381MinSigDSIGN
-> PossessionProofDSIGN BLS12381MinSigDSIGN
forall v.
(DSIGNAggregatable v, HasCallStack) =>
ContextDSIGN v -> SignKeyDSIGN v -> PossessionProofDSIGN v
createPossessionProofDSIGN
          ContextDSIGN BLS12381MinSigDSIGN
BLS12381SignContext
extCtx
          (PrivateKey POP -> SignKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PrivateKey r -> SignKeyDSIGN BLS12381MinSigDSIGN
unPrivateKey PrivateKey POP
sk)
    }
 where
  poolBytes :: ByteString
poolBytes = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes (KeyHash StakePool -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
unKeyHash KeyHash StakePool
stakePoolHash)
  baseCtx :: BLS12381SignContext
baseCtx = Proxy POP -> ByteString -> BLS12381SignContext
forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> ByteString -> BLS12381SignContext
blsCtx (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @POP) (PrivateKey POP -> ByteString
forall (r :: KeyRole). PrivateKey r -> ByteString
privateKeyScope PrivateKey POP
sk)
  extCtx :: BLS12381SignContext
extCtx = BLS12381SignContext
baseCtx{blsSignContextAug = blsSignContextAug baseCtx <> Just poolBytes}

-- | Verify a proof of possession signature for a public key
verifyProofOfPossession ::
  PublicKey POP ->
  KeyHash StakePool ->
  ProofOfPossession ->
  Either String ()
verifyProofOfPossession :: PublicKey POP
-> KeyHash StakePool -> ProofOfPossession -> Either String ()
verifyProofOfPossession PublicKey POP
pk KeyHash StakePool
stakePoolHash ProofOfPossession
pop =
  ContextDSIGN BLS12381MinSigDSIGN
-> VerKeyDSIGN BLS12381MinSigDSIGN
-> PossessionProofDSIGN BLS12381MinSigDSIGN
-> Either String ()
forall v.
(DSIGNAggregatable v, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> PossessionProofDSIGN v -> Either String ()
verifyPossessionProofDSIGN
    ContextDSIGN BLS12381MinSigDSIGN
BLS12381SignContext
extCtx
    (PublicKey POP -> VerKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
unPublicKey PublicKey POP
pk)
    (ProofOfPossession -> PossessionProofDSIGN BLS12381MinSigDSIGN
unProofOfPossession ProofOfPossession
pop)
 where
  poolBytes :: ByteString
poolBytes = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes (KeyHash StakePool -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
unKeyHash KeyHash StakePool
stakePoolHash)
  baseCtx :: BLS12381SignContext
baseCtx = Proxy POP -> ByteString -> BLS12381SignContext
forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> ByteString -> BLS12381SignContext
blsCtx (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @POP) (PublicKey POP -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope PublicKey POP
pk)
  extCtx :: BLS12381SignContext
extCtx = BLS12381SignContext
baseCtx{blsSignContextAug = blsSignContextAug baseCtx <> Just poolBytes}

-- * Aggregate keys and signatures

-- | Aggregate multiple public keys into a single one.
--
-- PRECONDITION: all keys must have the same scope.
--
-- PRECONDITION: this assumes that proofs of possession have already been
-- verified for all keys in advance.
aggregatePublicKeys ::
  NE [PublicKey r] ->
  Either String (PublicKey r)
aggregatePublicKeys :: forall (r :: KeyRole).
NE [PublicKey r] -> Either String (PublicKey r)
aggregatePublicKeys keys :: NE [PublicKey r]
keys@(PublicKey r
firstKey :| [PublicKey r]
restKeys) = do
  -- Ensure all keys have the same scope before aggregation
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= PublicKey r -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope PublicKey r
firstKey) ((PublicKey r -> ByteString) -> [PublicKey r] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey r -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope [PublicKey r]
restKeys)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"Cannot aggregate public keys with different scopes"
  aggKey <-
    [VerKeyDSIGN BLS12381MinSigDSIGN]
-> Either String (VerKeyDSIGN BLS12381MinSigDSIGN)
forall v.
(DSIGNAggregatable v, HasCallStack) =>
[VerKeyDSIGN v] -> Either String (VerKeyDSIGN v)
uncheckedAggregateVerKeysDSIGN
      ([VerKeyDSIGN BLS12381MinSigDSIGN]
 -> Either String (VerKeyDSIGN BLS12381MinSigDSIGN))
-> (NE [PublicKey r] -> [VerKeyDSIGN BLS12381MinSigDSIGN])
-> NE [PublicKey r]
-> Either String (VerKeyDSIGN BLS12381MinSigDSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN)
-> [PublicKey r] -> [VerKeyDSIGN BLS12381MinSigDSIGN]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole).
PublicKey r -> VerKeyDSIGN BLS12381MinSigDSIGN
unPublicKey
      ([PublicKey r] -> [VerKeyDSIGN BLS12381MinSigDSIGN])
-> (NonEmpty (PublicKey r) -> [PublicKey r])
-> NonEmpty (PublicKey r)
-> [VerKeyDSIGN BLS12381MinSigDSIGN]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PublicKey r) -> [PublicKey r]
forall a. NonEmpty a -> [a]
NonEmpty.toList
      (NE [PublicKey r]
 -> Either String (VerKeyDSIGN BLS12381MinSigDSIGN))
-> NE [PublicKey r]
-> Either String (VerKeyDSIGN BLS12381MinSigDSIGN)
forall a b. (a -> b) -> a -> b
$ NE [PublicKey r]
keys
  pure $
    PublicKey
      { unPublicKey = aggKey
      , publicKeyScope = publicKeyScope firstKey
      }

-- | Aggregate multiple signatures into a single one
aggregateSignatures ::
  NE [Signature r] ->
  Either String (Signature r)
aggregateSignatures :: forall (r :: KeyRole).
NE [Signature r] -> Either String (Signature r)
aggregateSignatures NE [Signature r]
sigs =
  (SigDSIGN BLS12381MinSigDSIGN -> Signature r)
-> Either String (SigDSIGN BLS12381MinSigDSIGN)
-> Either String (Signature r)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigDSIGN BLS12381MinSigDSIGN -> Signature r
forall (r :: KeyRole). SigDSIGN BLS12381MinSigDSIGN -> Signature r
Signature
    (Either String (SigDSIGN BLS12381MinSigDSIGN)
 -> Either String (Signature r))
-> (NE [Signature r]
    -> Either String (SigDSIGN BLS12381MinSigDSIGN))
-> NE [Signature r]
-> Either String (Signature r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SigDSIGN BLS12381MinSigDSIGN]
-> Either String (SigDSIGN BLS12381MinSigDSIGN)
forall v.
(DSIGNAggregatable v, HasCallStack) =>
[SigDSIGN v] -> Either String (SigDSIGN v)
aggregateSigsDSIGN
    ([SigDSIGN BLS12381MinSigDSIGN]
 -> Either String (SigDSIGN BLS12381MinSigDSIGN))
-> (NonEmpty (Signature r) -> [SigDSIGN BLS12381MinSigDSIGN])
-> NonEmpty (Signature r)
-> Either String (SigDSIGN BLS12381MinSigDSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signature r -> SigDSIGN BLS12381MinSigDSIGN)
-> [Signature r] -> [SigDSIGN BLS12381MinSigDSIGN]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature r -> SigDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole). Signature r -> SigDSIGN BLS12381MinSigDSIGN
unSignature
    ([Signature r] -> [SigDSIGN BLS12381MinSigDSIGN])
-> (NonEmpty (Signature r) -> [Signature r])
-> NonEmpty (Signature r)
-> [SigDSIGN BLS12381MinSigDSIGN]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Signature r) -> [Signature r]
forall a. NonEmpty a -> [a]
NonEmpty.toList
    (NE [Signature r] -> Either String (Signature r))
-> NE [Signature r] -> Either String (Signature r)
forall a b. (a -> b) -> a -> b
$ NE [Signature r]
sigs

-- * VRF signature manipulation

-- | Convert a BLS signature to a natural number for use in local sortition
signatureNatural ::
  Signature VRF ->
  Natural
signatureNatural :: Signature VRF -> Natural
signatureNatural Signature VRF
sig =
  ByteString -> Natural
bytesToNatural
    (ByteString -> Natural)
-> (Signature VRF -> ByteString) -> Signature VRF -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH (SigDSIGN BLS12381MinSigDSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes
    (Hash HASH (SigDSIGN BLS12381MinSigDSIGN) -> ByteString)
-> (Signature VRF -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN))
-> Signature VRF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith @HASH SigDSIGN BLS12381MinSigDSIGN -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN
    (SigDSIGN BLS12381MinSigDSIGN
 -> Hash HASH (SigDSIGN BLS12381MinSigDSIGN))
-> (Signature VRF -> SigDSIGN BLS12381MinSigDSIGN)
-> Signature VRF
-> Hash HASH (SigDSIGN BLS12381MinSigDSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature VRF -> SigDSIGN BLS12381MinSigDSIGN
forall (r :: KeyRole). Signature r -> SigDSIGN BLS12381MinSigDSIGN
unSignature
    (Signature VRF -> Natural) -> Signature VRF -> Natural
forall a b. (a -> b) -> a -> b
$ Signature VRF
sig

-- | The maximum natural number that can be produced by a BLS signature
signatureNaturalMax :: Natural
signatureNaturalMax :: Natural
signatureNaturalMax =
  Natural
2 Natural -> Integer -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^ ((Integer
8 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
hashSize) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
 where
  hashSize :: Integer
hashSize =
    Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy HASH -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.hashSize (Proxy HASH
forall {k} (t :: k). Proxy t
Proxy :: Proxy HASH))

-- | Create a normalized VRF output from a BLS signature
toNormalizedVRFOutput ::
  Signature VRF ->
  NormalizedVRFOutput
toNormalizedVRFOutput :: Signature VRF -> NormalizedVRFOutput
toNormalizedVRFOutput Signature VRF
sig =
  Rational -> NormalizedVRFOutput
NormalizedVRFOutput (Rational -> NormalizedVRFOutput)
-> Rational -> NormalizedVRFOutput
forall a b. (a -> b) -> a -> b
$
    Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Signature VRF -> Natural
signatureNatural Signature VRF
sig)
      Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Natural -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
signatureNaturalMax

-- * Linearized VRF output verification

-- | Verify a list of VRF outputs against on the same input using linearization.
--
-- The idea is to first aggregate all public keys and VRF outputs into a single
-- aggregate ones. These can then be verified in one go, saving the (higher)
-- cost of multiple signature verifications.
--
-- However, since we later derive a numeric value from each individual VRF
-- output, verifying the aggregate signature alone is not sufficient. This is
-- because an attacker could swap their (bad) VRF output with someone else's
-- (better) one, and a naive signature aggregation and verification approach
-- would still succeed.
--
-- Instead, each VRF output is first linearized using a scalar derived from the
-- signature itself, and then aggregated together. This way, if an attacker
-- tries to swap their VRF output with someone else's, the linearization will
-- produce a different aggregate signature that will fail verification.
--
-- PRECONDITION: all keys must have the same scope.
--
-- PRECONDITION: the number of signatures must match the number of keys.
linearizeAndVerifyVRFs ::
  SignableRepresentation msg =>
  NE [PublicKey VRF] ->
  msg ->
  NE [Signature VRF] ->
  Either String ()
linearizeAndVerifyVRFs :: forall msg.
SignableRepresentation msg =>
NE [PublicKey VRF] -> msg -> NE [Signature VRF] -> Either String ()
linearizeAndVerifyVRFs keys :: NE [PublicKey VRF]
keys@(PublicKey VRF
firstKey :| [PublicKey VRF]
restKeys) msg
msg NE [Signature VRF]
sigs = do
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= PublicKey VRF -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope PublicKey VRF
firstKey) ((PublicKey VRF -> ByteString) -> [PublicKey VRF] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey VRF -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope [PublicKey VRF]
restKeys)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"Cannot aggregate public keys with different scopes"

  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty (Signature VRF) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Signature VRF)
NE [Signature VRF]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty (PublicKey VRF) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (PublicKey VRF)
NE [PublicKey VRF]
keys) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"Number of signatures must match number of public keys"

  let scalars :: NonEmpty Integer
scalars =
        (Signature VRF -> Integer)
-> NonEmpty (Signature VRF) -> NonEmpty Integer
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map
          (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer)
-> (Signature VRF -> Natural) -> Signature VRF -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature VRF -> Natural
signatureNatural)
          NonEmpty (Signature VRF)
NE [Signature VRF]
sigs

  let linearizedKeyPoint :: Point Curve2
linearizedKeyPoint =
        [(Integer, Point Curve2)] -> Point Curve2
forall curve. BLS curve => [(Integer, Point curve)] -> Point curve
blsMSM
          ([(Integer, Point Curve2)] -> Point Curve2)
-> (NE [PublicKey VRF] -> [(Integer, Point Curve2)])
-> NE [PublicKey VRF]
-> Point Curve2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Integer, Point Curve2) -> [(Integer, Point Curve2)]
forall a. NonEmpty a -> [a]
NonEmpty.toList
          (NonEmpty (Integer, Point Curve2) -> [(Integer, Point Curve2)])
-> (NonEmpty (PublicKey VRF) -> NonEmpty (Integer, Point Curve2))
-> NonEmpty (PublicKey VRF)
-> [(Integer, Point Curve2)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Integer
-> NonEmpty (Point Curve2) -> NonEmpty (Integer, Point Curve2)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty Integer
scalars
          (NonEmpty (Point Curve2) -> NonEmpty (Integer, Point Curve2))
-> (NonEmpty (PublicKey VRF) -> NonEmpty (Point Curve2))
-> NonEmpty (PublicKey VRF)
-> NonEmpty (Integer, Point Curve2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PublicKey VRF -> Point Curve2)
-> NonEmpty (PublicKey VRF) -> NonEmpty (Point Curve2)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\(PublicKey (VerKeyBLS12381 Point Curve2
p) ByteString
_) -> Point Curve2
p)
          (NE [PublicKey VRF] -> Point Curve2)
-> NE [PublicKey VRF] -> Point Curve2
forall a b. (a -> b) -> a -> b
$ NE [PublicKey VRF]
keys

  let linearizedSigPoint :: Point Curve1
linearizedSigPoint =
        [(Integer, Point Curve1)] -> Point Curve1
forall curve. BLS curve => [(Integer, Point curve)] -> Point curve
blsMSM
          ([(Integer, Point Curve1)] -> Point Curve1)
-> (NE [Signature VRF] -> [(Integer, Point Curve1)])
-> NE [Signature VRF]
-> Point Curve1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Integer, Point Curve1) -> [(Integer, Point Curve1)]
forall a. NonEmpty a -> [a]
NonEmpty.toList
          (NonEmpty (Integer, Point Curve1) -> [(Integer, Point Curve1)])
-> (NonEmpty (Signature VRF) -> NonEmpty (Integer, Point Curve1))
-> NonEmpty (Signature VRF)
-> [(Integer, Point Curve1)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Integer
-> NonEmpty (Point Curve1) -> NonEmpty (Integer, Point Curve1)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty Integer
scalars
          (NonEmpty (Point Curve1) -> NonEmpty (Integer, Point Curve1))
-> (NonEmpty (Signature VRF) -> NonEmpty (Point Curve1))
-> NonEmpty (Signature VRF)
-> NonEmpty (Integer, Point Curve1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signature VRF -> Point Curve1)
-> NonEmpty (Signature VRF) -> NonEmpty (Point Curve1)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\(Signature (SigBLS12381 Point (DualCurve Curve2)
p)) -> Point Curve1
Point (DualCurve Curve2)
p)
          (NE [Signature VRF] -> Point Curve1)
-> NE [Signature VRF] -> Point Curve1
forall a b. (a -> b) -> a -> b
$ NE [Signature VRF]
sigs

  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Point Curve2 -> Bool
forall curve. BLS curve => Point curve -> Bool
blsIsInf Point Curve2
linearizedKeyPoint) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"Resulting key point is at infinity, cannot linearize"

  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Point Curve1 -> Bool
forall curve. BLS curve => Point curve -> Bool
blsIsInf Point Curve1
linearizedSigPoint) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"Resulting signature point is at infinity, cannot linearize"

  let linearizedKey :: PublicKey VRF
linearizedKey =
        VerKeyDSIGN BLS12381MinSigDSIGN -> ByteString -> PublicKey VRF
forall (r :: KeyRole).
VerKeyDSIGN BLS12381MinSigDSIGN -> ByteString -> PublicKey r
PublicKey
          (Point Curve2 -> VerKeyDSIGN BLS12381MinSigDSIGN
forall curve. Point curve -> VerKeyDSIGN (BLS12381DSIGN curve)
VerKeyBLS12381 Point Curve2
linearizedKeyPoint)
          (PublicKey VRF -> ByteString
forall (r :: KeyRole). PublicKey r -> ByteString
publicKeyScope PublicKey VRF
firstKey)

  let linearizedSig :: Signature VRF
linearizedSig =
        SigDSIGN BLS12381MinSigDSIGN -> Signature VRF
forall (r :: KeyRole). SigDSIGN BLS12381MinSigDSIGN -> Signature r
Signature
          (Point (DualCurve Curve2) -> SigDSIGN BLS12381MinSigDSIGN
forall curve.
Point (DualCurve curve) -> SigDSIGN (BLS12381DSIGN curve)
SigBLS12381 Point Curve1
Point (DualCurve Curve2)
linearizedSigPoint)

  forall (r :: KeyRole) msg.
(SignableRepresentation msg, HasBLSContext r) =>
PublicKey r -> msg -> Signature r -> Either String ()
verifyWithRole @VRF PublicKey VRF
linearizedKey msg
msg Signature VRF
linearizedSig