{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Consensus.Cardano.Golden (tests) where

import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.Node
import Ouroboros.Consensus.HardFork.Combinator.Serialisation
import Ouroboros.Consensus.Ledger.Query (QueryVersion)
import Ouroboros.Consensus.Shelley.HFEras ()
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import System.FilePath ((</>))
import Test.Consensus.Cardano.Examples
import Test.Tasty
import Test.Util.Paths
import Test.Util.Serialisation.Golden

tests :: TestTree
tests :: TestTree
tests = CodecConfig (CardanoBlock Crypto)
-> FilePath -> Examples (CardanoBlock Crypto) -> TestTree
forall blk.
(SerialiseDiskConstraints blk, SerialiseNodeToNodeConstraints blk,
 SerialiseNodeToClientConstraints blk,
 SupportedNetworkProtocolVersion blk, BlockSupportsLedgerQuery blk,
 ToGoldenDirectory (BlockNodeToNodeVersion blk),
 ToGoldenDirectory (QueryVersion, BlockNodeToClientVersion blk),
 HasCallStack) =>
CodecConfig blk -> FilePath -> Examples blk -> TestTree
goldenTest_all CodecConfig (CardanoBlock Crypto)
codecConfig ($(getGoldenDir) FilePath -> FilePath -> FilePath
</> FilePath
"cardano") Examples (CardanoBlock Crypto)
examples

instance
  CardanoHardForkConstraints c =>
  ToGoldenDirectory (HardForkNodeToNodeVersion (CardanoEras c))
  where
  toGoldenDirectory :: HardForkNodeToNodeVersion (CardanoEras c) -> FilePath
toGoldenDirectory HardForkNodeToNodeVersion (CardanoEras c)
v = case HardForkNodeToNodeVersion (CardanoEras c)
v of
    BlockNodeToNodeVersion (CardanoBlock c)
HardForkNodeToNodeVersion (CardanoEras c)
CardanoNodeToNodeVersion1 -> FilePath
"CardanoNodeToNodeVersion1"
    BlockNodeToNodeVersion (CardanoBlock c)
HardForkNodeToNodeVersion (CardanoEras c)
CardanoNodeToNodeVersion2 -> FilePath
"CardanoNodeToNodeVersion2"
    HardForkNodeToNodeVersion (CardanoEras c)
_ -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown version: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> HardForkNodeToNodeVersion (CardanoEras c) -> FilePath
forall a. Show a => a -> FilePath
show HardForkNodeToNodeVersion (CardanoEras c)
v

instance
  CardanoHardForkConstraints c =>
  ToGoldenDirectory (QueryVersion, HardForkNodeToClientVersion (CardanoEras c))
  where
  toGoldenDirectory :: (QueryVersion, HardForkNodeToClientVersion (CardanoEras c))
-> FilePath
toGoldenDirectory (QueryVersion
queryVersion, HardForkNodeToClientVersion (CardanoEras c)
blockVersion) =
    QueryVersion -> FilePath
forall a. Show a => a -> FilePath
show QueryVersion
queryVersion FilePath -> FilePath -> FilePath
</> case HardForkNodeToClientVersion (CardanoEras c)
blockVersion of
      BlockNodeToClientVersion (CardanoBlock c)
HardForkNodeToClientVersion (CardanoEras c)
CardanoNodeToClientVersion12 -> FilePath
"CardanoNodeToClientVersion12"
      BlockNodeToClientVersion (CardanoBlock c)
HardForkNodeToClientVersion (CardanoEras c)
CardanoNodeToClientVersion13 -> FilePath
"CardanoNodeToClientVersion13"
      BlockNodeToClientVersion (CardanoBlock c)
HardForkNodeToClientVersion (CardanoEras c)
CardanoNodeToClientVersion14 -> FilePath
"CardanoNodeToClientVersion14"
      BlockNodeToClientVersion (CardanoBlock c)
HardForkNodeToClientVersion (CardanoEras c)
CardanoNodeToClientVersion15 -> FilePath
"CardanoNodeToClientVersion15"
      BlockNodeToClientVersion (CardanoBlock c)
HardForkNodeToClientVersion (CardanoEras c)
CardanoNodeToClientVersion16 -> FilePath
"CardanoNodeToClientVersion16"
      BlockNodeToClientVersion (CardanoBlock c)
HardForkNodeToClientVersion (CardanoEras c)
CardanoNodeToClientVersion17 -> FilePath
"CardanoNodeToClientVersion17"
      HardForkNodeToClientVersion (CardanoEras c)
_ -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown version: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> HardForkNodeToClientVersion (CardanoEras c) -> FilePath
forall a. Show a => a -> FilePath
show HardForkNodeToClientVersion (CardanoEras c)
blockVersion