-- editorconfig-checker-disable-file
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module Evaluation.Regressions (
  schnorrVerifyRegressions
  ) where

import Data.Bits (zeroBits)
import Data.ByteString (ByteString)
import Data.List.Split (chunksOf)
import Evaluation.Builtins.Common (typecheckEvaluateCek)
import GHC.Exts (fromListN)
import PlutusCore (DefaultFun (VerifySchnorrSecp256k1Signature),
                   EvaluationResult (EvaluationFailure))
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultBuiltinCostModelForTesting)
import PlutusCore.MkPlc (builtin, mkConstant, mkIterAppNoAnn)
import PlutusPrelude
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertEqual, assertFailure, testCase)
import Text.Read (readMaybe)

schnorrVerifyRegressions :: TestTree
schnorrVerifyRegressions :: TestTree
schnorrVerifyRegressions =
  [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Schnorr signature verification regressions" [
    [Char] -> Assertion -> TestTree
testCase [Char]
"malformed verkey should fail" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let badVerKey :: ByteString
badVerKey = ByteString
"m"
      let message :: ByteString
message = ByteString
"\213"
      let comp :: Term TyName Name DefaultUni DefaultFun ()
comp = Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
builtin () DefaultFun
VerifySchnorrSecp256k1Signature) [
            forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @ByteString () ByteString
badVerKey,
            forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @ByteString () ByteString
message,
            forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
mkConstant @ByteString () ByteString
signature
            ]
      let result :: Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()), [Text])
result = BuiltinSemanticsVariant DefaultFun
-> CostingPart DefaultUni DefaultFun
-> Term TyName Name DefaultUni DefaultFun ()
-> Either
     (Error DefaultUni DefaultFun ())
     (EvaluationResult (Term Name DefaultUni DefaultFun ()), [Text])
forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun ()) m, Typecheckable uni fun, GEq uni,
 Everywhere uni ExMemoryUsage, PrettyUni uni, Pretty fun) =>
BuiltinSemanticsVariant fun
-> CostingPart uni fun
-> Term TyName Name uni fun ()
-> m (EvaluationResult (Term Name uni fun ()), [Text])
typecheckEvaluateCek BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def BuiltinCostModel
CostingPart DefaultUni DefaultFun
defaultBuiltinCostModelForTesting Term TyName Name DefaultUni DefaultFun ()
comp
      case Either
  (Error DefaultUni DefaultFun ())
  (EvaluationResult (Term Name DefaultUni DefaultFun ()), [Text])
result of
        Left Error DefaultUni DefaultFun ()
_         -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure [Char]
"Failed to type check unexpectedly"
        Right (EvaluationResult (Term Name DefaultUni DefaultFun ())
res, [Text]
_) -> [Char]
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
-> EvaluationResult (Term Name DefaultUni DefaultFun ())
-> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"" EvaluationResult (Term Name DefaultUni DefaultFun ())
forall a. EvaluationResult a
EvaluationFailure EvaluationResult (Term Name DefaultUni DefaultFun ())
res
    ]

-- The original reproducing case is a hex string
-- Unfortunately, ByteString literals are a weird pseudo-ASCII thing
-- Thus, this manual reconstruction
signature :: ByteString
signature :: ByteString
signature = Int -> [Item ByteString] -> ByteString
forall l. IsList l => Int -> [Item l] -> l
fromListN Int
64 ([Word8] -> ByteString)
-> ([Char] -> [Word8]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Word8
go ([[Char]] -> [Word8]) -> ([Char] -> [[Char]]) -> [Char] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [[Char]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
2 ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"4d83cfb975c5f8b9ba656edb205466bf2c5548f01fc3277427d4ff555df4a996383e171127e82e56fd9bfd0e22df12a004fdac73c67793d97199cc5b223dbe84"
  where
    go :: [Char] -> Word8
    go :: [Char] -> Word8
go = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe Word8
forall a. Bits a => a
zeroBits (Maybe Word8 -> Word8)
-> ([Char] -> Maybe Word8) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Word8
forall a. Read a => [Char] -> Maybe a
readMaybe