{-# 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 Paths_cardano_ledger_dijkstra (getDataFileName)
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.Examples (
  exampleDijkstraOnwardsEraPParams,
  exampleDijkstraOnwardsEraPParamsUpdate,
  exampleDijkstraTx,
 )
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

  mkEraFullPath :: FilePath -> IO FilePath
mkEraFullPath = FilePath -> IO FilePath
getDataFileName

  exampleTx :: Tx TopTx DijkstraEra
exampleTx = Tx TopTx DijkstraEra
exampleDijkstraTx

  examplePParams :: PParams DijkstraEra
examplePParams = PParams DijkstraEra
forall era.
(DijkstraEraPParams era, ConwayEraPParams era) =>
PParams era
exampleDijkstraOnwardsEraPParams

  examplePParamsUpdate :: PParamsUpdate DijkstraEra
examplePParamsUpdate = PParamsUpdate DijkstraEra
forall era.
(DijkstraEraPParams era, ConwayEraPParams era) =>
PParamsUpdate era
exampleDijkstraOnwardsEraPParamsUpdate

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}}