{-# LANGUAGE KindSignatures    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module Crypto (
  verifyEd25519Signature,
  verifyEcdsaSecp256k1Signature,
  verifySchnorrSecp256k1Signature,
  ) where

import Cardano.Crypto.DSIGN.Class qualified as DSIGN
import Cardano.Crypto.DSIGN.EcdsaSecp256k1 (EcdsaSecp256k1DSIGN, toMessageHash)
import Cardano.Crypto.DSIGN.SchnorrSecp256k1 (SchnorrSecp256k1DSIGN)
import Control.Applicative (Alternative (empty))
import Crypto.ECC.Ed25519Donna (publicKey, signature, verify)
import Crypto.Error (maybeCryptoError)
import Data.ByteString qualified as BS
import Data.Kind (Type)
import Data.Text (Text)
import PlutusCore.Builtin.Emitter (Emitter, emit)
import PlutusCore.Evaluation.Result (EvaluationResult (EvaluationFailure))

-- | Ed25519 signature verification
-- This will fail if the key or the signature are not of the expected length.
verifyEd25519Signature
    :: Alternative f
    => BS.ByteString  -- ^ Public Key (32 bytes)
    -> BS.ByteString  -- ^ Message    (arbitrary length)
    -> BS.ByteString  -- ^ Signature  (64 bytes)
    -> f Bool
verifyEd25519Signature :: ByteString -> ByteString -> ByteString -> f Bool
verifyEd25519Signature ByteString
pubKey ByteString
msg ByteString
sig =
    f Bool -> (Bool -> f Bool) -> Maybe Bool -> f Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f Bool
forall (f :: * -> *) a. Alternative f => f a
empty Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> f Bool)
-> (CryptoFailable Bool -> Maybe Bool)
-> CryptoFailable Bool
-> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable Bool -> Maybe Bool
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable Bool -> f Bool) -> CryptoFailable Bool -> f Bool
forall a b. (a -> b) -> a -> b
$
        PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
verify
            (PublicKey -> ByteString -> Signature -> Bool)
