{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Shelley.Serialisation.Tripping.JSON (
  tests,
) where

import Cardano.Ledger.Address (Addr)
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Keys (GenDelegPair (..), KeyHash, KeyRole (Genesis))
import Cardano.Ledger.Shelley.API.Types (ShelleyGenesis)
import Data.Aeson (FromJSON, ToJSON (toJSON), decode, encode, fromJSON)
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.QuickCheck (Property, (.&&.), (===))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

propRoundTripJSON :: (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON :: forall a. (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON a
a =
  (Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a) Result a -> Result a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a -> Result a
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
a) Maybe a -> Maybe a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Shelley Genesis"
    [ TestName -> (ShelleyGenesis -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Genesis roundtrip" ((ShelleyGenesis -> Property) -> TestTree)
-> (ShelleyGenesis -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a. (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON @ShelleyGenesis
    , TestName -> (Coin -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Coin roundtrip" ((Coin -> Property) -> TestTree) -> (Coin -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a. (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON @Coin
    , TestName -> (Addr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Address roundtrip" ((Addr -> Property) -> TestTree) -> (Addr -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a. (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON @Addr
    , TestName -> (KeyHash 'Genesis -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Genesis KeyHash " ((KeyHash 'Genesis -> Property) -> TestTree)
-> (KeyHash 'Genesis -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a. (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON @(KeyHash 'Genesis)
    , TestName -> (GenDelegPair -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"GenDelegPair roundtrip" ((GenDelegPair -> Property) -> TestTree)
-> (GenDelegPair -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a. (ToJSON a, FromJSON a, Show a, Eq a) => a -> Property
propRoundTripJSON @GenDelegPair
    ]