-- SPDX-FileCopyrightText: 2023 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | BLS-MinPk cryptographic primitives.

module Morley.Tezos.Crypto.BLS
  ( -- * Cryptographic primitive types
    PublicKey (..)
  , SecretKey
  , Signature (..)
  , detSecretKey
  , randomSecretKey
  , toPublic

  -- * Raw bytes (no checksums, tags or anything)
  , publicKeyToBytes
  , mkPublicKey
  , publicKeyLengthBytes
  , signatureToBytes
  , mkSignature
  , signatureLengthBytes

  -- * Formatting and parsing
  , formatPublicKey
  , mformatPublicKey
  , parsePublicKey
  , formatSecretKey
  , parseSecretKey
  , formatSignature
  , mformatSignature
  , parseSignature

  -- * Signing
  , sign
  , checkSignature
  ) where

import Crypto.BLST qualified as BLST
import Crypto.Random (MonadRandom(getRandomBytes))
import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, convert)
import Data.ByteArray.Sized (SizedByteArray(..), sizedByteArray)
import Fmt (Buildable, build)

import Morley.Michelson.Text
import Morley.Tezos.Crypto.Util

----------------------------------------------------------------------------
-- Types, instances, conversions
----------------------------------------------------------------------------

type MinPk = 'BLST.G1

-- | Domain separation tag used by tezos
dst :: Maybe ByteString
-- see https://gitlab.com/nomadic-labs/cryptography/ocaml-bls12-381-signature/-/blob/1.0.0/src/bls12_381_signature.ml#L350
-- https://gitlab.com/tezos/tezos/-/blob/e9a9b61969b7a44749bed9bd9cdbcb4f2283220f/src/lib_crypto/bls.ml#L333
dst :: Maybe ByteString
dst = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_AUG_"

-- | BLS-MinPk public cryptographic key.
newtype PublicKey = PublicKey
  { PublicKey -> PublicKey MinPk
unPublicKey :: BLST.PublicKey MinPk
  } deriving stock (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, (forall x. PublicKey -> Rep PublicKey x)
-> (forall x. Rep PublicKey x -> PublicKey) -> Generic PublicKey
forall x. Rep PublicKey x -> PublicKey
forall x. PublicKey -> Rep PublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PublicKey -> Rep PublicKey x
from :: forall x. PublicKey -> Rep PublicKey x
$cto :: forall x. Rep PublicKey x -> PublicKey
to :: forall x. Rep PublicKey x -> PublicKey
Generic)
    deriving anyclass PublicKey -> ()
(PublicKey -> ()) -> NFData PublicKey
forall a. (a -> ()) -> NFData a
$crnf :: PublicKey -> ()
rnf :: PublicKey -> ()
NFData

instance Ord PublicKey where
  compare :: PublicKey -> PublicKey -> Ordering
compare = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> ByteString -> Ordering)
-> (PublicKey -> ByteString) -> PublicKey -> PublicKey -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes :: PublicKey -> ByteString)

-- | BLS-MinPk secret cryptographic key.
newtype SecretKey = SecretKey
  { SecretKey -> SecretKey
unSecretKey :: BLST.SecretKey
  } deriving stock (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> String
show :: SecretKey -> String
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, (forall x. SecretKey -> Rep SecretKey x)
-> (forall x. Rep SecretKey x -> SecretKey) -> Generic SecretKey
forall x. Rep SecretKey x -> SecretKey
forall x. SecretKey -> Rep SecretKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecretKey -> Rep SecretKey x
from :: forall x. SecretKey -> Rep SecretKey x
$cto :: forall x. Rep SecretKey x -> SecretKey
to :: forall x. Rep SecretKey x -> SecretKey
Generic)
    deriving anyclass SecretKey -> ()
(SecretKey -> ()) -> NFData SecretKey
forall a. (a -> ()) -> NFData a
$crnf :: SecretKey -> ()
rnf :: SecretKey -> ()
NFData

-- | Deterministicaly generate a secret key from seed.
detSecretKey :: ByteString -> SecretKey
detSecretKey :: ByteString -> SecretKey
detSecretKey ByteString
seed = SecretKey -> SecretKey
SecretKey (SecretKey -> SecretKey) -> SecretKey -> SecretKey
forall a b. (a -> b) -> a -> b
$ ByteString -> MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey
forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed do
  SizedByteArray 32 Bytes
