{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Chain.Common.Lovelace (
  tests,
)
where

import Cardano.Chain.Common (
  LovelaceError (..),
  addLovelace,
  integerToLovelace,
  maxLovelaceVal,
  mkKnownLovelace,
  mkLovelace,
  scaleLovelace,
  subLovelace,
  unsafeGetLovelace,
 )
import Cardano.Prelude
import Data.Data (Constr, toConstr)
import Formatting (build, sformat)
import Hedgehog (Property, discover, forAll, property, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Common.Gen (genCustomLovelace, genLovelace)
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, withTestsTS)

ts_prop_addLovelace :: TSProperty
ts_prop_addLovelace :: TSProperty
ts_prop_addLovelace = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  Lovelace
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Lovelace
genLovelace
  let newRange :: Word64
newRange = Word64
maxLovelaceVal forall a. Num a => a -> a -> a
- Lovelace -> Word64
unsafeGetLovelace Lovelace
a
  Lovelace
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ Word64 -> Gen Lovelace
genCustomLovelace Word64
newRange
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace Lovelace
a Lovelace
b

prop_addLovelaceOverflow :: Property
prop_addLovelaceOverflow :: Property
prop_addLovelaceOverflow =
  HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr
      Constr
dummyLovelaceOverflow
      (Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace (forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @1) forall a. Bounded a => a
maxBound)

ts_prop_integerToLovelace :: TSProperty
ts_prop_integerToLovelace :: TSProperty
ts_prop_integerToLovelace = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  Integer
testInt <-
    forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
maxLovelaceVal :: Integer))
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ Integer -> Either LovelaceError Lovelace
integerToLovelace Integer
testInt

prop_integerToLovelaceTooLarge :: Property
prop_integerToLovelaceTooLarge :: Property
prop_integerToLovelaceTooLarge =
  HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr
      Constr
dummyLovelaceTooLarge
      (Integer -> Either LovelaceError Lovelace
integerToLovelace (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
maxLovelaceVal forall a. Num a => a -> a -> a
+ Word64
1) :: Integer))

prop_integerToLovelaceTooSmall :: Property
prop_integerToLovelaceTooSmall :: Property
prop_integerToLovelaceTooSmall =
  HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummyLovelaceTooSmall (Integer -> Either LovelaceError Lovelace
integerToLovelace (forall a. Num a => a -> a
negate Integer
1))

prop_maxLovelaceUnchanged :: Property
prop_maxLovelaceUnchanged :: Property
prop_maxLovelaceUnchanged =
  HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
maxLovelaceVal :: Integer) forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Integer
45e15

ts_prop_mkLovelace :: TSProperty
ts_prop_mkLovelace :: TSProperty
ts_prop_mkLovelace = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  Word64
testWrd <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> Range a
Range.linear Word64
0 Word64
maxLovelaceVal)
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ Word64 -> Either LovelaceError Lovelace
mkLovelace Word64
testWrd

prop_mkLovelaceTooLarge :: Property
prop_mkLovelaceTooLarge :: Property
prop_mkLovelaceTooLarge =
  HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummyLovelaceTooLarge (Word64 -> Either LovelaceError Lovelace
mkLovelace (Word64
maxLovelaceVal forall a. Num a => a -> a -> a
+ Word64
1))

prop_scaleLovelaceTooLarge :: Property
prop_scaleLovelaceTooLarge :: Property
prop_scaleLovelaceTooLarge =
  HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr
      Constr
dummyLovelaceTooLarge
      (forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace forall a. Bounded a => a
maxBound (Integer
2 :: Integer))

ts_prop_subLovelace :: TSProperty
ts_prop_subLovelace :: TSProperty
ts_prop_subLovelace = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  Lovelace
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Lovelace
genLovelace
  Lovelace
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ Word64 -> Gen Lovelace
genCustomLovelace (Lovelace -> Word64
unsafeGetLovelace Lovelace
a)
  forall a (m :: * -> *) b.
(Buildable a, HasCallStack, MonadTest m) =>
Either a b -> m ()
assertIsRight forall a b. (a -> b) -> a -> b
$ Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace Lovelace
a Lovelace
b

ts_prop_subLovelaceUnderflow :: TSProperty
ts_prop_subLovelaceUnderflow :: TSProperty
ts_prop_subLovelaceUnderflow =
  TestLimit -> Property -> TSProperty
withTestsTS TestLimit
1000
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ do
      -- (maxLovelaveVal - 1) to avoid an overflow error in `addLovelace`
      -- in case expression
      Lovelace
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ Word64 -> Gen Lovelace
genCustomLovelace (Word64
maxLovelaceVal forall a. Num a => a -> a -> a
- Word64
1)
      case Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace Lovelace
a (forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @1) of
        Right Lovelace
added ->
          forall b a (m :: * -> *).
(Buildable b, Data a, HasCallStack, MonadTest m) =>
Constr -> Either a b -> m ()
assertIsLeftConstr Constr
dummyLovelaceUnderflow (Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace Lovelace
a Lovelace
added)
        Left LovelaceError
err ->
          forall a. HasCallStack => Text -> a
panic
            forall a b. (a -> b) -> a -> b
$ forall a. Format Text a -> a
sformat
              (Format (LovelaceError -> Text) (LovelaceError -> Text)
"The impossible happened in subLovelaceUnderflow: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build)
              LovelaceError
err

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [forall a b. a -> b -> a
const $$String
[(PropertyName, Property)]
Property
String -> PropertyName
String -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
prop_scaleLovelaceTooLarge :: Property
prop_mkLovelaceTooLarge :: Property
prop_maxLovelaceUnchanged :: Property
prop_integerToLovelaceTooSmall :: Property
prop_integerToLovelaceTooLarge :: Property
prop_addLovelaceOverflow :: Property
discover, $$discoverPropArg]

--------------------------------------------------------------------------------
-- Dummy values for constructor comparison in assertIsLeftConstr tests
--------------------------------------------------------------------------------

dummyLovelaceOverflow :: Constr
dummyLovelaceOverflow :: Constr
dummyLovelaceOverflow = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Word64 -> LovelaceError
LovelaceOverflow Word64
1

dummyLovelaceTooLarge :: Constr
dummyLovelaceTooLarge :: Constr
dummyLovelaceTooLarge = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Integer -> LovelaceError
LovelaceTooLarge Integer
1

dummyLovelaceTooSmall :: Constr
dummyLovelaceTooSmall :: Constr
dummyLovelaceTooSmall = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Integer -> LovelaceError
LovelaceTooSmall Integer
1

dummyLovelaceUnderflow :: Constr
dummyLovelaceUnderflow :: Constr
dummyLovelaceUnderflow = forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> LovelaceError
LovelaceUnderflow Word64
1 Word64
1