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

-- | Secp256k1 cryptographic primitives.

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

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

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

  -- * Signing
  , sign
  , checkSignature
  ) where

import Crypto.Hash (Blake2b_256(..))
import Crypto.PubKey.ECC.ECDSA qualified as ECDSA
import Crypto.PubKey.ECC.Generate qualified as ECC.Generate
import Crypto.PubKey.ECC.Types (Curve(..), CurveName(..), getCurveByName)
import Crypto.PubKey.ECC.Types qualified as ECDSA
import Crypto.Random (MonadRandom)
import Data.ByteArray (ByteArray, ByteArrayAccess)
import Fmt (Buildable, build)

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

curve :: Curve
curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1

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

-- | Secp256k1 public cryptographic key.
newtype PublicKey = PublicKey
  { PublicKey -> PublicKey
unPublicKey :: ECDSA.PublicKey
  } deriving stock (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, 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, (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)

instance NFData PublicKey where
  rnf :: PublicKey -> ()
rnf (PublicKey (ECDSA.PublicKey Curve
cu PublicPoint
q))
    = Curve -> ()
rnfCurve Curve
cu () -> () -> ()
forall a b. a -> b -> b
`seq` PublicPoint -> ()
forall a. NFData a => a -> ()
rnf PublicPoint
q

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)

-- | Secp256k1 secret cryptographic key.
newtype SecretKey = SecretKey
  { SecretKey -> KeyPair
unSecretKey :: ECDSA.KeyPair
  } 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)

instance NFData SecretKey where
  rnf :: SecretKey -> ()
rnf (SecretKey (ECDSA.KeyPair Curve
cu PublicPoint
pp PrivateNumber
pn)) =
    Curve -> ()
rnfCurve Curve
cu () -> () -> ()
forall a b. a -> b -> b
`seq` (PublicPoint, PrivateNumber) -> ()
forall a. NFData a => a -> ()
rnf (PublicPoint
pp, PrivateNumber
pn)

-- | Deterministicaly generate a secret key from seed.
detSecretKey :: ByteString -> SecretKey
detSecretKey :: ByteString -> SecretKey
detSecretKey ByteString
seed = ByteString -> MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey
forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed (MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey)
-> MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey
forall a b. (a -> b) -> a -> b
$ MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
detSecretKeyDo

detSecretKeyDo :: MonadRandom m => m SecretKey
detSecretKeyDo :: forall (m :: * -> *). MonadRandom m => m SecretKey
detSecretKeyDo = KeyPair -> SecretKey
SecretKey (KeyPair -> SecretKey) -> m KeyPair -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  (PublicKey
publicKey, PrivateKey
privateKey) <- Curve -> m (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Curve -> m (PublicKey, PrivateKey)
ECC.Generate.generate Curve
curve
  KeyPair -> m KeyPair
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> m KeyPair) -> KeyPair -> m KeyPair
forall a b. (a -> b) -> a -> b
$
    Curve -> PublicPoint -> PrivateNumber -> KeyPair
ECDSA.KeyPair Curve
curve (PublicKey -> PublicPoint
ECDSA.public_q PublicKey
publicKey) (PrivateKey -> PrivateNumber
ECDSA.private_d PrivateKey
privateKey)

-- | Create a public key from a secret key.
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic =
  PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Curve -> PublicPoint -> PublicKey
ECDSA.PublicKey Curve
curve (PublicPoint -> PublicKey)
-> (SecretKey -> PublicPoint) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ECDSA.KeyPair Curve
_ PublicPoint
pp PrivateNumber
_) -> PublicPoint
pp) (KeyPair -> PublicPoint)
-> (SecretKey -> KeyPair) -> SecretKey -> PublicPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> KeyPair
unSecretKey

-- | Secp256k1 cryptographic signature.
newtype Signature = Signature
  { Signature -> Signature
unSignature :: ECDSA.Signature
  } 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)

instance NFData Signature where
  rnf :: Signature -> ()
rnf (Signature (ECDSA.Signature PrivateNumber
a PrivateNumber
b)) = PrivateNumber -> ()
forall a. NFData a => a -> ()
rnf PrivateNumber
a () -> () -> ()
forall a b. a -> b -> b
`seq` PrivateNumber -> ()
forall a. NFData a => a -> ()
rnf PrivateNumber
b

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

-- | Convert a 'PublicKey' to raw bytes.
publicKeyToBytes :: forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes :: forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes (PublicKey PublicKey
p) =
  Curve -> PublicKey -> ba
forall ba. (ByteArray ba, HasCallStack) => Curve -> PublicKey -> ba
publicKeyToBytes_ Curve
curve PublicKey
p

-- | Make a 'PublicKey' from raw bytes.
mkPublicKey :: ByteArrayAccess ba => ba -> Either CryptoParseError PublicKey
mkPublicKey :: forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
mkPublicKey ba
ba = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Curve -> ba -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
Curve -> ba -> Either CryptoParseError PublicKey
mkPublicKey_ Curve
curve ba
ba

publicKeyLengthBytes :: (Integral n, CheckIntSubType Int n) => n
publicKeyLengthBytes :: forall n. (Integral n, CheckIntSubType Int n) => n
publicKeyLengthBytes = Curve -> n
forall n. (Integral n, CheckIntSubType Int n) => Curve -> n
publicKeyLengthBytes_ Curve
curve

-- | Convert a 'PublicKey' to raw bytes.
signatureToBytes :: ByteArray ba => Signature -> ba
signatureToBytes :: forall ba. ByteArray ba => Signature -> ba
signatureToBytes (Signature Signature
sig) =
  Curve -> Signature -> ba
forall ba. ByteArray ba => Curve -> Signature -> ba
signatureToBytes_ Curve
curve Signature
sig