bs <- SizedByteArray 32 Bytes
-> Maybe (SizedByteArray 32 Bytes) -> SizedByteArray 32 Bytes
forall a. a -> Maybe a -> a
fromMaybe (Text -> SizedByteArray 32 Bytes
forall a. HasCallStack => Text -> a
error Text
"impossible") (Maybe (SizedByteArray 32 Bytes) -> SizedByteArray 32 Bytes)
-> (Bytes -> Maybe (SizedByteArray 32 Bytes))
-> Bytes
-> SizedByteArray 32 Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray @32 @Bytes (Bytes -> SizedByteArray 32 Bytes)
-> MonadPseudoRandom ChaChaDRG Bytes
-> MonadPseudoRandom ChaChaDRG (SizedByteArray 32 Bytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MonadPseudoRandom ChaChaDRG Bytes
forall byteArray.
ByteArray byteArray =>
Int -> MonadPseudoRandom ChaChaDRG byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
  pure $ SizedByteArray 32 Bytes -> SecretKey
forall ba (n :: Natural).
(ByteArrayAccess ba, 32 <= n, KnownNat n) =>
SizedByteArray n ba -> SecretKey
BLST.keygen SizedByteArray 32 Bytes
bs

-- | Generate a random secret key.
randomSecretKey :: MonadRandom m => m SecretKey
randomSecretKey :: forall (m :: * -> *). MonadRandom m => m SecretKey
randomSecretKey = ByteString -> SecretKey
detSecretKey (ByteString -> SecretKey) -> m ByteString -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32

-- | Create a public key from a secret key.
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic = PublicKey MinPk -> PublicKey
PublicKey (PublicKey MinPk -> PublicKey)
-> (SecretKey -> PublicKey MinPk) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey MinPk
forall (c :: Curve). IsCurve c => SecretKey -> PublicKey c
BLST.skToPk (SecretKey -> PublicKey MinPk)
-> (SecretKey -> SecretKey) -> SecretKey -> PublicKey MinPk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> SecretKey
unSecretKey

-- | BLS-MinPk cryptographic signature.
newtype Signature = Signature
  { Signature -> Signature MinPk 'Hash
unSignature :: BLST.Signature MinPk 'BLST.Hash
  } deriving stock (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Signature -> Rep Signature x
from :: forall x. Signature -> Rep Signature x
$cto :: forall x. Rep Signature x -> Signature
to :: forall x. Rep Signature x -> Signature
Generic)
    deriving anyclass Signature -> ()
(Signature -> ()) -> NFData Signature
forall a. (a -> ()) -> NFData a
$crnf :: Signature -> ()
rnf :: Signature -> ()
NFData

----------------------------------------------------------------------------
-- Conversion to/from raw bytes (no checksums, tags or anything)
----------------------------------------------------------------------------

-- | Convert a 'PublicKey' to raw bytes.
publicKeyToBytes :: ByteArray ba => PublicKey -> ba
publicKeyToBytes :: forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes = Bytes -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes -> ba) -> (PublicKey -> Bytes) -> PublicKey -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray P1CompressSize Bytes -> Bytes
forall (n :: Natural) ba. SizedByteArray n ba -> ba
unSizedByteArray (SizedByteArray P1CompressSize Bytes -> Bytes)
-> (PublicKey -> SizedByteArray P1CompressSize Bytes)
-> PublicKey
-> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey MinPk -> SizedByteArray P1CompressSize Bytes
PublicKey MinPk
-> SizedByteArray (CompressedSize (CurveToPkPoint MinPk)) Bytes
forall (c :: Curve).
IsCurve c =>
PublicKey c
-> SizedByteArray (CompressedSize (CurveToPkPoint c)) Bytes
BLST.compressPk (PublicKey MinPk -> SizedByteArray P1CompressSize Bytes)
-> (PublicKey -> PublicKey MinPk)
-> PublicKey
-> SizedByteArray P1CompressSize Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey MinPk
unPublicKey

-- | Convert a 'PublicKey' to raw bytes.
secretKeyToBytes :: ByteArray ba => SecretKey -> ba
secretKeyToBytes :: forall ba. ByteArray ba => SecretKey -> ba
secretKeyToBytes = ScrubbedBytes -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ScrubbedBytes -> ba)
-> (SecretKey -> ScrubbedBytes) -> SecretKey -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray 32 ScrubbedBytes -> ScrubbedBytes
forall (n :: Natural) ba. SizedByteArray n ba -> ba
unSizedByteArray (SizedByteArray 32 ScrubbedBytes -> ScrubbedBytes)
-> (SecretKey -> SizedByteArray 32 ScrubbedBytes)
-> SecretKey
-> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> SizedByteArray 32 ScrubbedBytes
BLST.serializeSk (SecretKey -> SizedByteArray 32 ScrubbedBytes)
-> (SecretKey -> SecretKey)
-> SecretKey
-> SizedByteArray 32 ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> SecretKey
unSecretKey

