Skip to content

Commit

Permalink
rewrite with checkstate
Browse files Browse the repository at this point in the history
  • Loading branch information
carbolymer committed Jan 25, 2024
1 parent 279ab5a commit e035f0a
Show file tree
Hide file tree
Showing 2 changed files with 31 additions and 26 deletions.
6 changes: 3 additions & 3 deletions cardano-testnet/cardano-testnet.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -36,14 +36,13 @@ library
, bytestring
, cardano-api ^>= 8.37.1.0
, cardano-cli ^>= 8.19.0.0
, cardano-git-rev
, cardano-crypto-class
, cardano-crypto-wrapper
, cardano-ledger-alonzo
, cardano-ledger-byron
, cardano-ledger-conway
, cardano-ledger-core
, cardano-git-rev
, cardano-ledger-core
, cardano-ledger-byron
, cardano-ledger-shelley
, cardano-node
, cardano-ping ^>= 0.2.0.10
Expand Down Expand Up @@ -193,6 +192,7 @@ test-suite cardano-testnet-test
, cardano-cli
, cardano-crypto-class
, cardano-ledger-conway
, cardano-ledger-shelley
, cardano-testnet
, containers
, directory
Expand Down
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
Expand All @@ -8,26 +7,28 @@ module Cardano.Testnet.Test.FoldBlocks where

import Cardano.Api hiding (cardanoEra)
import qualified Cardano.Api as Api
import Cardano.Api.Ledger (Coin (..))
import qualified Cardano.Api.Ledger as Api
import qualified Cardano.Api.Shelley as Api

import qualified Cardano.Ledger.Shelley.API as L
import qualified Cardano.Ledger.Shelley.LedgerState as L
import Cardano.Testnet as TN

import Prelude

import qualified Control.Concurrent as IO
import Control.Concurrent.Async (async, link)
import Control.Exception (Exception, throw)
import Control.Monad
import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.State.Strict
import qualified Data.Text as TS
import qualified System.Directory as IO
import System.FilePath ((</>))

import GHC.IO (unsafePerformIO)
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H
import qualified Hedgehog.Extras.Test as H

import Lens.Micro.Extras (view)
import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as L
import Prelude
import qualified System.Directory as IO
import System.FilePath ((</>))
import qualified Testnet.Property.Utils as H
import Testnet.Runtime

Expand Down Expand Up @@ -110,24 +111,28 @@ prop_foldBlocks_check_if_treasury_is_growing = H.integrationRetryWorkspace 0 "f

H.threadDelay 1_000_000

-- Start foldBlocks in a separate thread
i <- H.nothingFailM . H.leftFailM . runExceptT $ H.timeout 10_000_000 $ Api.foldBlocks (File configFile) (Api.File socketPathAbs) Api.QuickValidation 0 (handler eventsLog)
if i > 0
then H.success
else H.failure
i <- H.nothingFailM . H.leftFailM . runExceptT $ H.timeout 10_000_000 $
Api.checkLedgerStateCondition (File configFile) (Api.File socketPathAbs) Api.QuickValidation 1_000 [] handler
H.failure
-- if i > 0
-- then H.success
-- else H.failure
where
handler :: FilePath -> Env -> LedgerState -> [Api.LedgerEvent] -> BlockInMode -> Int -> IO (Int, FoldStatus)
handler df _env ledgerState ledgerEvents _blockInCardanoMode _nununu = do
let LedgerState{L.shelleyLedgerState} = ledgerState
appendFile df "#### BLOCK\n"
appendFile df $ show ledgerState <> "\n"
appendFile df $ unlines $ map show ledgerEvents
-- pure (0, ContinueFold)
pure (0, StopFold)
handler :: AnyNewEpochState -> State [Integer] LedgerStateCondition
handler (AnyNewEpochState _ newEpochState) = do
let (Coin coin) = view (L.nesEsL . L.esAccountStateL . L.asTreasuryL) newEpochState
-- put amounts in reverse order in state
amounts <- state $ dup . (coin:)
if checkGrowing amounts && length amounts == 3
then pure ConditionMet
else pure ConditionNotMet

checkGrowing :: (Ord a) => [a] -> Bool
checkGrowing = \case
[] -> True
[_] -> True
(x:y:xs) -> x <= y && checkGrowing (y:xs)
(x:y:xs) -> x >= y && checkGrowing (y:xs)

dup :: a -> (a, a)
dup a = (a, a)

0 comments on commit e035f0a

Please sign in to comment.