-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
-- SPDX-License-Identifier: MPL-2.0

-- for inequality on keygen
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Crypto.BLST
  ( -- * Main functions
    keygen
  , skToPk
  , sign
  , verify
  , serializeSk
  , deserializeSk
  , serializePk
  , deserializePk
  , compressPk
  , decompressPk
  , serializeSignature
  , deserializeSignature
  , compressSignature
  , decompressSignature

    -- * Aggregate signatures
  , aggregateSignatures
  , aggregateVerify

    -- * Representation datatypes
  , SecretKey
  , PublicKey
  , Signature
  , B.BlstError(..)

    -- * Utility typeclasses
  , IsCurve
  , IsPoint
  , ToCurve
  , Demote

    -- * Data kinds
  , Curve(..)
  , B.EncodeMethod(..)

    -- * Typelevel byte sizes
  , ByteSize
  , SerializeOrCompress(..)

    -- * Misc helpers
  , noDST
  , byteSize
  ) where

import Control.Exception (catch, throwIO)
import Control.Monad (forM_)
import Data.ByteArray (ByteArrayAccess, Bytes, ScrubbedBytes)
import Data.ByteArray.Sized (SizedByteArray, unSizedByteArray)
import Data.Foldable (foldlM)
import Data.List.NonEmpty (NonEmpty(..))
import GHC.TypeNats (KnownNat, type (<=))
import System.IO.Unsafe (unsafePerformIO)

import Crypto.BLST.Internal.Bindings qualified as B
import Crypto.BLST.Internal.Classy
import Crypto.BLST.Internal.Demote
import Crypto.BLST.Internal.Types