-- | Make a 'Signature' from raw bytes.
mkSignature :: ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature :: forall ba. ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature ba
ba = Signature -> Signature
Signature (Signature -> Signature)
-> Either CryptoParseError Signature
-> Either CryptoParseError Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Curve -> ba -> Either CryptoParseError Signature
forall ba.
ByteArray ba =>
Curve -> ba -> Either CryptoParseError Signature
mkSignature_ Curve
curve ba
ba

signatureLengthBytes :: (Integral n, CheckIntSubType Int n) => n
signatureLengthBytes :: forall n. (Integral n, CheckIntSubType Int n) => n
signatureLengthBytes = Curve -> n
forall n. (Integral n, CheckIntSubType Int n) => Curve -> n
signatureLengthBytes_ Curve
curve

mkSecretKey :: ByteArray ba => ba -> Either CryptoParseError SecretKey
mkSecretKey :: forall ba. ByteArray ba => ba -> Either CryptoParseError SecretKey
mkSecretKey = SecretKey -> Either CryptoParseError SecretKey
forall a b. b -> Either a b
Right (SecretKey -> Either CryptoParseError SecretKey)
-> (ba -> SecretKey) -> ba -> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> SecretKey
SecretKey (KeyPair -> SecretKey) -> (ba -> KeyPair) -> ba -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curve -> ba -> KeyPair
forall ba. ByteArray ba => Curve -> ba -> KeyPair
mkSecretKey_ Curve
curve

-- | Convert a 'PublicKey' to raw bytes.
secretKeyToBytes :: ByteArray ba => SecretKey -> ba
secretKeyToBytes :: forall ba. ByteArray ba => SecretKey -> ba
secretKeyToBytes (SecretKey KeyPair
kp) =
  KeyPair -> ba
forall ba. ByteArray ba => KeyPair -> ba
secretKeyToBytes_ KeyPair
kp

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

publicKeyTag :: ByteString
publicKeyTag :: ByteString
publicKeyTag = ByteString
"\003\254\226\086"

-- | Base16 format is @11a2e0c9@
secretKeyTag :: ByteString
secretKeyTag :: ByteString
secretKeyTag = ByteString
"\017\162\224\201"

signatureTag :: ByteString
signatureTag :: ByteString
signatureTag = ByteString
"\013\115\101\019\063"

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

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

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

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

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. ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature

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

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. ByteArray ba => ba -> Either CryptoParseError SecretKey
mkSecretKey

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

-- | Sign a message using the secret key.
sign :: MonadRandom m => SecretKey -> ByteString -> m Signature
sign :: forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign (SecretKey KeyPair
keyPair) ByteString
msg = (Signature -> Signature) -> m Signature -> m Signature
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
Signature (m Signature -> m Signature) -> m Signature -> m Signature
forall a b. (a -> b) -> a -> b
$ do
  let pk :: PrivateKey
pk = KeyPair -> PrivateKey
ECDSA.toPrivateKey KeyPair
keyPair
  ECDSA.Signature PrivateNumber
r PrivateNumber
s' <- PrivateKey -> Blake2b_256 -> ByteString -> m Signature
forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
ECDSA.sign PrivateKey
pk Blake2b_256
Blake2b_256 ByteString
msg
  let n :: PrivateNumber
n = CurveCommon -> PrivateNumber
ECDSA.ecc_n (CurveCommon -> PrivateNumber)
-> (Curve -> CurveCommon) -> Curve -> PrivateNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curve -> CurveCommon
ECDSA.common_curve (Curve -> PrivateNumber) -> Curve -> PrivateNumber
forall a b. (a -> b) -> a -> b
$ PrivateKey -> Curve
ECDSA.private_curve PrivateKey
pk
      -- Tezos uses bitcoin-core implementation of secp256k1, or, more
      -- accurately, nomadic-labs OCaml bindings to bitcoin-core implementation,
      -- see [tezos dependencies] and [C implementation]. It does this thing for
      -- some reason. The signature is valid either way, but the network will
      -- refuse to accept @s > n/2@. note that @s' < n@ due to modular
      -- arithmetic.
      --
      -- [tezos dependencies]: https://gitlab.com/tezos/tezos/-/blob/e9a9b61969b7a44749bed9bd9cdbcb4f2283220f/src/lib_crypto/dune#L16
      -- [C implementation]: https://gitlab.com/nomadic-labs/ocaml-secp256k1-internal/-/blob/1b51aefb3ae579a24529b18cf9da6991b4ff17c2/src/ecdsa_impl.h#L305
      --
      -- Original code for C implementation:
      -- https://github.com/bitcoin/bitcoin/blob/c06cda3e48e9826043ebc5790a7bb505bfbf368c/src/secp256k1/src/ecdsa_impl.h#L305
      s :: PrivateNumber
s | PrivateNumber
s' PrivateNumber -> PrivateNumber -> Bool
forall a. Ord a => a -> a -> Bool
> PrivateNumber
n PrivateNumber -> PrivateNumber -> PrivateNumber
forall a. Integral a => a -> a -> a
`div` PrivateNumber
2 = PrivateNumber
n PrivateNumber -> PrivateNumber -> PrivateNumber
forall a. Num a => a -> a -> a
- PrivateNumber
s'
        | Bool
otherwise = PrivateNumber
s'
  Signature -> m Signature
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> m Signature) -> Signature -> m Signature
forall a b. (a -> b) -> a -> b
$ PrivateNumber -> PrivateNumber -> Signature
ECDSA.Signature PrivateNumber
r PrivateNumber
s


-- | Check that a sequence of bytes has been signed with a given key.
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature (PublicKey PublicKey
pk) (Signature Signature
sig) =
  Blake2b_256 -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify Blake2b_256
Blake2b_256 PublicKey
pk Signature
sig