{-# LANGUAGE FlexibleContexts #-}

module Test.ThreadNet.Util.SimpleBlock (prop_validSimpleBlock) where

import Data.Typeable (Typeable)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Mock.Ledger
import Ouroboros.Consensus.Util.Condense (condense)
import Test.QuickCheck

prop_validSimpleBlock ::
  (SimpleCrypto c, Typeable ext, Typeable ext') =>
  SimpleBlock' c ext ext' -> Property
prop_validSimpleBlock :: forall c ext ext'.
(SimpleCrypto c, Typeable ext, Typeable ext') =>
SimpleBlock' c ext ext' -> Property
prop_validSimpleBlock SimpleBlock' c ext ext'
blk = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (Tx -> Property) -> [Tx] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map Tx -> Property
each ([Tx] -> [Property]) -> [Tx] -> [Property]
forall a b. (a -> b) -> a -> b
$ SimpleBody -> [Tx]
simpleTxs (SimpleBody -> [Tx]) -> SimpleBody -> [Tx]
forall a b. (a -> b) -> a -> b
$ SimpleBlock' c ext ext' -> SimpleBody
forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleBody SimpleBlock' c ext ext'
blk
 where
  now :: SlotNo
  now :: SlotNo
now = SimpleBlock' c ext ext' -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot SimpleBlock' c ext ext'
blk

  msg :: String
  msg :: String
msg = String
"block contains expired transaction:"

  each :: Tx -> Property
  each :: Tx -> Property
each tx :: Tx
tx@(Tx Expiry
expiry Set TxIn
_ins [TxOut]
_outs) =
    String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (SlotNo, Tx) -> String
forall a. Condense a => a -> String
condense (SlotNo
now, Tx
tx)) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
      case Expiry
expiry of
        Expiry
DoNotExpire -> Bool
True
        ExpireAtOnsetOf SlotNo
s -> SlotNo
now SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
s