{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -Wno-orphans #-}

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

import           Ouroboros.Consensus.Byron.Ledger.NetworkProtocolVersion
import           Ouroboros.Consensus.Byron.Node ()
import           Ouroboros.Consensus.Ledger.Query (QueryVersion)
import           System.FilePath ((</>))
import           Test.Consensus.Byron.Examples
import           Test.Tasty
import           Test.Util.Paths
import           Test.Util.Serialisation.Golden

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

instance ToGoldenDirectory ByronNodeToNodeVersion
  -- Use defaults

instance ToGoldenDirectory (QueryVersion, ByronNodeToClientVersion) where
  toGoldenDirectory :: (QueryVersion, ByronNodeToClientVersion) -> FilePath
toGoldenDirectory (QueryVersion
queryVersion, ByronNodeToClientVersion
blockVersion)
    = QueryVersion -> FilePath
forall a. Show a => a -> FilePath
show QueryVersion
queryVersion FilePath -> FilePath -> FilePath
</> ByronNodeToClientVersion -> FilePath
forall a. Show a => a -> FilePath
show ByronNodeToClientVersion
blockVersion