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

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

import Cardano.Prelude
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 =
  TestLimit
-> Gen Certificate
-> (Certificate -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 ((ProtocolMagicId -> Gen Certificate) -> Gen Certificate
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Certificate
genCanonicalCertificate) Certificate -> PropertyT IO ()
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 =
  TestLimit
-> Gen GenesisAvvmBalances
-> (GenesisAvvmBalances -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisAvvmBalances
genGenesisAvvmBalances GenesisAvvmBalances -> PropertyT IO ()
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 =
  TestLimit
-> Gen GenesisData
-> (GenesisData -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 ((ProtocolMagicId -> Gen GenesisData) -> Gen GenesisData
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen GenesisData
genCanonicalGenesisData) GenesisData -> PropertyT IO ()
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 =
  TestLimit
-> Gen GenesisDelegation
-> (GenesisDelegation -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 ((ProtocolMagicId -> Gen GenesisDelegation) -> Gen GenesisDelegation
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen GenesisDelegation
genCanonicalGenesisDelegation) GenesisDelegation -> PropertyT IO ()
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 =
  TestLimit
-> Gen GenesisNonAvvmBalances
-> (GenesisNonAvvmBalances -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances GenesisNonAvvmBalances -> PropertyT IO ()
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 =
  TestLimit
-> Gen GenesisKeyHashes
-> (GenesisKeyHashes -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisKeyHashes
genGenesisKeyHashes GenesisKeyHashes -> PropertyT IO ()
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 =
  TestLimit
-> Gen ProtocolParameters
-> (ProtocolParameters -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ProtocolParameters
genCanonicalProtocolParameters ProtocolParameters -> PropertyT IO ()
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 =
  GenesisData -> FilePath -> Property
forall a.
(Eq a, FromJSON (Either SchemaError) a, HasCallStack, Show a) =>
a -> FilePath -> Property
goldenTestCanonicalJSONDec
    GenesisData
exampleGenesisData0
    FilePath
"golden/json/genesis/GenesisData0_Legacy_HasNetworkMagic"

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

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