{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs           #-}
module Plutus.Contract.Test.Certification where

import Plutus.Contract.Test.ContractModel
import Plutus.Contract.Test.ContractModel.CrashTolerance
import PlutusTx.Coverage
import Test.Tasty as Tasty

data Instance c m where
  Instance :: c m => Instance c m

-- | A certification object specifies what tests should be run by the
--   'Plutus.Contract.Test.Certification.Run.certify' function.
data Certification m = Certification {
    Certification m -> CoverageIndex
certCoverageIndex      :: CoverageIndex,                      -- ^ Coverage locations for on-chain test coverage.
    Certification m -> Maybe (NoLockedFundsProof m)
certNoLockedFunds      :: Maybe (NoLockedFundsProof m),
    Certification m -> Maybe (NoLockedFundsProofLight m)
certNoLockedFundsLight :: Maybe (NoLockedFundsProofLight m),
    Certification m -> Maybe (Instance CrashTolerance m)
certCrashTolerance     :: Maybe (Instance CrashTolerance m),  -- ^ Contract model for testing robustness against off-chain code crashes.
    Certification m -> Maybe Whitelist
certWhitelist          :: Maybe Whitelist,                    -- ^ List of allowed exceptions from on-chain code. Usually `Just 'defaultWhiteList'`.
    Certification m -> Maybe (CoverageRef -> TestTree)
certUnitTests          :: Maybe (CoverageRef -> TestTree),    -- ^ Unit tests using "Test.Tasty". See e.g. 'Plutus.Contract.Test.checkPredicateCoverage'.
    Certification m -> [(String, DL m ())]
certDLTests            :: [(String, DL m ())]                 -- ^ Unit tests using 'Plutus.Contract.Test.ContractModel.DL'.
  }

defaultCertification :: Certification m
defaultCertification :: Certification m
defaultCertification = Certification :: forall m.
CoverageIndex
-> Maybe (NoLockedFundsProof m)
-> Maybe (NoLockedFundsProofLight m)
-> Maybe (Instance CrashTolerance m)
-> Maybe Whitelist
-> Maybe (CoverageRef -> TestTree)
-> [(String, DL m ())]
-> Certification m
Certification
  { certCoverageIndex :: CoverageIndex
certCoverageIndex      = CoverageIndex
forall a. Monoid a => a
mempty
  , certNoLockedFunds :: Maybe (NoLockedFundsProof m)
certNoLockedFunds      = Maybe (NoLockedFundsProof m)
forall a. Maybe a
Nothing
  , certNoLockedFundsLight :: Maybe (NoLockedFundsProofLight m)
certNoLockedFundsLight = Maybe (NoLockedFundsProofLight m)
forall a. Maybe a
Nothing
  , certUnitTests :: Maybe (CoverageRef -> TestTree)
certUnitTests          = Maybe (CoverageRef -> TestTree)
forall a. Maybe a
Nothing
  , certCrashTolerance :: Maybe (Instance CrashTolerance m)
certCrashTolerance     = Maybe (Instance CrashTolerance m)
forall a. Maybe a
Nothing
  , certWhitelist :: Maybe Whitelist
certWhitelist          = Whitelist -> Maybe Whitelist
forall a. a -> Maybe a
Just Whitelist
defaultWhitelist
  , certDLTests :: [(String, DL m ())]
certDLTests            = []
  }