{-# 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.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertEqual, testCase)

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

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

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Secp256k1 Test Vectors"
    [ -- Note : Proxies are here repetead due to specific test vectors need to be used with specific proxy
      TestName -> [TestTree] -> TestTree
testGroup
        TestName
"EcdsaSecp256k1"
        [ forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
Proxy v -> TestTree
signAndVerifyTest Proxy EcdsaSecp256k1DSIGN
ecdsaProxy
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> TestTree
verifyOnlyTest (VerKeyDSIGN EcdsaSecp256k1DSIGN, ByteString,
 SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaVerKeyAndSigVerifyTestVectors
        , TestTree
wrongMessageHashLengthTest
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
VerKeyDSIGN v -> TestTree
mismatchSignKeyVerKeyTest VerKeyDSIGN EcdsaSecp256k1DSIGN
wrongEcdsaVerKeyTestVector
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
[(ByteString, VerKeyDSIGN v, SigDSIGN v)] -> TestTree
mismatchMessageSignatureTest [(ByteString, VerKeyDSIGN EcdsaSecp256k1DSIGN,
  SigDSIGN EcdsaSecp256k1DSIGN)]
ecdsaMismatchMessageAndSignature
        , forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> TestTree
verKeyNotOnCurveParserTest Proxy EcdsaSecp256k1DSIGN
ecdsaProxy HexStringInCBOR
verKeyNotOnCurveTestVectorRaw
        , forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> TestTree
invalidLengthVerKeyParserTest
            Proxy EcdsaSecp256k1DSIGN
ecdsaProxy
            [HexStringInCBOR]
wrongLengthVerKeyTestVectorsRaw
            InvalidLengthErrorFunction
invalidEcdsaVerKeyLengthError
        , forall v.
FromCBOR (SigDSIGN v) =>
Proxy v
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> TestTree
invalidLengthSignatureParserTest
            Proxy EcdsaSecp256k1DSIGN
ecdsaProxy
            [HexStringInCBOR]
ecdsaWrongLengthSigTestVectorsRaw
            InvalidLengthErrorFunction
invalidEcdsaSigLengthError
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> TestTree
negativeSignatureTest (VerKeyDSIGN EcdsaSecp256k1DSIGN, ByteString,
 SigDSIGN EcdsaSecp256k1DSIGN)
ecdsaNegSigTestVectors
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"SchnorrSecp256k1"
        [ forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
Proxy v -> TestTree
signAndVerifyTest Proxy SchnorrSecp256k1DSIGN
schnorrProxy
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> TestTree
verifyOnlyTest (VerKeyDSIGN SchnorrSecp256k1DSIGN, ByteString,
 SigDSIGN SchnorrSecp256k1DSIGN)
schnorrVerKeyAndSigVerifyTestVectors
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
VerKeyDSIGN v -> TestTree
mismatchSignKeyVerKeyTest VerKeyDSIGN SchnorrSecp256k1DSIGN
wrongSchnorrVerKeyTestVector
        , forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
[(ByteString, VerKeyDSIGN v, SigDSIGN v)] -> TestTree
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.
          forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> TestTree
verKeyNotOnCurveParserTest Proxy SchnorrSecp256k1DSIGN
schnorrProxy (Int -> HexStringInCBOR -> HexStringInCBOR
Utils.dropBytes Int
1 HexStringInCBOR
verKeyNotOnCurveTestVectorRaw)
        , forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> TestTree
invalidLengthVerKeyParserTest
            Proxy SchnorrSecp256k1DSIGN
schnorrProxy
            (forall a b. (a -> b) -> [a] -> [b]
map (Int -> HexStringInCBOR -> HexStringInCBOR
Utils.dropBytes Int
1) [HexStringInCBOR]
wrongLengthVerKeyTestVectorsRaw)
            InvalidLengthErrorFunction
invalidSchnorrVerKeyLengthError
        , forall v.
FromCBOR (SigDSIGN v) =>
Proxy v
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> TestTree
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) ->
  TestTree
negativeSignatureTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> TestTree
negativeSignatureTest (VerKeyDSIGN v
vKey, ByteString
msg, SigDSIGN v
sig) =
  TestName -> Assertion -> TestTree
testCase TestName
"Verification should fail when using negative signature." forall a b. (a -> b) -> a -> b
$ do
    let result :: Either TestName ()
result = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vKey (forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Test failed. Verification should be false for negative signature." forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isLeft Either TestName ()
result

type InvalidLengthErrorFunction = Integer -> String

invalidLengthSignatureParserTest ::
  forall v.
  FromCBOR (SigDSIGN v) =>
  Proxy v ->
  [HexStringInCBOR] ->
  InvalidLengthErrorFunction ->
  TestTree
invalidLengthSignatureParserTest :: forall v.
FromCBOR (SigDSIGN v) =>
Proxy v
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> TestTree
invalidLengthSignatureParserTest Proxy v
_ [HexStringInCBOR]
invalidLengthSigs InvalidLengthErrorFunction
errorF =
  TestName -> Assertion -> TestTree
testCase TestName
"Parsing should fail when using invalid length signatures." forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HexStringInCBOR]
invalidLengthSigs forall a b. (a -> b) -> a -> b
$ \HexStringInCBOR
invalidSig -> do
      let (DeserialiseFailure ByteOffset
_ TestName
actualError) = forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidSigParserTest (forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
invalidSig
      forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
        TestName
"Expected invalid length signature error.."
        (InvalidLengthErrorFunction
errorF forall a b. (a -> b) -> a -> b
$ HexStringInCBOR -> Integer
Utils.hexByteStringLength HexStringInCBOR
invalidSig)
        TestName
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 = forall v.
FromCBOR (SigDSIGN v) =>
Proxy v -> HexStringInCBOR -> Either DecoderError (SigDSIGN v)
fullSigParser (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
_ -> forall a. HasCallStack => TestName -> a
error TestName
unexpectedDecodingError
    Right SigDSIGN v
_ -> forall a. HasCallStack => TestName -> a
error TestName
"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) = 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 ->
  TestTree
invalidLengthVerKeyParserTest :: forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v
-> [HexStringInCBOR] -> InvalidLengthErrorFunction -> TestTree
invalidLengthVerKeyParserTest Proxy v
_ [HexStringInCBOR]
invalidLengthVKeys InvalidLengthErrorFunction
errorF =
  TestName -> Assertion -> TestTree
testCase TestName
"Parsing should fail when using invalid length verification keys." forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HexStringInCBOR]
invalidLengthVKeys forall a b. (a -> b) -> a -> b
$ \HexStringInCBOR
invalidVKey -> do
      let (DeserialiseFailure ByteOffset
_ TestName
actualError) = forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidVerKeyParserTest (forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
invalidVKey
      forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
        TestName
"Expected invalid length verification key error."
        (InvalidLengthErrorFunction
errorF forall a b. (a -> b) -> a -> b
$ HexStringInCBOR -> Integer
Utils.hexByteStringLength HexStringInCBOR
invalidVKey)
        TestName
actualError

-- Try to parse raw verification key string and expect decode key error.
verKeyNotOnCurveParserTest ::
  forall v.
  FromCBOR (VerKeyDSIGN v) =>
  Proxy v ->
  HexStringInCBOR ->
  TestTree
verKeyNotOnCurveParserTest :: forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> TestTree
verKeyNotOnCurveParserTest Proxy v
_ HexStringInCBOR
rawVKey = TestName -> Assertion -> TestTree
testCase TestName
"Parsing should fail when trying to parse verification key not on the curve." forall a b. (a -> b) -> a -> b
$ do
  let (DeserialiseFailure ByteOffset
_ TestName
actualError) = forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> DeserialiseFailure
invalidVerKeyParserTest (forall {k} (t :: k). Proxy t
Proxy @v) HexStringInCBOR
rawVKey
  forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"Expected cannot decode key error." TestName
cannotDecodeVerificationKeyError TestName
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 = forall v.
FromCBOR (VerKeyDSIGN v) =>
Proxy v -> HexStringInCBOR -> Either DecoderError (VerKeyDSIGN v)
fullVerKeyParser (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
_ -> forall a. HasCallStack => TestName -> a
error TestName
unexpectedDecodingError
    Right VerKeyDSIGN v
_ -> forall a. HasCallStack => TestName -> a
error TestName
"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) = 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)] ->
  TestTree
mismatchMessageSignatureTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
[(ByteString, VerKeyDSIGN v, SigDSIGN v)] -> TestTree
mismatchMessageSignatureTest [(ByteString, VerKeyDSIGN v, SigDSIGN v)]
mismatchMessageSignatureVectors =
  TestName -> Assertion -> TestTree
testCase
    TestName
"Verification should not be successful when using mismatch message, signature and vice versa."
    forall a b. (a -> b) -> a -> b
$ 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 TestName ()
result = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vKey (forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig
          HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Test Failed. Verification should not be successful." forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isLeft Either TestName ()
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 ->
  TestTree
mismatchSignKeyVerKeyTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
VerKeyDSIGN v -> TestTree
mismatchSignKeyVerKeyTest VerKeyDSIGN v
vKey = TestName -> Assertion -> TestTree
testCase TestName
"Verification should not be successful when using wrong verification key." forall a b. (a -> b) -> a -> b
$ do
  let result :: Either TestName ()
result = forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either TestName ()
signAndVerifyWithVkey (forall {k} (t :: k). Proxy t
Proxy @v) forall d. FromCBOR (SignKeyDSIGN d) => SignKeyDSIGN d
defaultSKey VerKeyDSIGN v
vKey ByteString
defaultMessage
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Test failed. Verification should not be successful." forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isLeft Either TestName ()
result

-- Wrong message hash length parser test for ecdsa
wrongMessageHashLengthTest :: TestTree
wrongMessageHashLengthTest :: TestTree
wrongMessageHashLengthTest = TestName -> Assertion -> TestTree
testCase TestName
"toMessageHash should return Nothing when using invalid length message hash." forall a b. (a -> b) -> a -> b
$
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
wrongLengthMessageHashTestVectors forall a b. (a -> b) -> a -> b
$ \ByteString
msg -> do
    let msgHash :: Maybe MessageHash
msgHash = ByteString -> Maybe MessageHash
toMessageHash ByteString
msg
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Test failed. Wrong message hash length is treated as right." forall a b. (a -> b) -> a -> b
$ 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) ->
  TestTree
verifyOnlyTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
(VerKeyDSIGN v, ByteString, SigDSIGN v) -> TestTree
verifyOnlyTest (VerKeyDSIGN v
vKey, ByteString
msg, SigDSIGN v
sig) = TestName -> Assertion -> TestTree
testCase TestName
"Verification only should be successful." forall a b. (a -> b) -> a -> b
$ forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v -> VerKeyDSIGN v -> ByteString -> SigDSIGN v -> Assertion
verifyOnly (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 ->
  TestTree
signAndVerifyTest :: forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a, FromCBOR (SignKeyDSIGN v)) =>
Proxy v -> TestTree
signAndVerifyTest Proxy v
_ =
  TestName -> Assertion -> TestTree
testCase TestName
"Signing and verifications should be successful." forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v -> SignKeyDSIGN v -> ByteString -> Assertion
signAndVerify (forall {k} (t :: k). Proxy t
Proxy @v)) 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 -> Assertion
signAndVerify Proxy v
_ SignKeyDSIGN v
sKey ByteString
msg = do
  let vKey :: VerKeyDSIGN v
vKey = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN v
sKey
      result :: Either TestName ()
result = forall v a.
(DSIGNAlgorithm v, ContextDSIGN v ~ (), Signable v a,
 ToSignable v a) =>
Proxy v
-> SignKeyDSIGN v
-> VerKeyDSIGN v
-> ByteString
-> Either TestName ()
signAndVerifyWithVkey (forall {k} (t :: k). Proxy t
Proxy @v) SignKeyDSIGN v
sKey VerKeyDSIGN v
vKey ByteString
msg
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Test failed. Sign and verification should be successful." forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isRight Either TestName ()
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 TestName ()
signAndVerifyWithVkey Proxy v
_ SignKeyDSIGN v
sKey VerKeyDSIGN v
vKey ByteString
msg =
  let sig :: SigDSIGN v
sig = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN () (forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SignKeyDSIGN v
sKey
   in forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vKey (forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (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 -> Assertion
verifyOnly Proxy v
_ VerKeyDSIGN v
vKey ByteString
msg SigDSIGN v
sig = do
  let result :: Either TestName ()
result = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either TestName ()
verifyDSIGN () VerKeyDSIGN v
vKey (forall v a.
(ToSignable v a, Signable v a) =>
Proxy v -> ByteString -> a
toSignable (forall {k} (t :: k). Proxy t
Proxy @v) ByteString
msg) SigDSIGN v
sig
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Test failed. Verification only should be successful." forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isRight Either TestName ()
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 = forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> ByteString -> MessageHash
hashAndPack (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