{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Test.Crypto.Vector.Secp256k1DSIGN (
  tests,
)
where

import Cardano.Binary (DecoderError (DecoderErrorDeserialiseFailure), FromCBOR, decodeFull')
import Cardano.Crypto.DSIGN (
  DSIGNAlgorithm (
    ContextDSIGN,
    SigDSIGN,
    SignKeyDSIGN,
    Signable,
    VerKeyDSIGN,
    deriveVerKeyDSIGN,
    signDSIGN,
    verifyDSIGN
  ),
  EcdsaSecp256k1DSIGN,
  MessageHash,
  SchnorrSecp256k1DSIGN,
  hashAndPack,
  toMessageHash,
 )
import Cardano.Crypto.Hash.SHA3_256 (SHA3_256)
import Codec.CBOR.Read (DeserialiseFailure (..))
import Control.Monad (forM_)
import Data.ByteString (ByteString)
import Data.Either (isLeft, isRight)
import Data.Maybe (isNothing)
import Data.Proxy (Proxy (..))
import Test.Crypto.Vector.SerializationUtils as Utils (
  HexStringInCBOR (..),
  dropBytes,
  hexByteStringLength,
 )
import Test.Crypto.Vector.StringConstants (
  cannotDecodeVerificationKeyError,
  invalidEcdsaSigLengthError,
  invalidEcdsaVerKeyLengthError,
  invalidSchnorrSigLengthError,
  invalidSchnorrVerKeyLengthError,
  unexpectedDecodingError,
 )
import Test.Crypto.Vector.Vectors (
  defaultMessage,
  defaultSKey,
  ecdsaMismatchMessageAndSignature,
  ecdsaNegSigTestVectors,
  ecdsaVerKeyAndSigVerifyTestVectors,
  ecdsaWrongLengthSigTestVectorsRaw,
  schnorrMismatchMessageAndSignature,
  schnorrVerKeyAndSigVerifyTestVectors,
  schnorrWrongLengthSigTestVectorsRaw,
  signAndVerifyTestVectors,
  verKeyNotOnCurveTestVectorRaw,
  wrongEcdsaVerKeyTestVector,
  wrongLengthMessageHashTestVectors,
  wrongLengthVerKeyTestVectorsRaw,
  wrongSchnorrVerKeyTestVector,
 )
import Test.HUnit (assertBool, assertEqual)
import Test.Hspec (Spec, describe, it)

ecdsaProxy :: Proxy EcdsaSecp256k1DSIGN
ecdsaProxy :: Proxy EcdsaSecp256k1DSIGN
ecdsaProxy = Proxy EcdsaSecp256k1DSIGN
forall {k} (t :: k). Proxy t
Proxy

schnorrProxy :: Proxy SchnorrSecp256k1DSIGN
schnorrProxy :: Proxy SchnorrSecp256k1DSIGN
schnorrProxy = Proxy SchnorrSecp256k1DSIGN
forall {k} (t :: k). Proxy t
Proxy

tests :: Spec
tests :: Spec
tests =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Secp256k1 Test Vectors" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    -- Note : Proxies are here repetead due to specific test vectors need to be used with specific proxy
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"EcdsaSecp256k1" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      Proxy EcdsaSecp256k1DSIGN -> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
Proxy v -> Spec
signAndVerifyTest Proxy EcdsaSecp256k1DSIGN
ecdsaProxy
      (VerKeyDSIGN EcdsaSecp256k1DSIGN, ByteString,
 SigDSIGN EcdsaSecp256k1DSIGN)
-> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> Spec
verifyOnlyTest (VerKeyDSIGN EcdsaSecp256k1DSIGN, ByteString,
 SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaVerKeyAndSigVerifyTestVectors
      Spec
wrongMessageHashLengthTest
      VerKeyDSIGN EcdsaSecp256k1DSIGN -> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
VerKeyDSIGN v -> Spec
mismatchSignKeyVerKeyTest VerKeyDSIGN EcdsaSecp256k1DSIGN
wrongEcdsaVerKeyTestVector
      [(ByteString, VerKeyDSIGN EcdsaSecp256k1DSIGN,
  SigDSIGN EcdsaSecp256k1DSIGN)]
-> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
[(ByteString, VerKeyDSIGN v, SigDSIGN v)] -> Spec
mismatchMessageSignatureTest [(ByteString, VerKeyDSIGN EcdsaSecp256k1DSIGN,
  SigDSIGN EcdsaSecp256k1DSIGN)]
ecdsaMismatchMessageAndSignature
      Proxy EcdsaSecp256k1DSIGN -> HexStringInCBOR -> Spec
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> Spec
verKeyNotOnCurveParserTest Proxy EcdsaSecp256k1DSIGN
ecdsaProxy HexStringInCBOR
verKeyNotOnCurveTestVectorRaw
      Proxy EcdsaSecp256k1DSIGN
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
invalidLengthVerKeyParserTest
        Proxy EcdsaSecp256k1DSIGN
ecdsaProxy
        [HexStringInCBOR]
wrongLengthVerKeyTestVectorsRaw
        InvalidLengthErrorFunction
invalidEcdsaVerKeyLengthError
      Proxy EcdsaSecp256k1DSIGN
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
invalidLengthSignatureParserTest
        Proxy EcdsaSecp256k1DSIGN
ecdsaProxy
        [HexStringInCBOR]
ecdsaWrongLengthSigTestVectorsRaw
        InvalidLengthErrorFunction
invalidEcdsaSigLengthError
      (VerKeyDSIGN EcdsaSecp256k1DSIGN, ByteString,
 SigDSIGN EcdsaSecp256k1DSIGN)
-> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> Spec
negativeSignatureTest (VerKeyDSIGN EcdsaSecp256k1DSIGN, ByteString,
 SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaNegSigTestVectors
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SchnorrSecp256k1" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      Proxy SchnorrSecp256k1DSIGN -> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
Proxy v -> Spec
signAndVerifyTest Proxy SchnorrSecp256k1DSIGN
schnorrProxy
      (VerKeyDSIGN SchnorrSecp256k1DSIGN, ByteString,
 SigDSIGN SchnorrSecp256k1DSIGN)
-> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> Spec
verifyOnlyTest (VerKeyDSIGN SchnorrSecp256k1DSIGN, ByteString,
 SigDSIGN SchnorrSecp256k1DSIGN)
schnorrVerKeyAndSigVerifyTestVectors
      VerKeyDSIGN SchnorrSecp256k1DSIGN -> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
VerKeyDSIGN v -> Spec
mismatchSignKeyVerKeyTest VerKeyDSIGN SchnorrSecp256k1DSIGN
wrongSchnorrVerKeyTestVector
      [(ByteString, VerKeyDSIGN SchnorrSecp256k1DSIGN,
  SigDSIGN SchnorrSecp256k1DSIGN)]
-> Spec
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
[(ByteString, VerKeyDSIGN v, SigDSIGN v)] -> Spec
mismatchMessageSignatureTest [(ByteString, VerKeyDSIGN SchnorrSecp256k1DSIGN,
  SigDSIGN SchnorrSecp256k1DSIGN)]
schnorrMismatchMessageAndSignature
      -- Note: First byte is dropped for schnorr as it doesn't require Y-cordinate information and assumed to be even and our vectors contains Y-information.
      Proxy SchnorrSecp256k1DSIGN -> HexStringInCBOR -> Spec
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> Spec
verKeyNotOnCurveParserTest Proxy SchnorrSecp256k1DSIGN
schnorrProxy (Int -> HexStringInCBOR -> HexStringInCBOR
Utils.dropBytes Int
1 HexStringInCBOR
verKeyNotOnCurveTestVectorRaw)
      Proxy SchnorrSecp256k1DSIGN
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
invalidLengthVerKeyParserTest
        Proxy SchnorrSecp256k1DSIGN
schnorrProxy
        ((HexStringInCBOR -> HexStringInCBOR)
-> [HexStringInCBOR] -> [HexStringInCBOR]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> HexStringInCBOR -> HexStringInCBOR
Utils.dropBytes Int
1) [HexStringInCBOR]
wrongLengthVerKeyTestVectorsRaw)
        InvalidLengthErrorFunction
invalidSchnorrVerKeyLengthError
      Proxy SchnorrSecp256k1DSIGN
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
invalidLengthSignatureParserTest
        Proxy SchnorrSecp256k1DSIGN
schnorrProxy
        [HexStringInCBOR]
schnorrWrongLengthSigTestVectorsRaw
        InvalidLengthErrorFunction
invalidSchnorrSigLengthError

negativeSignatureTest ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  ) =>
  (VerKeyDSIGN v, ByteString, SigDSIGN v) ->
  Spec
negativeSignatureTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> Spec
negativeSignatureTest (VerKeyDSIGN v
vKey, ByteString
msg, SigDSIGN v
sig) =
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Verification should fail when using negative signature." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    let result :: Either String ()
result = ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
verifyDSIGN () VerKeyDSIGN v
vKey (Proxy v -> ByteString -> a
forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig
    HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"Test failed. Verification should be false for negative signature." (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Either String () -> Bool
forall a b. Either a b -> Bool
isLeft Either String ()
result

type InvalidLengthErrorFunction = Integer -> String

invalidLengthSignatureParserTest ::
  forall v.
  FromCBOR (SigDSIGN v) =>
  Proxy v ->
  [HexStringInCBOR] ->
  InvalidLengthErrorFunction ->
  Spec
invalidLengthSignatureParserTest :: forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
invalidLengthSignatureParserTest Proxy v
_ [HexStringInCBOR]
invalidLengthSigs InvalidLengthErrorFunction
errorF =
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Parsing should fail when using invalid length signatures." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
    [HexStringInCBOR] -> (HexStringInCBOR -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HexStringInCBOR]
invalidLengthSigs ((HexStringInCBOR -> IO ()) -> IO ())
-> (HexStringInCBOR -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HexStringInCBOR
invalidSig -> do
      let (DeserialiseFailure ByteOffset
_ String
actualError) = Proxy v -> HexStringInCBOR -> DeserialiseFailure
forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidSigParserTest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
invalidSig
      String -> String -> String -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual
        String
"Expected invalid length signature error.."
        (InvalidLengthErrorFunction
errorF InvalidLengthErrorFunction -> InvalidLengthErrorFunction
forall a b. (a -> b) -> a -> b
$ HexStringInCBOR -> Integer
Utils.hexByteStringLength HexStringInCBOR
invalidSig)
        String
actualError

-- Try to parse the raw string into signature key and return the deserialize error
invalidSigParserTest ::
  forall v.
  FromCBOR (SigDSIGN v) =>
  Proxy v ->
  HexStringInCBOR ->
  DeserialiseFailure
invalidSigParserTest :: forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidSigParserTest Proxy v
_ HexStringInCBOR
rawSig = do
  let result :: Either DecoderError (SigDSIGN v)
result = Proxy v -> HexStringInCBOR -> Either DecoderError (SigDSIGN v)
forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> HexStringInCBOR -> Either DecoderError (SigDSIGN v)
fullSigParser (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
rawSig
  case Either DecoderError (SigDSIGN v)
result of
    Left (DecoderErrorDeserialiseFailure Text
_ DeserialiseFailure
err) -> DeserialiseFailure
err
    Left DecoderError
_ -> String -> DeserialiseFailure
forall a. HasCallStack => String -> a
error String
unexpectedDecodingError
    Right SigDSIGN v
_ -> String -> DeserialiseFailure
forall a. HasCallStack => String -> a
error String
"Test failed. Invalid signature is treated as valid."

-- Signature parser using decodeFull
fullSigParser ::
  forall v.
  FromCBOR (SigDSIGN v) =>
  Proxy v ->
  HexStringInCBOR ->
  Either DecoderError (SigDSIGN v)
fullSigParser :: forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> HexStringInCBOR -> Either DecoderError (SigDSIGN v)
fullSigParser Proxy v
_ (HexCBOR ByteString
hs) = ByteString -> Either DecoderError (SigDSIGN v)
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' ByteString
hs

-- Try to parse invalid length raw verification key
invalidLengthVerKeyParserTest ::
  forall v.
  FromCBOR (VerKeyDSIGN v) =>
  Proxy v ->
  [HexStringInCBOR] ->
  InvalidLengthErrorFunction ->
  Spec
invalidLengthVerKeyParserTest :: forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> [HexStringInCBOR] -> InvalidLengthErrorFunction -> Spec
invalidLengthVerKeyParserTest Proxy v
_ [HexStringInCBOR]
invalidLengthVKeys InvalidLengthErrorFunction
errorF =
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Parsing should fail when using invalid length verification keys." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
    [HexStringInCBOR] -> (HexStringInCBOR -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HexStringInCBOR]
invalidLengthVKeys ((HexStringInCBOR -> IO ()) -> IO ())
-> (HexStringInCBOR -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HexStringInCBOR
invalidVKey -> do
      let (DeserialiseFailure ByteOffset
_ String
actualError) = Proxy v -> HexStringInCBOR -> DeserialiseFailure
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidVerKeyParserTest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
invalidVKey
      String -> String -> String -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual
        String
"Expected invalid length verification key error."
        (InvalidLengthErrorFunction
errorF InvalidLengthErrorFunction -> InvalidLengthErrorFunction
forall a b. (a -> b) -> a -> b
$ HexStringInCBOR -> Integer
Utils.hexByteStringLength HexStringInCBOR
invalidVKey)
        String
actualError

-- Try to parse raw verification key string and expect decode key error.
verKeyNotOnCurveParserTest ::
  forall v.
  FromCBOR (VerKeyDSIGN v) =>
  Proxy v ->
  HexStringInCBOR ->
  Spec
verKeyNotOnCurveParserTest :: forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> Spec
verKeyNotOnCurveParserTest Proxy v
_ HexStringInCBOR
rawVKey = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Parsing should fail when trying to parse verification key not on the curve." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
  let (DeserialiseFailure ByteOffset
_ String
actualError) = Proxy v -> HexStringInCBOR -> DeserialiseFailure
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidVerKeyParserTest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
rawVKey
  String -> String -> String -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual String
"Expected cannot decode key error." String
cannotDecodeVerificationKeyError String
actualError

-- Try to parse the raw string into verification key and return the deserialize error
invalidVerKeyParserTest ::
  forall v.
  FromCBOR (VerKeyDSIGN v) =>
  Proxy v ->
  HexStringInCBOR ->
  DeserialiseFailure
invalidVerKeyParserTest :: forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidVerKeyParserTest Proxy v
_ HexStringInCBOR
rawVKey = do
  let result :: Either DecoderError (VerKeyDSIGN v)
result = Proxy v -> HexStringInCBOR -> Either DecoderError (VerKeyDSIGN v)
forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> Either DecoderError (VerKeyDSIGN v)
fullVerKeyParser (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
rawVKey
  case Either DecoderError (VerKeyDSIGN v)
result of
    Left (DecoderErrorDeserialiseFailure Text
_ DeserialiseFailure
err) -> DeserialiseFailure
err
    Left DecoderError
_ -> String -> DeserialiseFailure
forall a. HasCallStack => String -> a
error String
unexpectedDecodingError
    Right VerKeyDSIGN v
_ -> String -> DeserialiseFailure
forall a. HasCallStack => String -> a
error String
"Test failed. Invalid verification key is treated as valid."

-- Vkey parser using decodeFull
fullVerKeyParser ::
  forall v.
  FromCBOR (VerKeyDSIGN v) =>
  Proxy v ->
  HexStringInCBOR ->
  Either DecoderError (VerKeyDSIGN v)
fullVerKeyParser :: forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> Either DecoderError (VerKeyDSIGN v)
fullVerKeyParser Proxy v
_ (HexCBOR ByteString
hs) = ByteString -> Either DecoderError (VerKeyDSIGN v)
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' ByteString
hs

-- Use mismatch messages and signature vectors to test how verification behaves on wrong message or wrong signature
mismatchMessageSignatureTest ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  ) =>
  [(ByteString, VerKeyDSIGN v, SigDSIGN v)] ->
  Spec
mismatchMessageSignatureTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
[(ByteString, VerKeyDSIGN v, SigDSIGN v)] -> Spec
mismatchMessageSignatureTest [(ByteString, VerKeyDSIGN v, SigDSIGN v)]
mismatchMessageSignatureVectors =
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
    String
"Verification should not be successful when using mismatch message, signature and vice versa."
    (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ [(ByteString, VerKeyDSIGN v, SigDSIGN v)]
-> ((ByteString, VerKeyDSIGN v, SigDSIGN v) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
      [(ByteString, VerKeyDSIGN v, SigDSIGN v)]
mismatchMessageSignatureVectors
      ( \(ByteString
msg, VerKeyDSIGN v
vKey, SigDSIGN v
sig) -> do
          let result :: Either String ()
result = ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
verifyDSIGN () VerKeyDSIGN v
vKey (Proxy v -> ByteString -> a
forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig
          HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"Test Failed. Verification should not be successful." (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Either String () -> Bool
forall a b. Either a b -> Bool
isLeft Either String ()
result
      )

-- Use mismatch verification key for the signature generated by another signing key
mismatchSignKeyVerKeyTest ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  , FromCBOR (SignKeyDSIGN v)
  ) =>
  VerKeyDSIGN v ->
  Spec
mismatchSignKeyVerKeyTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
VerKeyDSIGN v -> Spec
mismatchSignKeyVerKeyTest VerKeyDSIGN v
vKey = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Verification should not be successful when using wrong verification key." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
  let result :: Either String ()
result = Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either String ()
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either String ()
signAndVerifyWithVkey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) SignKeyDSIGN v
forall d. FromCBOR (SignKeyDSIGN d) => SignKeyDSIGN d
defaultSKey VerKeyDSIGN v
vKey ByteString
defaultMessage
  HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"Test failed. Verification should not be successful." (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Either String () -> Bool
forall a b. Either a b -> Bool
isLeft Either String ()
result

-- Wrong message hash length parser test for ecdsa
wrongMessageHashLengthTest :: Spec
wrongMessageHashLengthTest :: Spec
wrongMessageHashLengthTest = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"toMessageHash should return Nothing when using invalid length message hash." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
  [ByteString] -> (ByteString -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
wrongLengthMessageHashTestVectors ((ByteString -> IO ()) -> IO ()) -> (ByteString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ByteString
msg -> do
    let msgHash :: Maybe MessageHash
msgHash = ByteString -> Maybe MessageHash
toMessageHash ByteString
msg
    HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"Test failed. Wrong message hash length is treated as right." (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe MessageHash -> Bool
forall a. Maybe a -> Bool
isNothing Maybe MessageHash
msgHash

-- Test for vKey, message and signature test vectors without using sign key
verifyOnlyTest ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  ) =>
  (VerKeyDSIGN v, ByteString, SigDSIGN v) ->
  Spec
verifyOnlyTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> Spec
verifyOnlyTest (VerKeyDSIGN v
vKey, ByteString
msg, SigDSIGN v
sig) = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Verification only should be successful." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ Proxy v -> VerKeyDSIGN v -> ByteString -> SigDSIGN v -> IO ()
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v -> VerKeyDSIGN v -> ByteString -> SigDSIGN v -> IO ()
verifyOnly (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) VerKeyDSIGN v
vKey ByteString
msg SigDSIGN v
sig

-- Sign using given sKey and verify it
signAndVerifyTest ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  , FromCBOR (SignKeyDSIGN v)
  ) =>
  Proxy v ->
  Spec
signAndVerifyTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
Proxy v -> Spec
signAndVerifyTest Proxy v
_ =
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Signing and verifications should be successful." (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
    ((SignKeyDSIGN v, ByteString) -> IO ())
-> [(SignKeyDSIGN v, ByteString)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((SignKeyDSIGN v -> ByteString -> IO ())
-> (SignKeyDSIGN v, ByteString) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((SignKeyDSIGN v -> ByteString -> IO ())
 -> (SignKeyDSIGN v, ByteString) -> IO ())
-> (SignKeyDSIGN v -> ByteString -> IO ())
-> (SignKeyDSIGN v, ByteString)
-> IO ()
forall a b. (a -> b) -> a -> b
$ Proxy v -> SignKeyDSIGN v -> ByteString -> IO ()
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v -> SignKeyDSIGN v -> ByteString -> IO ()
signAndVerify (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)) [(SignKeyDSIGN v, ByteString)]
forall d.
FromCBOR (SignKeyDSIGN d) =>
[(SignKeyDSIGN d, ByteString)]
signAndVerifyTestVectors

-- Sign a message using sign key, dervive verification key and check the signature
-- Used for testing whole sign and verification flow
signAndVerify ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  ) =>
  Proxy v ->
  SignKeyDSIGN v ->
  ByteString ->
  IO ()
signAndVerify :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v -> SignKeyDSIGN v -> ByteString -> IO ()
signAndVerify Proxy v
_ SignKeyDSIGN v
sKey ByteString
msg = do
  let vKey :: VerKeyDSIGN v
vKey = SignKeyDSIGN v -> VerKeyDSIGN v
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sKey
      result :: Either String ()
result = Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either String ()
forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either String ()
signAndVerifyWithVkey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) SignKeyDSIGN v
sKey VerKeyDSIGN v
vKey ByteString
msg
  HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"Test failed. Sign and verification should be successful." (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Either String () -> Bool
forall a b. Either a b -> Bool
isRight Either String ()
result

-- Sign a message using given sign key, verification key and check the signature
-- Used for testing whole sign and verification flow
signAndVerifyWithVkey ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  ) =>
  Proxy v ->
  SignKeyDSIGN v ->
  VerKeyDSIGN v ->
  ByteString ->
  Either String ()
signAndVerifyWithVkey :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either String ()
signAndVerifyWithVkey Proxy v
_ SignKeyDSIGN v
sKey VerKeyDSIGN v
vKey ByteString
msg =
  let sig :: SigDSIGN v
sig = ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () (Proxy v -> ByteString -> a
forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SignKeyDSIGN v
sKey
   in ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
verifyDSIGN () VerKeyDSIGN v
vKey (Proxy v -> ByteString -> a
forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig

-- Use alreday given signature, message and vkey to verify the signature
verifyOnly ::
  forall v a.
  ( DSIGNAlgorithm v
  , ContextDSIGN v ~ ()
  , Signable v a
  , ToSignable v a
  ) =>
  Proxy v ->
  VerKeyDSIGN v ->
  ByteString ->
  SigDSIGN v ->
  IO ()
verifyOnly :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v -> VerKeyDSIGN v -> ByteString -> SigDSIGN v -> IO ()
verifyOnly Proxy v
_ VerKeyDSIGN v
vKey ByteString
msg SigDSIGN v
sig = do
  let result :: Either String ()
result = ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
verifyDSIGN () VerKeyDSIGN v
vKey (Proxy v -> ByteString -> a
forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig
  HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
"Test failed. Verification only should be successful." (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Either String () -> Bool
forall a b. Either a b -> Bool
isRight Either String ()
result

-- Class for supplying required message format according to signature algorithm used
class ToSignable v a | v -> a where
  toSignable :: Signable v a => Proxy v -> ByteString -> a

instance ToSignable EcdsaSecp256k1DSIGN MessageHash where
  toSignable :: Signable EcdsaSecp256k1DSIGN MessageHash =>
Proxy EcdsaSecp256k1DSIGN -> ByteString -> MessageHash
toSignable Proxy EcdsaSecp256k1DSIGN
_ ByteString
bs = Proxy SHA3_256 -> ByteString -> MessageHash
forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> ByteString -> MessageHash
hashAndPack (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SHA3_256) ByteString
bs

instance ToSignable SchnorrSecp256k1DSIGN ByteString where
  toSignable :: Signable SchnorrSecp256k1DSIGN ByteString =>
Proxy SchnorrSecp256k1DSIGN -> ByteString -> ByteString
toSignable Proxy SchnorrSecp256k1DSIGN
_ ByteString
bs = ByteString
bs