{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Dijkstra.Era (
  module Test.Cardano.Ledger.Conway.Era,
  DijkstraEraTest,
) where

import Cardano.Ledger.Block (Block (..))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.Era (DijkstraEraBlockHeader (..))
import Cardano.Ledger.Dijkstra.Scripts (DijkstraEraScript)
import Cardano.Ledger.Dijkstra.State
import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody)
import Cardano.Ledger.Plutus (Language (..))
import Data.Coerce
import Data.Maybe (fromJust)
import Lens.Micro (lens)
import Test.Cardano.Ledger.BlockHeader (TestBlockHeader (..))
import Test.Cardano.Ledger.Conway.Era
import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
import Test.Cardano.Ledger.Dijkstra.Binary.Annotator ()
import Test.Cardano.Ledger.Dijkstra.TreeDiff ()
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)

instance EraTest DijkstraEra where
  zeroCostModels :: CostModels
zeroCostModels = HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1 .. Language
PlutusV4]

  mkTestAccountState :: HasCallStack =>
Maybe Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState DijkstraEra
mkTestAccountState Maybe Ptr
_ptr = CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState DijkstraEra
forall era.
ConwayEraAccounts era =>
CompactForm Coin
-> Maybe (KeyHash StakePool) -> Maybe DRep -> AccountState era
mkConwayTestAccountState

  accountsFromAccountsMap :: Map (Credential Staking) (AccountState DijkstraEra)
-> Accounts DijkstraEra
accountsFromAccountsMap = Map (Credential Staking) (AccountState DijkstraEra)
-> Accounts DijkstraEra
Map (Credential Staking) (ConwayAccountState DijkstraEra)
-> ConwayAccounts DijkstraEra
forall a b. Coercible a b => a -> b
coerce

class
  ( ConwayEraTest era
  , DijkstraEraTxBody era
  , DijkstraEraScript era
  ) =>
  DijkstraEraTest era

instance ShelleyEraTest DijkstraEra

instance AllegraEraTest DijkstraEra

instance MaryEraTest DijkstraEra

instance AlonzoEraTest DijkstraEra

instance BabbageEraTest DijkstraEra

instance ConwayEraTest DijkstraEra

instance DijkstraEraTest DijkstraEra

instance DijkstraEraBlockHeader TestBlockHeader DijkstraEra where
  prevNonceBlockHeaderL :: Lens' (Block TestBlockHeader DijkstraEra) Nonce
prevNonceBlockHeaderL =
    (Block TestBlockHeader DijkstraEra -> Nonce)
-> (Block TestBlockHeader DijkstraEra
    -> Nonce -> Block TestBlockHeader DijkstraEra)
-> Lens' (Block TestBlockHeader DijkstraEra) Nonce
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      (Maybe Nonce -> Nonce
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Nonce -> Nonce)
-> (Block TestBlockHeader DijkstraEra -> Maybe Nonce)
-> Block TestBlockHeader DijkstraEra
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestBlockHeader -> Maybe Nonce
tbhPrevNonce (TestBlockHeader -> Maybe Nonce)
-> (Block TestBlockHeader DijkstraEra -> TestBlockHeader)
-> Block TestBlockHeader DijkstraEra
-> Maybe Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block TestBlockHeader DijkstraEra -> TestBlockHeader
forall h era. Block h era -> h
blockHeader)
      ((Block TestBlockHeader DijkstraEra
  -> Nonce -> Block TestBlockHeader DijkstraEra)
 -> Lens' (Block TestBlockHeader DijkstraEra) Nonce)
-> (Block TestBlockHeader DijkstraEra
    -> Nonce -> Block TestBlockHeader DijkstraEra)
-> Lens' (Block TestBlockHeader DijkstraEra) Nonce
forall a b. (a -> b) -> a -> b
$ \b :: Block TestBlockHeader DijkstraEra
b@Block {TestBlockHeader
blockHeader :: forall h era. Block h era -> h
blockHeader :: TestBlockHeader
blockHeader} Nonce
pNonce -> Block TestBlockHeader DijkstraEra
b {blockHeader = blockHeader {tbhPrevNonce = Just pNonce}}