{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.BaseTypesSpec (spec) where

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Either
import Data.GenValidity (GenValid (genValid))
import Data.GenValidity.Scientific ()
import Data.Scientific
import Data.Typeable
import Test.Cardano.Ledger.Binary.RoundTrip (roundTripCborExpectation)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()

boundedRationalTests ::
  forall a.
  ( BoundedRational a
  , ToJSON a
  , FromJSON a
  , EncCBOR a
  , DecCBOR a
  , Arbitrary a
  , GenValid a
  , Show a
  , Ord a
  ) =>
  [(String, ByteString)] ->
  Spec
boundedRationalTests :: forall a.
(BoundedRational a, ToJSON a, FromJSON a, EncCBOR a, DecCBOR a,
 Arbitrary a, GenValid a, Show a, Ord a) =>
[(String, ByteString)] -> Spec
boundedRationalTests [(String, ByteString)]
badJSONValues = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (TypeRep -> ShowS
showsTypeRep (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) String
"") forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Rational roundtrip" forall a b. (a -> b) -> a -> b
$ do
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"(boundRational . unboundRational)" forall a b. (a -> b) -> a -> b
$ \(a
bi :: a) ->
        forall a. a -> Maybe a
Just a
bi forall a. (Eq a, Show a) => a -> a -> Property
=== forall r. BoundedRational r => Rational -> Maybe r
boundRational (forall r. BoundedRational r => r -> Rational
unboundRational a
bi)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"(unboundRational . boundRational)" forall a b. (a -> b) -> a -> b
$
        forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll forall a. GenValid a => Gen a
genValid forall a b. (a -> b) -> a -> b
$ \Rational
r ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (forall prop. Testable prop => prop -> Property
property Bool
True)
            ((Rational
r forall a. (Eq a, Show a) => a -> a -> Property
===) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => r -> Rational
unboundRational)
            (forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
r :: Maybe a)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"bounding produces valid values within bounds" forall a b. (a -> b) -> a -> b
$
        forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll forall a. GenValid a => Gen a
genValid forall a b. (a -> b) -> a -> b
$ \Rational
r ->
          case forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
r of
            Maybe a
Nothing -> forall prop. Testable prop => prop -> Property
property Bool
True
            Just (a
br :: a) ->
              forall prop. Testable prop => [prop] -> Property
conjoin
                [ forall a. Bounded a => a
minBound forall a. Ord a => a -> a -> Bool
<= a
br
                , a
br forall a. Ord a => a -> a -> Bool
<= forall a. Bounded a => a
maxBound
                , forall r. BoundedRational r => r -> Rational
unboundRational (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Rational
r
                , Rational
r forall a. Ord a => a -> a -> Bool
<= forall r. BoundedRational r => r -> Rational
unboundRational (forall a. Bounded a => a
maxBound :: a)
                ]
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"JSON" forall a b. (a -> b) -> a -> b
$ do
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"ToJSON/FromJSON roundtrip" forall a b. (a -> b) -> a -> b
$
        forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll forall a. GenValid a => Gen a
genValid forall a b. (a -> b) -> a -> b
$ \(a
br :: a) ->
          forall prop. Testable prop => Int -> prop -> Property
within Int
500000 forall a b. (a -> b) -> a -> b
$
            case ByteString -> Either String a
boundedFromJSON (forall a. ToJSON a => a -> ByteString
encode a
br) of
              Left String
err -> forall a. HasCallStack => String -> a
error String
err
              Right (a
br' :: a) -> forall r. BoundedRational r => r -> Rational
unboundRational a
br forall a. (Eq a, Show a) => a -> a -> Property
=== forall r. BoundedRational r => r -> Rational
unboundRational a
br'
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Roundtrip from valid Scientific and back exactly" forall a b. (a -> b) -> a -> b
$
        forall prop. Testable prop => Int -> prop -> Property
within Int
500000 forall a b. (a -> b) -> a -> b
$
          forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll forall a. GenValid a => Gen a
genValid forall a b. (a -> b) -> a -> b
$ \(Scientific
s :: Scientific) ->
            case ByteString -> Either String a
boundedFromJSON (forall a. ToJSON a => a -> ByteString
encode Scientific
s) of
              Right (a
ui :: a) -> Scientific
s forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. Fractional a => Rational -> a
fromRational (forall r. BoundedRational r => r -> Rational
unboundRational a
ui)
              Left String
_ -> forall prop. Testable prop => prop -> Property
property Bool
True
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Bad Values" forall a b. (a -> b) -> a -> b
$ do
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Check divergence" forall a b. (a -> b) -> a -> b
$
          forall prop. Testable prop => Int -> prop -> Property
within Int
500000 forall a b. (a -> b) -> a -> b
$
            ByteString -> Either String a
boundedFromJSON ByteString
"10e1234567893456" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall a b. Either a b -> Bool
isLeft
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, ByteString)]
badJSONValues forall a b. (a -> b) -> a -> b
$ \(String
testName, ByteString
invalidInput) ->
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
testName forall a b. (a -> b) -> a -> b
$
            ByteString -> Either String a
boundedFromJSON ByteString
invalidInput forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall a b. Either a b -> Bool
isLeft
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"CBOR roundtrip" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll forall a. GenValid a => Gen a
genValid forall a b. (a -> b) -> a -> b
$
        \(a
br :: a) -> forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation a
br
  where
    boundedFromJSON :: ByteString -> Either String a
boundedFromJSON = forall a. FromJSON a => ByteString -> Either String a
eitherDecode :: ByteString -> Either String a

spec :: Spec
spec :: Spec
spec = do
  let badJSONValues :: [(String, ByteString)]
badJSONValues =
        [(String
"Word64 denominator overflow", ByteString
"3.14159265358979323e-7"), (String
"Negative value", ByteString
"-1e-3")]
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"BoundedRational" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(BoundedRational a, ToJSON a, FromJSON a, EncCBOR a, DecCBOR a,
 Arbitrary a, GenValid a, Show a, Ord a) =>
[(String, ByteString)] -> Spec
boundedRationalTests @UnitInterval forall a b. (a -> b) -> a -> b
$ [(String, ByteString)]
badJSONValues forall a. [a] -> [a] -> [a]
++ [(String
"Too big", ByteString
"1.01")]
    forall a.
(BoundedRational a, ToJSON a, FromJSON a, EncCBOR a, DecCBOR a,
 Arbitrary a, GenValid a, Show a, Ord a) =>
[(String, ByteString)] -> Spec
boundedRationalTests @PositiveUnitInterval forall a b. (a -> b) -> a -> b
$
      [(String, ByteString)]
badJSONValues forall a. [a] -> [a] -> [a]
++ [(String
"Zero", ByteString
"0"), (String
"Too big", ByteString
"1.01")]
    forall a.
(BoundedRational a, ToJSON a, FromJSON a, EncCBOR a, DecCBOR a,
 Arbitrary a, GenValid a, Show a, Ord a) =>
[(String, ByteString)] -> Spec
boundedRationalTests @PositiveInterval forall a b. (a -> b) -> a -> b
$ [(String, ByteString)]
badJSONValues forall a. [a] -> [a] -> [a]
++ [(String
"Zero", ByteString
"0")]
    forall a.
(BoundedRational a, ToJSON a, FromJSON a, EncCBOR a, DecCBOR a,
 Arbitrary a, GenValid a, Show a, Ord a) =>
[(String, ByteString)] -> Spec
boundedRationalTests @NonNegativeInterval [(String, ByteString)]
badJSONValues