{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Cardano.Ledger.Core.JSON (
roundTripJsonSpec,
roundTripJsonEraSpec,
roundTripJsonProperty,
goldenJsonPParamsSpec,
goldenJsonPParamsUpdateSpec,
) where
import Cardano.Ledger.Core
import Data.Aeson (FromJSON, ToJSON, eitherDecode, eitherDecodeFileStrict, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as BSL
import Data.Function ((&))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable (Proxy (..), Typeable, typeRep)
import GHC.Stack
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Era (EraTest)
roundTripJsonSpec ::
forall t.
(HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t, Arbitrary t) =>
Spec
roundTripJsonSpec :: forall t.
(HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t,
Arbitrary t) =>
Spec
roundTripJsonSpec =
String -> (t -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> TypeRep) -> Proxy t -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t)) ((t -> Property) -> Spec) -> (t -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall t.
(HasCallStack, Show t, Eq t, ToJSON t, FromJSON t) =>
t -> Property
roundTripJsonProperty @t
roundTripJsonProperty ::
forall t.
(HasCallStack, Show t, Eq t, ToJSON t, FromJSON t) =>
t ->
Property
roundTripJsonProperty :: forall t.
(HasCallStack, Show t, Eq t, ToJSON t, FromJSON t) =>
t -> Property
roundTripJsonProperty t
original = do
let encoded :: ByteString
encoded = t -> ByteString
forall a. ToJSON a => a -> ByteString
encode t
original
encodedString :: String
encodedString =
String
"Encoded: \n " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BSL.toStrict (t -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty t
original)))
case ByteString -> Either String t
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
encoded of
Left String
err ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Failed decoding: \n " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
encodedString)
Right t
result ->
Expectation -> Property
forall prop. Testable prop => prop -> Property
property (t
result t -> t -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` t
original)
Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
encodedString
roundTripJsonEraSpec ::
forall era.
( HasCallStack
, EraTest era
) =>
Spec
roundTripJsonEraSpec :: forall era. (HasCallStack, EraTest era) => Spec
roundTripJsonEraSpec =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall era. Era era => String
eraName @era) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip JSON" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
forall t.
(HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t,
Arbitrary t) =>
Spec
roundTripJsonSpec @(PParams era)
forall t.
(HasCallStack, Typeable t, Show t, Eq t, ToJSON t, FromJSON t,
Arbitrary t) =>
Spec
roundTripJsonSpec @(TranslationContext era)
goldenJsonPParamsSpec ::
forall era.
EraPParams era =>
SpecWith FilePath
goldenJsonPParamsSpec :: forall era. EraPParams era => SpecWith String
goldenJsonPParamsSpec =
String
-> (String -> Expectation)
-> SpecWith (Arg (String -> Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Golden JSON specs for PParams " ((String -> Expectation) -> SpecWith (Arg (String -> Expectation)))
-> (String -> Expectation)
-> SpecWith (Arg (String -> Expectation))
forall a b. (a -> b) -> a -> b
$ \String
file -> do
Either String (PParams era)
decoded <- forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict @(PParams era) String
file
IO (PParams era) -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (PParams era) -> Expectation)
-> IO (PParams era) -> Expectation
forall a b. (a -> b) -> a -> b
$ Either String (PParams era) -> IO (PParams era)
forall a b. (HasCallStack, ToExpr a) => Either a b -> IO b
expectRightExpr Either String (PParams era)
decoded
goldenJsonPParamsUpdateSpec ::
forall era.
EraTest era =>
SpecWith FilePath
goldenJsonPParamsUpdateSpec :: forall era. EraTest era => SpecWith String
goldenJsonPParamsUpdateSpec =
String
-> (String -> Expectation)
-> SpecWith (Arg (String -> Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Golden JSON specs for PParamsUpdate" ((String -> Expectation) -> SpecWith (Arg (String -> Expectation)))
-> (String -> Expectation)
-> SpecWith (Arg (String -> Expectation))
forall a b. (a -> b) -> a -> b
$ \String
file -> do
let ppu :: PParamsUpdate era
ppu = Int -> Int -> Gen (PParamsUpdate era) -> PParamsUpdate era
forall a. Int -> Int -> Gen a -> a
runGen Int
100 Int
100 (forall a. Arbitrary a => Gen a
arbitrary @(PParamsUpdate era))
let encoded :: Text
encoded = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty PParamsUpdate era
ppu
Text
fileContent <- ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BSL.readFile String
file
Text
encoded Text -> Text -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Text
fileContent