-> CryptoFailable PublicKey
-> CryptoFailable (ByteString -> Signature -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
publicKey ByteString
pubKey
            CryptoFailable (ByteString -> Signature -> Bool)
-> CryptoFailable ByteString -> CryptoFailable (Signature -> Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> CryptoFailable ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
msg
            CryptoFailable (Signature -> Bool)
-> CryptoFailable Signature -> CryptoFailable Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
signature ByteString
sig

-- | Verify an ECDSA signature made using the SECP256k1 curve.
--
-- = Note
--
-- This takes a message /hash/, rather than a general blob of bytes; thus, it is
-- limited in length.
verifyEcdsaSecp256k1Signature
  :: BS.ByteString -- ^ Public key   (64 bytes)
  -> BS.ByteString -- ^ Message hash (32 bytes)
  -> BS.ByteString -- ^ Signature    (64 bytes)
  -> Emitter (EvaluationResult Bool)
verifyEcdsaSecp256k1Signature :: ByteString
-> ByteString -> ByteString -> Emitter (EvaluationResult Bool)
verifyEcdsaSecp256k1Signature ByteString
pk ByteString
msg ByteString
sig =
  case ByteString -> Maybe (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
DSIGN.rawDeserialiseVerKeyDSIGN @EcdsaSecp256k1DSIGN ByteString
pk of
    Maybe (VerKeyDSIGN EcdsaSecp256k1DSIGN)
Nothing -> Text -> Text -> Emitter (EvaluationResult Bool)
forall a. Text -> Text -> Emitter (EvaluationResult a)
failWithMessage Text
loc Text
"Invalid verification key."
    Just VerKeyDSIGN EcdsaSecp256k1DSIGN
pk' -> case ByteString -> Maybe (SigDSIGN EcdsaSecp256k1DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
DSIGN.rawDeserialiseSigDSIGN @EcdsaSecp256k1DSIGN ByteString
sig of
      Maybe (SigDSIGN EcdsaSecp256k1DSIGN)
Nothing -> Text -> Text -> Emitter (EvaluationResult Bool)
forall a. Text -> Text -> Emitter (EvaluationResult a)
failWithMessage Text
loc Text
"Invalid signature."
      Just SigDSIGN EcdsaSecp256k1DSIGN
sig' -> case ByteString -> Maybe MessageHash
toMessageHash ByteString
msg of
        Maybe MessageHash
Nothing -> Text -> Text -> Emitter (EvaluationResult Bool)
forall a. Text -> Text -> Emitter (EvaluationResult a)
failWithMessage Text
loc Text
"Invalid message hash."
        Just MessageHash
msg' -> EvaluationResult Bool -> Emitter (EvaluationResult Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationResult Bool -> Emitter (EvaluationResult Bool))
-> (Bool -> EvaluationResult Bool)
-> Bool
-> Emitter (EvaluationResult Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> EvaluationResult Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Emitter (EvaluationResult Bool))
-> Bool -> Emitter (EvaluationResult Bool)
forall a b. (a -> b) -> a -> b
$ case ContextDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
-> MessageHash
-> SigDSIGN EcdsaSecp256k1DSIGN
-> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
DSIGN.verifyDSIGN () VerKeyDSIGN EcdsaSecp256k1DSIGN
pk' MessageHash
msg' SigDSIGN EcdsaSecp256k1DSIGN
sig' of
          Left String
_   -> Bool
False
          Right () -> Bool
True
  where
    loc :: Text
    loc :: Text
loc = Text
"ECDSA SECP256k1 signature verification"

-- | Verify a Schnorr signature made using the SECP256k1 curve.
--
-- = Note
--
-- Unlike 'verifyEcdsaSecp256k1Signature', this can accept messages of arbitrary
-- form and length.
verifySchnorrSecp256k1Signature
  :: BS.ByteString -- ^ Public key (64 bytes)
  -> BS.ByteString -- ^ Message    (arbitrary length)
  -> BS.ByteString -- ^ Signature  (64 bytes)
  -> Emitter (EvaluationResult Bool)
verifySchnorrSecp256k1Signature :: ByteString
-> ByteString -> ByteString -> Emitter (EvaluationResult Bool)
verifySchnorrSecp256k1Signature ByteString
pk ByteString
msg ByteString
sig =
  case ByteString -> Maybe (VerKeyDSIGN SchnorrSecp256k1DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
DSIGN.rawDeserialiseVerKeyDSIGN @SchnorrSecp256k1DSIGN ByteString
pk of
    Maybe (VerKeyDSIGN SchnorrSecp256k1DSIGN)
Nothing -> Text -> Text -> Emitter (EvaluationResult Bool)
forall a. Text -> Text -> Emitter (EvaluationResult a)
failWithMessage Text
loc Text
"Invalid verification key."
    Just VerKeyDSIGN SchnorrSecp256k1DSIGN
pk' -> case ByteString -> Maybe (SigDSIGN SchnorrSecp256k1DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
DSIGN.rawDeserialiseSigDSIGN @SchnorrSecp256k1DSIGN ByteString
sig of
      Maybe (SigDSIGN SchnorrSecp256k1DSIGN)
Nothing -> Text -> Text -> Emitter (EvaluationResult Bool)
forall a. Text -> Text -> Emitter (EvaluationResult a)
failWithMessage Text
loc Text
"Invalid signature."
      Just SigDSIGN SchnorrSecp256k1DSIGN
sig' -> EvaluationResult Bool -> Emitter (EvaluationResult Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationResult Bool -> Emitter (EvaluationResult Bool))
-> (Bool -> EvaluationResult Bool)
-> Bool
-> Emitter (EvaluationResult Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> EvaluationResult Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Emitter (EvaluationResult Bool))
-> Bool -> Emitter (EvaluationResult Bool)
forall a b. (a -> b) -> a -> b
$ case ContextDSIGN SchnorrSecp256k1DSIGN
-> VerKeyDSIGN SchnorrSecp256k1DSIGN
-> ByteString
-> SigDSIGN SchnorrSecp256k1DSIGN
-> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
DSIGN.verifyDSIGN () VerKeyDSIGN SchnorrSecp256k1DSIGN
pk' ByteString
msg SigDSIGN SchnorrSecp256k1DSIGN
sig' of
        Left String
_   -> Bool
False
        Right () -> Bool
True
  where
    loc :: Text
    loc :: Text
loc = Text
"Schnorr SECP256k1 signature verification"

-- Helpers

-- TODO: Something like 'failWithMessage x y *> foo' should really fail with
-- 'EvaluationFailure' without evaluating 'foo', but currently it will. This
-- requires a fix to how Emitter and EvaluationResult work, and since we don't
-- expect 'failWithMessage' to be used this way, we note this for future
-- reference only for when such fixes are made.
failWithMessage :: forall (a :: Type) .
  Text -> Text -> Emitter (EvaluationResult a)
failWithMessage :: Text -> Text -> Emitter (EvaluationResult a)
failWithMessage Text
location Text
reason = do
  Text -> Emitter ()
emit (Text -> Emitter ()) -> Text -> Emitter ()
forall a b. (a -> b) -> a -> b
$ Text
location Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
  EvaluationResult a -> Emitter (EvaluationResult a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvaluationResult a
forall a. EvaluationResult a
EvaluationFailure