{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Allegra.ScriptsSpec (spec) where

import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..), inInterval)
import Test.Cardano.Base.QuickCheck (testLawsGroup)
import Test.Cardano.Ledger.Allegra.Arbitrary ()
import Test.Cardano.Ledger.Common
import Test.QuickCheck.Classes (
  commutativeMonoidLaws,
  commutativeSemigroupLaws,
  exponentialSemigroupLaws,
  idempotentSemigroupLaws,
  monoidLaws,
  semigroupLaws,
 )

spec :: Spec
spec :: Spec
spec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ValidityInterval" (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
"Semigroup and Monoid laws" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    forall a. [Proxy a -> Laws] -> Spec
testLawsGroup @ValidityInterval
      [ Proxy ValidityInterval -> Laws
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Laws
semigroupLaws
      , Proxy ValidityInterval -> Laws
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Laws
commutativeSemigroupLaws
      , Proxy ValidityInterval -> Laws
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Laws
idempotentSemigroupLaws
      , Proxy ValidityInterval -> Laws
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Laws
exponentialSemigroupLaws
      , Proxy ValidityInterval -> Laws
forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
monoidLaws
      , Proxy ValidityInterval -> Laws
forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
commutativeMonoidLaws
      ]
  -- This is the property `PV4.TxInfoSimplified.ttisValidRange` relies on: a top
  -- transaction is valid exactly at the slots where every sub-transaction in it
  -- is valid. This property is stated again `inInterval`.
  String
-> (ValidityInterval -> ValidityInterval -> SlotNo -> Property)
-> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"<> is the intersection of the two intervals" ((ValidityInterval -> ValidityInterval -> SlotNo -> Property)
 -> Spec)
-> (ValidityInterval -> ValidityInterval -> SlotNo -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$ \ValidityInterval
vi1 ValidityInterval
vi2 SlotNo
slot ->
    SlotNo -> ValidityInterval -> Bool
inInterval SlotNo
slot (ValidityInterval
vi1 ValidityInterval -> ValidityInterval -> ValidityInterval
forall a. Semigroup a => a -> a -> a
<> ValidityInterval
vi2) Bool -> Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (SlotNo -> ValidityInterval -> Bool
inInterval SlotNo
slot ValidityInterval
vi1 Bool -> Bool -> Bool
&& SlotNo -> ValidityInterval -> Bool
inInterval SlotNo
slot ValidityInterval
vi2)