-- | Generate a secret key from bytes.
keygen :: (ByteArrayAccess ba, 32 <= n, KnownNat n) => SizedByteArray n ba -> SecretKey
keygen :: forall ba (n :: Natural).
(ByteArrayAccess ba, 32 <= n, KnownNat n) =>
SizedByteArray n ba -> SecretKey
keygen = Scalar -> SecretKey
SecretKey (Scalar -> SecretKey)
-> (SizedByteArray n ba -> Scalar)
-> SizedByteArray n ba
-> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Scalar -> Scalar
forall a. IO a -> a
unsafePerformIO (IO Scalar -> Scalar)
-> (SizedByteArray n ba -> IO Scalar)
-> SizedByteArray n ba
-> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ba -> IO Scalar
forall ba. ByteArrayAccess ba => ba -> IO Scalar
B.keygen (ba -> IO Scalar)
-> (SizedByteArray n ba -> ba) -> SizedByteArray n ba -> IO Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray n ba -> ba
forall (n :: Natural) ba. SizedByteArray n ba -> ba
unSizedByteArray
{-# NOINLINE keygen #-}

-- | Convert a secret key to the corresponding public key on a given curve.
skToPk :: forall c. IsCurve c => SecretKey -> PublicKey c
skToPk :: forall (c :: Curve). IsCurve c => SecretKey -> PublicKey c
skToPk (SecretKey Scalar
sk) = Affine (CurveToPkPoint c) -> PublicKey c
forall (c :: Curve). Affine (CurveToPkPoint c) -> PublicKey c
PublicKey (Affine (CurveToPkPoint c) -> PublicKey c)
-> Affine (CurveToPkPoint c) -> PublicKey c
forall a b. (a -> b) -> a -> b
$ IO (Affine (CurveToPkPoint c)) -> Affine (CurveToPkPoint c)
forall a. IO a -> a
unsafePerformIO (IO (Affine (CurveToPkPoint c)) -> Affine (CurveToPkPoint c))
-> IO (Affine (CurveToPkPoint c)) -> Affine (CurveToPkPoint c)
forall a b. (a -> b) -> a -> b
$ Scalar -> IO (Point (CurveToPkPoint c))
forall (c :: Curve).
IsCurve c =>
Scalar -> IO (Point (CurveToPkPoint c))
skToPkPoint Scalar
sk IO (Point (CurveToPkPoint c))
-> (Point (CurveToPkPoint c) -> IO (Affine (CurveToPkPoint c)))
-> IO (Affine (CurveToPkPoint c))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point (CurveToPkPoint c) -> IO (Affine (CurveToPkPoint c))
forall (p :: PointKind). IsPoint p => Point p -> IO (Affine p)
toAffine
{-# NOINLINE skToPk #-}

-- | Serialize public key.
serializePk
  :: forall c. IsCurve c
  => PublicKey c
  -> SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes
serializePk :: forall (c :: Curve).
IsCurve c =>
PublicKey c
-> SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes
serializePk (PublicKey Affine (CurveToPkPoint c)
pk) = IO (SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes)
-> SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes
forall a. IO a -> a
unsafePerformIO (IO (SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes)
 -> SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes)
-> IO (SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes)
-> SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes
forall a b. (a -> b) -> a -> b
$ Affine (CurveToPkPoint c)
-> IO (SizedByteArray (SerializedSize (CurveToPkPoint c)) Bytes)
forall (p :: PointKind).
IsPoint p =>
Affine p -> IO (SizedByteArray (SerializedSize p) Bytes)
affSerialize Affine (CurveToPkPoint c)
pk
{-# NOINLINE serializePk #-}

-- | Deserialize public key.
deserializePk
  :: forall c ba. (IsCurve c, ByteArrayAccess ba)
  => SizedByteArray (SerializedSize (CurveToPkPoint c)) ba
  -> Either B.BlstError (PublicKey c)
deserializePk :: forall (c :: Curve) ba.
(IsCurve c, ByteArrayAccess ba) =>
SizedByteArray (SerializedSize (CurveToPkPoint c)) ba
-> Either BlstError (PublicKey c)
deserializePk SizedByteArray (SerializedSize (CurveToPkPoint c)) ba
bs = IO (Either BlstError (PublicKey c))
-> Either BlstError (PublicKey c)
forall a. IO a -> a
unsafePerformIO (IO (Either BlstError (PublicKey c))
 -> Either BlstError (PublicKey c))
-> IO (Either BlstError (PublicKey c))
-> Either BlstError (PublicKey c)
forall a b. (a -> b) -> a -> b
$ (Affine (CurveToPkPoint c) -> PublicKey c)
-> Either BlstError (Affine (CurveToPkPoint c))
-> Either BlstError (PublicKey c)
forall a b. (a -> b) -> Either BlstError a -> Either BlstError b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Affine (CurveToPkPoint c) -> PublicKey c
forall (c :: Curve). Affine (CurveToPkPoint c) -> PublicKey c
PublicKey (Either BlstError (Affine (CurveToPkPoint c))
 -> Either BlstError (PublicKey c))
-> IO (Either BlstError (Affine (CurveToPkPoint c)))
-> IO (Either BlstError (PublicKey c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SizedByteArray (SerializedSize (CurveToPkPoint c)) ba
-> IO (Either BlstError (Affine (CurveToPkPoint c)))
forall ba.
ByteArrayAccess ba =>
SizedByteArray (SerializedSize (CurveToPkPoint c)) ba
-> IO (Either BlstError (Affine (CurveToPkPoint c)))
forall (p :: PointKind) ba.
(IsPoint p, ByteArrayAccess ba) =>
SizedByteArray (SerializedSize p) ba
-> IO (Either BlstError (Affine p))
deserialize SizedByteArray (SerializedSize (CurveToPkPoint c)) ba
bs
{-# NOINLINE deserializePk #-}

-- | Compress public key.
compressPk
  :: forall c. IsCurve c
  => PublicKey c
  -> SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes
compressPk :: forall (c :: Curve).
IsCurve c =>
PublicKey c
-> SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes
compressPk (PublicKey Affine (CurveToPkPoint c)
pk) = IO (SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes)
-> SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes
forall a. IO a -> a
unsafePerformIO (IO (SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes)
 -> SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes)
-> IO (SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes)
-> SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes
forall a b. (a -> b) -> a -> b
$ Affine (CurveToPkPoint c)
-> IO (SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes)
forall (p :: PointKind).
IsPoint p =>
Affine p -> IO (SizedByteArray (CompressedSize p) Bytes)
affCompress Affine (CurveToPkPoint c)
pk
{-# NOINLINE compressPk #-}

-- | Decompress public key.
decompressPk
  :: forall c ba. (IsCurve c, ByteArrayAccess ba)
  => SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
  -> Either B.BlstError (PublicKey c)
decompressPk :: forall (c :: Curve) ba.
(IsCurve c, ByteArrayAccess ba) =>
SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
-> Either BlstError (PublicKey c)
decompressPk SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
bs = IO (Either BlstError (PublicKey c))
-> Either BlstError (PublicKey c)
forall a. IO a -> a
unsafePerformIO (IO (Either BlstError (PublicKey c))
 -> Either BlstError (PublicKey c))
-> IO (Either BlstError (PublicKey c))
-> Either BlstError (PublicKey c)
forall a b. (a -> b) -> a -> b
$ (Affine (CurveToPkPoint c) -> PublicKey c)
-> Either BlstError (Affine (CurveToPkPoint c))
-> Either BlstError (PublicKey c)
forall a b. (a -> b) -> Either BlstError a -> Either BlstError b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Affine (CurveToPkPoint c) -> PublicKey c
forall (c :: Curve). Affine (CurveToPkPoint c) -> PublicKey c
PublicKey (Either BlstError (Affine (CurveToPkPoint c))
 -> Either BlstError (PublicKey c))
-> IO (Either BlstError (Affine (CurveToPkPoint c)))
-> IO (Either BlstError (PublicKey c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
-> IO (Either BlstError (Affine (CurveToPkPoint c)))
forall ba.
ByteArrayAccess ba =>
SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
-> IO (Either BlstError (Affine (CurveToPkPoint c)))
forall (p :: PointKind) ba.
(IsPoint p, ByteArrayAccess ba) =>
SizedByteArray (CompressedSize p) ba
-> IO (Either BlstError (Affine p))
uncompress SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
bs
{-# NOINLINE decompressPk #-}

-- | Sign a single message.
sign
  :: forall c m ba ba2. (ToCurve m c, ByteArrayAccess ba, ByteArrayAccess ba2)
  => SecretKey -- ^ Secret key
  -> ba -- ^ Message to sign
  -> Maybe ba2 -- ^ Optional domain separation tag
  -> Signature c m
sign :: forall (c :: Curve) (m :: EncodeMethod) ba ba2.
(ToCurve m c, ByteArrayAccess ba, ByteArrayAccess ba2) =>
SecretKey -> ba -> Maybe ba2 -> Signature c m
sign (SecretKey Scalar
sk) ba
bytes Maybe ba2
dst = Affine (CurveToMsgPoint c) -> Signature c m
forall (c :: Curve) (m :: EncodeMethod).
Affine (CurveToMsgPoint c) -> Signature c m
Signature (Affine (CurveToMsgPoint c) -> Signature c m)
-> Affine (CurveToMsgPoint c) -> Signature c m
forall a b. (a -> b) -> a -> b
$ IO (Affine (CurveToMsgPoint c)) -> Affine (CurveToMsgPoint c)
forall a. IO a -> a
unsafePerformIO (IO (Affine (CurveToMsgPoint c)) -> Affine (CurveToMsgPoint c))
-> IO (Affine (CurveToMsgPoint c)) -> Affine (CurveToMsgPoint c)
forall a b. (a -> b) -> a -> b
$ do
  Point (CurveToMsgPoint c)
encMsg <- forall (meth :: EncodeMethod) (c :: Curve) ba ba2.
(ToCurve meth c, ByteArrayAccess ba, ByteArrayAccess ba2) =>
ba -> Maybe ba2 -> IO (Point (CurveToMsgPoint c))
toCurve @m ba
bytes Maybe ba2
dst
  Point (CurveToMsgPoint c)
-> Scalar -> IO (Point (CurveToMsgPoint c))
forall (c :: Curve).
IsCurve c =>
Point (CurveToMsgPoint c)
-> Scalar -> IO (Point (CurveToMsgPoint c))
signPk Point (CurveToMsgPoint c)
encMsg Scalar
sk IO (Point (CurveToMsgPoint c))
-> (Point (CurveToMsgPoint c) -> IO (Affine (CurveToMsgPoint c)))
-> IO (Affine (CurveToMsgPoint c))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point (CurveToMsgPoint c) -> IO (Affine (CurveToMsgPoint c))
forall (p :: PointKind). IsPoint p => Point p -> IO (Affine p)
toAffine
{-# NOINLINE sign #-}

-- | Serialize message signature.
serializeSignature
  :: forall c m. IsCurve c
  => Signature c m
  -> SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes
serializeSignature :: forall (c :: Curve) (m :: EncodeMethod).
IsCurve c =>
Signature c m
-> SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes
serializeSignature (Signature Affine (CurveToMsgPoint c)
sig) = IO (SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes)
-> SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes
forall a. IO a -> a
unsafePerformIO (IO (SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes)
 -> SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes)
-> IO (SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes)
-> SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes
forall a b. (a -> b) -> a -> b
$ Affine (CurveToMsgPoint c)
-> IO (SizedByteArray (SerializedSize (CurveToMsgPoint c)) Bytes)
forall (p :: PointKind).
IsPoint p =>
Affine p -> IO (SizedByteArray (SerializedSize p) Bytes)
affSerialize Affine (CurveToMsgPoint c)
sig
{-# NOINLINE serializeSignature #-}

-- | Deserialize message signature.
deserializeSignature
  :: forall c m ba. (IsCurve c, ByteArrayAccess ba)
  => SizedByteArray (SerializedSize (CurveToMsgPoint c)) ba
  -> Either B.BlstError (Signature c m)
deserializeSignature :: forall (c :: Curve) (m :: EncodeMethod) ba.
(IsCurve c, ByteArrayAccess ba) =>
SizedByteArray (SerializedSize (CurveToMsgPoint c)) ba
-> Either BlstError (Signature c m)
deserializeSignature SizedByteArray (SerializedSize (CurveToMsgPoint c)) ba
bs = IO (Either BlstError (Signature c m))
-> Either BlstError (Signature c m)
forall a. IO a -> a
unsafePerformIO (IO (Either BlstError (Signature c m))
 -> Either BlstError (Signature c m))
-> IO (Either BlstError (Signature c m))
-> Either BlstError (Signature c m)
forall a b. (a -> b) -> a -> b
$ (Affine (CurveToMsgPoint c) -> Signature c m)
-> Either BlstError (Affine (CurveToMsgPoint c))
-> Either BlstError (Signature c m)
forall a b. (a -> b) -> Either BlstError a -> Either BlstError b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Affine (CurveToMsgPoint c) -> Signature c m
forall (c :: Curve) (m :: EncodeMethod).
Affine (CurveToMsgPoint c) -> Signature c m
Signature (Either BlstError (Affine (CurveToMsgPoint c))
 -> Either BlstError (Signature c m))
-> IO (Either BlstError (Affine (CurveToMsgPoint c)))
-> IO (Either BlstError (Signature c m))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SizedByteArray (SerializedSize (CurveToMsgPoint c)) ba
-> IO (Either BlstError (Affine (CurveToMsgPoint c)))
forall ba.
ByteArrayAccess ba =>
SizedByteArray (SerializedSize (CurveToMsgPoint c)) ba
-> IO (Either BlstError (Affine (CurveToMsgPoint c)))
forall (p :: PointKind) ba.
(IsPoint p, ByteArrayAccess ba) =>
SizedByteArray (SerializedSize p) ba
-> IO (Either BlstError (Affine p))
deserialize SizedByteArray (SerializedSize (CurveToMsgPoint c)) ba
bs
{-# NOINLINE deserializeSignature #-}

-- | Serialize and compress message signature.
compressSignature
  :: forall c m. IsCurve c
  => Signature c m
  -> SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes
compressSignature :: forall (c :: Curve) (m :: EncodeMethod).
IsCurve c =>
Signature c m
-> SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes
compressSignature (Signature Affine (CurveToMsgPoint c)
sig) = IO (SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes)
-> SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes
forall a. IO a -> a
unsafePerformIO (IO (SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes)
 -> SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes)
-> IO (SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes)
-> SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes
forall a b. (a -> b) -> a -> b
$ Affine (CurveToMsgPoint c)
-> IO (SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes)
forall (p :: PointKind).
IsPoint p =>
Affine p -> IO (SizedByteArray (CompressedSize p) Bytes)
affCompress Affine (CurveToMsgPoint c)
sig
{-# NOINLINE compressSignature #-}

-- | Decompress and deserialize message signature.
decompressSignature
  :: forall c m ba. (IsCurve c, ByteArrayAccess ba)
  => SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
  -> Either B.BlstError (Signature c m)
decompressSignature :: forall (c :: Curve) (m :: EncodeMethod) ba.
(IsCurve c, ByteArrayAccess ba) =>
SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
-> Either BlstError (Signature c m)
decompressSignature SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
bs = IO (Either BlstError (Signature c m))
-> Either BlstError (Signature c m)
forall a. IO a -> a
unsafePerformIO (IO (Either BlstError (Signature c m))
 -> Either BlstError (Signature c m))
-> IO (Either BlstError (Signature c m))
-> Either BlstError (Signature c m)
forall a b. (a -> b) -> a -> b
$ (Affine (CurveToMsgPoint c) -> Signature c m)
-> Either BlstError (Affine (CurveToMsgPoint c))
-> Either BlstError (Signature c m)
forall a b. (a -> b) -> Either BlstError a -> Either BlstError b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Affine (CurveToMsgPoint c) -> Signature c m
forall (c :: Curve) (m :: EncodeMethod).
Affine (CurveToMsgPoint c) -> Signature c m
Signature (Either BlstError (Affine (CurveToMsgPoint c))
 -> Either BlstError (Signature c m))
-> IO (Either BlstError (Affine (CurveToMsgPoint c)))
-> IO (Either BlstError (Signature c m))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
-> IO (Either BlstError (Affine (CurveToMsgPoint c)))
forall ba.
ByteArrayAccess ba =>
SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
-> IO (Either BlstError (Affine (CurveToMsgPoint c)))
forall (p :: PointKind) ba.
(IsPoint p, ByteArrayAccess ba) =>
SizedByteArray (CompressedSize p) ba
-> IO (Either BlstError (Affine p))
uncompress SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
bs
{-# NOINLINE decompressSignature #-}

-- | Verify message signature.
verify
  :: forall c m ba ba2. (IsCurve c, Demote m, ByteArrayAccess ba, ByteArrayAccess ba2)
  => Signature c m -- ^ Signature
  -> PublicKey c -- ^ Public key of the signer
  -> ba -- ^ Message
  -> Maybe ba2 -- ^ Optional domain separation tag (must be the same as used for signing!)
  -> B.BlstError
verify :: forall (c :: Curve) (m :: EncodeMethod) ba ba2.
(IsCurve c, Demote m, ByteArrayAccess ba, ByteArrayAccess ba2) =>
Signature c m -> PublicKey c -> ba -> Maybe ba2 -> BlstError
verify (Signature Affine (CurveToMsgPoint c)
sig) (PublicKey Affine (CurveToPkPoint c)
pk) ba
bytes Maybe ba2
dst =
  IO BlstError -> BlstError
forall a. IO a -> a
unsafePerformIO (IO BlstError -> BlstError) -> IO BlstError -> BlstError
forall a b. (a -> b) -> a -> b
$ Affine (CurveToPkPoint c)
-> Affine (CurveToMsgPoint c)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
forall ba ba2.
(ByteArrayAccess ba, ByteArrayAccess ba2) =>
Affine (CurveToPkPoint c)
-> Affine (CurveToMsgPoint c)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
forall (c :: Curve) ba ba2.
(IsCurve c, ByteArrayAccess ba, ByteArrayAccess ba2) =>
Affine (CurveToPkPoint c)
-> Affine (CurveToMsgPoint c)
-> EncodeMethod
-> ba
-> Maybe ba2
-> IO BlstError
coreVerifyPk Affine (CurveToPkPoint c)
pk Affine (CurveToMsgPoint c)
sig EncodeMethod
meth ba
bytes Maybe ba2
dst
  where
    meth :: EncodeMethod
meth = forall {k} (x :: k). Demote x => k
forall (x :: EncodeMethod). Demote x => EncodeMethod
demote @m
{-# NOINLINE verify #-}

-- | Convenience synonym for 'Nothing'. Do not use domain separation tag.
noDST :: Maybe Bytes
noDST :: Maybe Bytes
noDST = Maybe Bytes
forall a. Maybe a
Nothing

-- | Serialize secret key.
serializeSk :: SecretKey -> SizedByteArray B.SkSerializeSize ScrubbedBytes
serializeSk :: SecretKey -> SizedByteArray 32 ScrubbedBytes
serializeSk (SecretKey Scalar
sk) = IO (SizedByteArray 32 ScrubbedBytes)
-> SizedByteArray 32 ScrubbedBytes
forall a. IO a -> a
unsafePerformIO (IO (SizedByteArray 32 ScrubbedBytes)
 -> SizedByteArray 32 ScrubbedBytes)
-> IO (SizedByteArray 32 ScrubbedBytes)
-> SizedByteArray 32 ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Scalar -> IO (SizedByteArray 32 ScrubbedBytes)
B.lendianFromScalar Scalar
sk
{-# NOINLINE serializeSk #-}

-- | Deserialize secret key.
deserializeSk :: ByteArrayAccess ba => SizedByteArray B.SkSerializeSize ba -> SecretKey
deserializeSk :: forall ba. ByteArrayAccess ba => SizedByteArray 32 ba -> SecretKey
deserializeSk SizedByteArray 32 ba
bs = Scalar -> SecretKey
SecretKey (Scalar -> SecretKey) -> Scalar -> SecretKey
forall a b. (a -> b) -> a -> b
$ IO Scalar -> Scalar
forall a. IO a -> a
unsafePerformIO (IO Scalar -> Scalar) -> IO Scalar -> Scalar
forall a b. (a -> b) -> a -> b
$ SizedByteArray 32 ba -> IO Scalar
forall ba. ByteArrayAccess ba => SizedByteArray 32 ba -> IO Scalar
B.scalarFromLendian SizedByteArray 32 ba
bs
{-# NOINLINE deserializeSk #-}

-- | Aggregate multiple signatures.
aggregateSignatures :: forall c m. IsCurve c => NonEmpty (Signature c m) -> Signature c m
aggregateSignatures :: forall (c :: Curve) (m :: EncodeMethod).
IsCurve c =>
NonEmpty (Signature c m) -> Signature c m
aggregateSignatures (Signature Affine (CurveToMsgPoint c)
x :| [Signature c m]
xs) = Affine (CurveToMsgPoint c) -> Signature c m
forall (c :: Curve) (m :: EncodeMethod).
Affine (CurveToMsgPoint c) -> Signature c m
Signature (Affine (CurveToMsgPoint c) -> Signature c m)
-> (IO (Affine (CurveToMsgPoint c)) -> Affine (CurveToMsgPoint c))
-> IO (Affine (CurveToMsgPoint c))
-> Signature c m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Affine (CurveToMsgPoint c)) -> Affine (CurveToMsgPoint c)
forall a. IO a -> a
unsafePerformIO (IO (Affine (CurveToMsgPoint c)) -> Signature c m)
-> IO (Affine (CurveToMsgPoint c)) -> Signature c m
forall a b. (a -> b) -> a -> b
$ do
  Point (CurveToMsgPoint c)
start <- Affine (CurveToMsgPoint c) -> IO (Point (CurveToMsgPoint c))
forall (p :: PointKind). IsPoint p => Affine p -> IO (Point p)
fromAffine Affine (CurveToMsgPoint c)
x
  (Point (CurveToMsgPoint c)
 -> Signature c m -> IO (Point (CurveToMsgPoint c)))
-> Point (CurveToMsgPoint c)
-> [Signature c m]
-> IO (Point (CurveToMsgPoint c))
forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Point (CurveToMsgPoint c)
-> Signature c m -> IO (Point (CurveToMsgPoint c))
forall {c :: Curve} {m :: EncodeMethod}.
IsPoint (CurveToMsgPoint c) =>
Point (CurveToMsgPoint c)
-> Signature c m -> IO (Point (CurveToMsgPoint c))
add Point (CurveToMsgPoint c)
start [Signature c m]
xs IO (Point (CurveToMsgPoint c))
-> (Point (CurveToMsgPoint c) -> IO (Affine (CurveToMsgPoint c)))
-> IO (Affine (CurveToMsgPoint c))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point (CurveToMsgPoint c) -> IO (Affine (CurveToMsgPoint c))
forall (p :: PointKind). IsPoint p => Point p -> IO (Affine p)
toAffine
  where
    add :: Point (CurveToMsgPoint c)
-> Signature c m -> IO (Point (CurveToMsgPoint c))
add Point (CurveToMsgPoint c)
x' (Signature Affine (CurveToMsgPoint c)
y) = Point (CurveToMsgPoint c)
-> Affine (CurveToMsgPoint c) -> IO (Point (CurveToMsgPoint c))
forall (p :: PointKind).
IsPoint p =>
Point p -> Affine p -> IO (Point p)
addOrDoubleAffine Point (CurveToMsgPoint c)
x' Affine (CurveToMsgPoint c)
y
{-# NOINLINE aggregateSignatures #-}

-- | Aggregate signature verification.
aggregateVerify
  :: forall c m ba ba2. (IsCurve c, Demote m, ByteArrayAccess ba, ByteArrayAccess ba2)
  => NonEmpty (PublicKey c, ba) -- ^ Public keys with corresponding messages
  -> Signature c m -- ^ Aggregate signature
  -> Maybe ba2 -- ^ Optional domain separation tag (must be the same as used for signing!)
  -> Either B.BlstError Bool
aggregateVerify :: forall (c :: Curve) (m :: EncodeMethod) ba ba2.
(IsCurve c, Demote m, ByteArrayAccess ba, ByteArrayAccess ba2) =>
NonEmpty (PublicKey c, ba)
-> Signature c m -> Maybe ba2 -> Either BlstError Bool
aggregateVerify ((PublicKey Affine (CurveToPkPoint c)
pk1, ba
msg1) :| [(PublicKey c, ba)]
xs) (Signature Affine (CurveToMsgPoint c)
sig) Maybe ba2
dst = IO (Either BlstError Bool) -> Either BlstError Bool
forall a. IO a -> a
unsafePerformIO (IO (Either BlstError Bool) -> Either BlstError Bool)
-> IO (Either BlstError Bool) -> Either BlstError Bool
forall a b. (a -> b) -> a -> b
$ do
  PairingCtx
ctx <- EncodeMethod -> Maybe ba2 -> IO PairingCtx
forall ba.
ByteArrayAccess ba =>
EncodeMethod -> Maybe ba -> IO PairingCtx
B.pairingInit (forall {k} (x :: k). Demote x => k
forall (x :: EncodeMethod). Demote x => EncodeMethod
demote @m) Maybe ba2
dst
  BlstError -> IO ()
checkThrow (BlstError -> IO ()) -> IO BlstError -> IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< PairingCtx
-> Affine (CurveToPkPoint c)
-> Bool
-> Maybe (Affine (CurveToMsgPoint c))
-> Bool
-> ba
-> IO BlstError
forall ba.
ByteArrayAccess ba =>
PairingCtx
-> Affine (CurveToPkPoint c)
-> Bool
-> Maybe (Affine (CurveToMsgPoint c))
-> Bool
-> ba
-> IO BlstError
forall (c :: Curve) ba.
(IsCurve c, ByteArrayAccess ba) =>
PairingCtx
-> Affine (CurveToPkPoint c)
-> Bool
-> Maybe (Affine (CurveToMsgPoint c))
-> Bool
-> ba
-> IO BlstError
pairingChkNAggrPk PairingCtx
ctx Affine (CurveToPkPoint c)
pk1 Bool
True (Affine (CurveToMsgPoint c) -> Maybe (Affine (CurveToMsgPoint c))
forall a. a -> Maybe a
Just Affine (CurveToMsgPoint c)
sig) Bool
True ba
msg1
  [(PublicKey c, ba)] -> ((PublicKey c, ba) -> IO ()) -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(PublicKey c, ba)]
xs (((PublicKey c, ba) -> IO ()) -> IO ())
-> ((PublicKey c, ba) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(PublicKey Affine (CurveToPkPoint c)
pki, ba
msgi) ->
    BlstError -> IO ()
checkThrow (BlstError -> IO ()) -> IO BlstError -> IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< PairingCtx
-> Affine (CurveToPkPoint c)
-> Bool
-> Maybe (Affine (CurveToMsgPoint c))
-> Bool
-> ba
-> IO BlstError
forall ba.
ByteArrayAccess ba =>
PairingCtx
-> Affine (CurveToPkPoint c)
-> Bool
-> Maybe (Affine (CurveToMsgPoint c))
-> Bool
-> ba
-> IO BlstError
forall (c :: Curve) ba.
(IsCurve c, ByteArrayAccess ba) =>
PairingCtx
-> Affine (CurveToPkPoint c)
-> Bool
-> Maybe (Affine (CurveToMsgPoint c))
-> Bool
-> ba
-> IO BlstError
pairingChkNAggrPk PairingCtx
ctx Affine (CurveToPkPoint c)
pki Bool
True Maybe (Affine (CurveToMsgPoint c))
forall a. Maybe a
Nothing Bool
True ba
msgi
  PairingCtx -> IO ()
B.pairingCommit PairingCtx
ctx
  Bool -> Either BlstError Bool
forall a b. b -> Either a b
Right (Bool -> Either BlstError Bool)
-> IO Bool -> IO (Either BlstError Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> PairingCtx -> IO Bool
B.pairingFinalVerify PairingCtx
ctx
  IO (Either BlstError Bool)
-> (BlstError -> IO (Either BlstError Bool))
-> IO (Either BlstError Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(BlstError
err :: B.BlstError) -> Either BlstError Bool -> IO (Either BlstError Bool)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either BlstError Bool -> IO (Either BlstError Bool))
-> Either BlstError Bool -> IO (Either BlstError Bool)
forall a b. (a -> b) -> a -> b
$ BlstError -> Either BlstError Bool
forall a b. a -> Either a b
Left BlstError
err
  where
    checkThrow :: BlstError -> IO ()
checkThrow = \case
      BlstError
B.BlstSuccess -> () -> IO ()
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
      BlstError
x -> BlstError -> IO ()
forall e a. Exception e => e -> IO a
throwIO BlstError
x
{-# NOINLINE aggregateVerify #-}