Spec.hs

-- editorconfig-checker-disable-file
module Main where

import PlutusLedgerApi.Common.Versions
import PlutusLedgerApi.Test.Examples
import PlutusLedgerApi.Test.V1.EvaluationContext qualified as V1
import PlutusLedgerApi.Test.V3.EvaluationContext qualified as V3
import PlutusLedgerApi.V1 as V1
import PlutusLedgerApi.V3 as V3
import PlutusPrelude
import Spec.ApiUtils qualified
import Spec.CBOR.DeserialiseFailureInfo qualified
import Spec.ContextDecoding qualified
import Spec.CostModelParams qualified
import Spec.Data.ContextDecoding qualified
import Spec.Data.CostModelParams qualified
import Spec.Data.Eval qualified
import Spec.Data.Versions qualified
import Spec.Eval qualified
import Spec.Interval qualified
import Spec.ScriptDecodeError qualified
import Spec.V1.Data.Value qualified as Data.Value
import Spec.V1.Value qualified as Value
import Spec.Versions qualified

import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck

import Control.Monad.Writer
import Data.Int (Int64)

main :: IO ()
main = defaultMain tests

v1_evalCtxForTesting :: V1.EvaluationContext
v1_evalCtxForTesting = fst $ unsafeFromRight $ runWriterT $ V1.mkEvaluationContext (fmap snd V1.costModelParamsForTesting)

-- | Constructing a V3 context with the first 223 parameters.
-- As a result, the cost model parameters for `integerToByteString` and `byteStringToInteger`
-- should be set to large numbers, preventing them from being used.
v3_evalCtxTooFewParams :: V3.EvaluationContext
v3_evalCtxTooFewParams = fst $ unsafeFromRight $ runWriterT $ V3.mkEvaluationContext (take 223 $ fmap snd V3.costModelParamsForTesting)

alwaysTrue :: TestTree
alwaysTrue = testCase "always true script returns true" $
    let script = either (error . show) id $ V1.deserialiseScript alonzoPV (alwaysSucceedingNAryFunction 2)
        (_, res) = V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting script [I 1, I 2]
    in assertBool "succeeds" (isRight res)

alwaysFalse :: TestTree
alwaysFalse = testCase "always false script returns false" $
    let script = either (error . show) id $ V1.deserialiseScript alonzoPV (alwaysFailingNAryFunction 2)
        (_, res) = V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting script [I 1, I 2]
    in assertBool "fails" (isLeft res)

unavailableBuiltins :: TestTree
unavailableBuiltins = testCase "builtins are unavailable before Alonzo" $
    let res = V1.deserialiseScript maryPV summingFunction
    in assertBool "fails" (isLeft res)

availableBuiltins :: TestTree
availableBuiltins = testCase "builtins are available after Alonzo" $
    let res = V1.deserialiseScript alonzoPV summingFunction
    in assertBool "succeeds" (isRight res)

integerToByteStringExceedsBudget :: TestTree
integerToByteStringExceedsBudget = testCase "integerToByteString should exceed budget" $
    let script = either (error . show) id $ V3.deserialiseScript changPV integerToByteStringFunction
        (_, res) = V3.evaluateScriptCounting changPV V3.Quiet v3_evalCtxTooFewParams script (I 1)
    in case res of
        Left _ -> assertFailure "fails"
        Right (ExBudget cpu _mem) -> assertBool "did not exceed budget" (cpu >= fromIntegral (maxBound :: Int64))

saltedFunction :: TestTree
saltedFunction =
    let evaluate ss ss' args =
            let s = either (error . show) id $ V1.deserialiseScript alonzoPV ss
                s' = either (error . show) id $ V1.deserialiseScript alonzoPV ss'
             in ( V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting s args
                , V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting s' args
                )
    in testGroup "salted function"
    [ testProperty "saturated" $ \(n :: Word8) salt fWhich ->
        let f = (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $ fromInteger $ toInteger n
            f' = saltFunction salt f
            args = replicate (fromEnum n) $ I 1
            ((_, res), (_, res')) = evaluate f f' args
        in cover 25 (isRight res) "success" $
           cover 25 (isLeft res) "fail" $
            void res === void res'
            .&&. fWhich === isRight res
    , testProperty "unsaturated" $ \(n :: Word8) (n' :: Word8) salt fWhich ->
        let f = (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $
                fromInteger (toInteger n) + fromInteger (toInteger n') + 1
            f' = saltFunction salt f
            args = replicate (fromEnum n) $ I 1
            ((_, res), (_, res')) = evaluate f f' args
        in cover 25 (isRight res) "success" $
           void res === void res'
    , testProperty "oversaturated" $ \(n :: Word8) (n' :: Word8) salt fWhich ->
        let f = (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $
                fromInteger (toInteger n)
            f' = saltFunction salt f
            args = replicate (fromEnum n + fromEnum n' + 1) $ I 1
            ((_, res), (_, res')) = evaluate f f' args
        in cover 25 (isLeft res) "fail" $
            void res === void res'
    , testProperty "salt" $ \(n :: Word8) salt salt' fWhich ->
        let f = (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $ fromInteger $ toInteger n
            f' = saltFunction salt f
            f'' = saltFunction salt' f
        in salt /= salt' ==> f' /= f''
    ]


tests :: TestTree
tests = testGroup "plutus-ledger-api"
  [ testGroup "basic evaluation tests"
    [
      alwaysTrue
    , alwaysFalse
    , saltedFunction
    , unavailableBuiltins
    , availableBuiltins
    , integerToByteStringExceedsBudget
    ]
    , testGroup "Common"
      [ Spec.Interval.tests
      , Spec.CBOR.DeserialiseFailureInfo.tests
      , Spec.ScriptDecodeError.tests
      , Spec.ApiUtils.tests
      ]
    , testGroup "Context-dependent tests"
      [ testGroup "Original"
        [ Spec.Eval.tests
        , Spec.Versions.tests
        , Spec.CostModelParams.tests
        , Spec.ContextDecoding.tests
        , Value.test_Value
        ]
      , testGroup "Data"
        [ Spec.Data.Eval.tests
        , Spec.Data.Versions.tests
        , Spec.Data.CostModelParams.tests
        , Spec.Data.ContextDecoding.tests
        , Data.Value.test_Value
        ]
      ]
    ]