{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Genesis.Json (
  tests,
)
where

import Cardano.Prelude
import GetDataFileName ((<:<))
import Hedgehog (Property)
import Test.Cardano.Chain.Delegation.Gen (genCanonicalCertificate)
import Test.Cardano.Chain.Genesis.Example (exampleGenesisData0)
import Test.Cardano.Chain.Genesis.Gen (
  genCanonicalGenesisData,
  genCanonicalGenesisDelegation,
  genGenesisAvvmBalances,
  genGenesisKeyHashes,
  genGenesisNonAvvmBalances,
 )
import Test.Cardano.Chain.Update.Gen (
  genCanonicalProtocolParameters,
 )
import Test.Cardano.Crypto.Gen (feedPM)
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- JSON Canonical Tests
--------------------------------------------------------------------------------

ts_roundTripCanonicalCertificate :: TSProperty
ts_roundTripCanonicalCertificate :: TSProperty
ts_roundTripCanonicalCertificate =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Certificate
genCanonicalCertificate) forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

ts_roundTripCanonicalGenesisAvvmBalances :: TSProperty
ts_roundTripCanonicalGenesisAvvmBalances :: TSProperty
ts_roundTripCanonicalGenesisAvvmBalances =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisAvvmBalances
genGenesisAvvmBalances forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

ts_roundTripCanonicalGenesisData :: TSProperty
ts_roundTripCanonicalGenesisData :: TSProperty
ts_roundTripCanonicalGenesisData =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen GenesisData
genCanonicalGenesisData) forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

ts_roundTripCanonicalGenesisDelegation :: TSProperty
ts_roundTripCanonicalGenesisDelegation :: TSProperty
ts_roundTripCanonicalGenesisDelegation =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen GenesisDelegation
genCanonicalGenesisDelegation) forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

ts_roundTripCanonicalGenesisNonAvvmBalances :: TSProperty
ts_roundTripCanonicalGenesisNonAvvmBalances :: TSProperty
ts_roundTripCanonicalGenesisNonAvvmBalances =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

ts_roundTripCanonicalGenesisKeyHashes :: TSProperty
ts_roundTripCanonicalGenesisKeyHashes :: TSProperty
ts_roundTripCanonicalGenesisKeyHashes =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisKeyHashes
genGenesisKeyHashes forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

ts_roundTripCanonicalProtocolParameters :: TSProperty
ts_roundTripCanonicalProtocolParameters :: TSProperty
ts_roundTripCanonicalProtocolParameters =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ProtocolParameters
genCanonicalProtocolParameters forall a (m :: * -> *).
(Eq a, Show a, MonadTest m, ToJSON Identity a,
 FromJSON (Either SchemaError) a) =>
a -> m ()
roundTripsCanonicalJsonPretty

--------------------------------------------------------------------------------
-- GenesisData (Canonical JSON)
--------------------------------------------------------------------------------

-- Decode-only golden tests for ensuring that, when decoding the legacy
-- `GenesisData` canonical JSON format, the `RequiresNetworkMagic` field
-- defaults to `RequiresMagic`.

golden_GenesisData0Dec :: Property
golden_GenesisData0Dec :: Property
golden_GenesisData0Dec =
  forall a.
(Eq a, FromJSON (Either SchemaError) a, HasCallStack, Show a) =>
a -> FilePath -> Property
goldenTestCanonicalJSONDec
    GenesisData
exampleGenesisData0
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/json/genesis/GenesisData0_Legacy_HasNetworkMagic"

-------------------------------------------------------------------------------
-- Main test export
-------------------------------------------------------------------------------

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [forall a b. a -> b -> a
const $$FilePath
[(PropertyName, Property)]
Property
FilePath -> PropertyName
FilePath -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
discoverGolden, $$discoverPropArg]