toSized
  :: forall n a. (KnownNat n, ByteArrayAccess a)
  => LText -> a -> Either CryptoParseError (SizedByteArray n a)
toSized :: forall (n :: Natural) a.
(KnownNat n, ByteArrayAccess a) =>
LText -> a -> Either CryptoParseError (SizedByteArray n a)
toSized LText
what =
  CryptoParseError
-> Maybe (SizedByteArray n a)
-> Either CryptoParseError (SizedByteArray n a)
forall l r. l -> Maybe r -> Either l r
maybeToRight (LText -> Int -> CryptoParseError
CryptoParseUnexpectedLength LText
what (Int -> CryptoParseError) -> Int -> CryptoParseError
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralOverflowing (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Natural
natVal @n Proxy n
forall {k} (t :: k). Proxy t
Proxy)
  (Maybe (SizedByteArray n a)
 -> Either CryptoParseError (SizedByteArray n a))
-> (a -> Maybe (SizedByteArray n a))
-> a
-> Either CryptoParseError (SizedByteArray n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (SizedByteArray n a)
forall (n :: Natural) ba.
(KnownNat n, ByteArrayAccess ba) =>
ba -> Maybe (SizedByteArray n ba)
sizedByteArray

-- | Make a 'PublicKey' from raw bytes.
mkPublicKey :: ByteArrayAccess ba => ba -> Either CryptoParseError PublicKey
mkPublicKey :: forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
mkPublicKey = LText
-> ba -> Either CryptoParseError (SizedByteArray P1CompressSize ba)
forall (n :: Natural) a.
(KnownNat n, ByteArrayAccess a) =>
LText -> a -> Either CryptoParseError (SizedByteArray n a)
toSized LText
"public key" (ba -> Either CryptoParseError (SizedByteArray P1CompressSize ba))
-> (SizedByteArray P1CompressSize ba
    -> Either CryptoParseError PublicKey)
-> ba
-> Either CryptoParseError PublicKey
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (BlstError -> CryptoParseError)
-> (PublicKey MinPk -> PublicKey)
-> Either BlstError (PublicKey MinPk)
-> Either CryptoParseError PublicKey
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BlstError -> CryptoParseError
CryptoParseBLSTError PublicKey MinPk -> PublicKey
PublicKey (Either BlstError (PublicKey MinPk)
 -> Either CryptoParseError PublicKey)
-> (SizedByteArray P1CompressSize ba
    -> Either BlstError (PublicKey MinPk))
-> SizedByteArray P1CompressSize ba
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray P1CompressSize ba
-> Either BlstError (PublicKey MinPk)
SizedByteArray (CompressedSize (CurveToPkPoint MinPk)) ba
-> Either BlstError (PublicKey MinPk)
forall (c :: Curve) ba.
(IsCurve c, ByteArrayAccess ba) =>
SizedByteArray (CompressedSize (CurveToPkPoint c)) ba
-> Either BlstError (PublicKey c)
BLST.decompressPk

publicKeyLengthBytes :: (Integral n, CheckIntSubType Int n) => n
publicKeyLengthBytes :: forall n. (Integral n, CheckIntSubType Int n) => n
publicKeyLengthBytes = Int -> n
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ forall (soc :: SerializeOrCompress) a.
KnownNat (ByteSize soc a) =>
Int
BLST.byteSize @'BLST.Compress @(BLST.PublicKey MinPk)

-- | Convert a 'Signature' to raw bytes.
signatureToBytes :: ByteArray ba => Signature -> ba
signatureToBytes :: forall ba. ByteArray ba => Signature -> ba
signatureToBytes = Bytes -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes -> ba) -> (Signature -> Bytes) -> Signature -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray P2CompressSize Bytes -> Bytes
forall (n :: Natural) ba. SizedByteArray n ba -> ba
unSizedByteArray (SizedByteArray P2CompressSize Bytes -> Bytes)
-> (Signature -> SizedByteArray P2CompressSize Bytes)
-> Signature
-> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature MinPk 'Hash -> SizedByteArray P2CompressSize Bytes
Signature MinPk 'Hash
-> SizedByteArray (CompressedSize (CurveToMsgPoint MinPk)) Bytes
forall (c :: Curve) (m :: EncodeMethod).
IsCurve c =>
Signature c m
-> SizedByteArray (CompressedSize (CurveToMsgPoint c)) Bytes
BLST.compressSignature (Signature MinPk 'Hash -> SizedByteArray P2CompressSize Bytes)
-> (Signature -> Signature MinPk 'Hash)
-> Signature
-> SizedByteArray P2CompressSize Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature MinPk 'Hash
unSignature

-- | Make a 'Signature' from raw bytes.
mkSignature :: ByteArrayAccess ba => ba -> Either CryptoParseError Signature
mkSignature :: forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError Signature
mkSignature = LText
-> ba -> Either CryptoParseError (SizedByteArray P2CompressSize ba)
forall (n :: Natural) a.
(KnownNat n, ByteArrayAccess a) =>
LText -> a -> Either CryptoParseError (SizedByteArray n a)
toSized LText
"signature" (ba -> Either CryptoParseError (SizedByteArray P2CompressSize ba))
-> (SizedByteArray P2CompressSize ba
    -> Either CryptoParseError Signature)
-> ba
-> Either CryptoParseError Signature
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  (BlstError -> CryptoParseError)
-> (Signature MinPk 'Hash -> Signature)
-> Either BlstError (Signature MinPk 'Hash)
-> Either CryptoParseError Signature
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BlstError -> CryptoParseError
CryptoParseBLSTError Signature MinPk 'Hash -> Signature
Signature (Either BlstError (Signature MinPk 'Hash)
 -> Either CryptoParseError Signature)
-> (SizedByteArray P2CompressSize ba
    -> Either BlstError (Signature MinPk 'Hash))
-> SizedByteArray P2CompressSize ba
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray P2CompressSize ba
-> Either BlstError (Signature MinPk 'Hash)
SizedByteArray (CompressedSize (CurveToMsgPoint MinPk)) ba
-> Either BlstError (Signature MinPk 'Hash)
forall (c :: Curve) (m :: EncodeMethod) ba.
(IsCurve c, ByteArrayAccess ba) =>
SizedByteArray (CompressedSize (CurveToMsgPoint c)) ba
-> Either BlstError (Signature c m)
BLST.decompressSignature

signatureLengthBytes :: (Integral n, CheckIntSubType Int n) => n
signatureLengthBytes :: forall n. (Integral n, CheckIntSubType Int n) => n
signatureLengthBytes = Int -> n
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ forall (soc :: SerializeOrCompress) a.
KnownNat (ByteSize soc a) =>
Int
BLST.byteSize @'BLST.Compress @(BLST.Signature MinPk 'BLST.Hash)

mkSecretKey :: ByteArrayAccess ba => ba -> Either CryptoParseError SecretKey
mkSecretKey :: forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError SecretKey
mkSecretKey = LText -> ba -> Either CryptoParseError (SizedByteArray 32 ba)
forall (n :: Natural) a.
(KnownNat n, ByteArrayAccess a) =>
LText -> a -> Either CryptoParseError (SizedByteArray n a)
toSized LText
"secret key" (ba -> Either CryptoParseError (SizedByteArray 32 ba))
-> (SizedByteArray 32 ba -> Either CryptoParseError SecretKey)
-> ba
-> Either CryptoParseError SecretKey
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  (BlstError -> CryptoParseError)
-> (SecretKey -> SecretKey)
-> Either BlstError SecretKey
-> Either CryptoParseError SecretKey
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BlstError -> CryptoParseError
CryptoParseBLSTError SecretKey -> SecretKey
SecretKey (Either BlstError SecretKey -> Either CryptoParseError SecretKey)
-> (SizedByteArray 32 ba -> Either BlstError SecretKey)
-> SizedByteArray 32 ba
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Either BlstError SecretKey
forall a. a -> Either BlstError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecretKey -> Either BlstError SecretKey)
-> (SizedByteArray 32 ba -> SecretKey)
-> SizedByteArray 32 ba
-> Either BlstError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteArray 32 ba -> SecretKey
forall ba. ByteArrayAccess ba => SizedByteArray 32 ba -> SecretKey
BLST.deserializeSk

----------------------------------------------------------------------------
-- Magic bytes
----------------------------------------------------------------------------

-- https://gitlab.com/tezos/tezos/-/blob/4b0dd9e9715ce82ac6429571d8843ab681522daf/src/lib_crypto/base58.ml#L428

publicKeyTag :: ByteString
publicKeyTag :: ByteString
publicKeyTag = ByteString
"\006\149\135\204" -- BLpk(76)

secretKeyTag :: ByteString
secretKeyTag :: ByteString
secretKeyTag = ByteString
"\003\150\192\040" -- BLsk(54)

signatureTag :: ByteString
signatureTag :: ByteString
signatureTag = ByteString
"\040\171\064\207" -- BLsig(142)

----------------------------------------------------------------------------
-- Formatting
----------------------------------------------------------------------------

formatPublicKey :: PublicKey -> Text
formatPublicKey :: PublicKey -> Text
formatPublicKey = ByteString -> Bytes -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
publicKeyTag (Bytes -> Text) -> (PublicKey -> Bytes) -> PublicKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes @Bytes

mformatPublicKey :: PublicKey -> MText
mformatPublicKey :: PublicKey -> MText
mformatPublicKey = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (PublicKey -> Either Text MText) -> PublicKey -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (PublicKey -> Text) -> PublicKey -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

instance Buildable PublicKey where
  build :: PublicKey -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (PublicKey -> Text) -> PublicKey -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey = ByteString
-> (ByteString -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
publicKeyTag ByteString -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
mkPublicKey

formatSecretKey :: SecretKey -> Text
formatSecretKey :: SecretKey -> Text
formatSecretKey = ByteString -> Bytes -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
secretKeyTag (Bytes -> Text) -> (SecretKey -> Bytes) -> SecretKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArray ba => SecretKey -> ba
secretKeyToBytes @Bytes

instance Buildable SecretKey where
  build :: SecretKey -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (SecretKey -> Text) -> SecretKey -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Text
formatSecretKey

parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey = ByteString
-> (ByteString -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
secretKeyTag ByteString -> Either CryptoParseError SecretKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError SecretKey
mkSecretKey

formatSignature :: Signature -> Text
formatSignature :: Signature -> Text
formatSignature = ByteString -> Bytes -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
signatureTag (Bytes -> Text) -> (Signature -> Bytes) -> Signature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArray ba => Signature -> ba
signatureToBytes @Bytes

mformatSignature :: Signature -> MText
mformatSignature :: Signature -> MText
mformatSignature = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Signature -> Either Text MText) -> Signature -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (Signature -> Text) -> Signature -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

instance Buildable Signature where
  build :: Signature -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (Signature -> Text) -> Signature -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

parseSignature :: Text -> Either CryptoParseError Signature
parseSignature :: Text -> Either CryptoParseError Signature
parseSignature = ByteString
-> (ByteString -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
signatureTag ByteString -> Either CryptoParseError Signature
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError Signature
mkSignature

----------------------------------------------------------------------------
-- Signing
----------------------------------------------------------------------------

-- | Sign a message using the secret key.
sign :: SecretKey -> ByteString -> Signature
sign :: SecretKey -> ByteString -> Signature
sign SecretKey
sk ByteString
msg = Signature MinPk 'Hash -> Signature
Signature (Signature MinPk 'Hash -> Signature)
-> Signature MinPk 'Hash -> Signature
forall a b. (a -> b) -> a -> b
$ SecretKey
-> ByteString -> Maybe ByteString -> Signature MinPk 'Hash
forall (c :: Curve) (m :: EncodeMethod) ba ba2.
(ToCurve m c, ByteArrayAccess ba, ByteArrayAccess ba2) =>
SecretKey -> ba -> Maybe ba2 -> Signature c m
BLST.sign (SecretKey -> SecretKey
unSecretKey SecretKey
sk)
  (PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes (SecretKey -> PublicKey
toPublic SecretKey
sk) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg) Maybe ByteString
dst
-- upstream does this concatenation with compressed public key
-- https://gitlab.com/nomadic-labs/cryptography/ocaml-bls12-381-signature/-/blob/531ed1f509a974f5067f431b6797b9246518520c/src/bls12_381_signature.ml#L662

-- | Check that a sequence of bytes has been signed with a given key.
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature pkg :: PublicKey
pkg@(PublicKey PublicKey MinPk
pk) (Signature Signature MinPk 'Hash
sig) ByteString
bytes =
  BlstError
BLST.BlstSuccess BlstError -> BlstError -> Bool
forall a. Eq a => a -> a -> Bool
== Signature MinPk 'Hash
-> PublicKey MinPk -> ByteString -> Maybe ByteString -> BlstError
forall (c :: Curve) (m :: EncodeMethod) ba ba2.
(IsCurve c, Demote m, ByteArrayAccess ba, ByteArrayAccess ba2) =>
Signature c m -> PublicKey c -> ba -> Maybe ba2 -> BlstError
BLST.verify Signature MinPk 'Hash
sig PublicKey MinPk
pk (PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes PublicKey
pkg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bytes) Maybe ByteString
dst