diff --git a/cardano-ledger/cardano-ledger.cabal b/cardano-ledger/cardano-ledger.cabal index 8e0f1883..59776add 100644 --- a/cardano-ledger/cardano-ledger.cabal +++ b/cardano-ledger/cardano-ledger.cabal @@ -26,7 +26,7 @@ library hs-source-dirs: src exposed-modules: Cardano.Chain.Block - Cardano.Chain.Byron.Auxiliary + Cardano.Chain.Byron.API Cardano.Chain.Common Cardano.Chain.Constants Cardano.Chain.Delegation @@ -179,7 +179,7 @@ test-suite cardano-ledger-test Test.Cardano.Chain.Block.Model.Examples Test.Cardano.Chain.Block.Validation Test.Cardano.Chain.Block.ValidationMode - Test.Cardano.Chain.Byron.Auxiliary + Test.Cardano.Chain.Byron.API Test.Cardano.Chain.Buildable diff --git a/cardano-ledger/src/Cardano/Chain/Byron/Auxiliary.hs b/cardano-ledger/src/Cardano/Chain/Byron/API.hs similarity index 97% rename from cardano-ledger/src/Cardano/Chain/Byron/Auxiliary.hs rename to cardano-ledger/src/Cardano/Chain/Byron/API.hs index 9cee09c8..6feef1db 100644 --- a/cardano-ledger/src/Cardano/Chain/Byron/Auxiliary.hs +++ b/cardano-ledger/src/Cardano/Chain/Byron/API.hs @@ -1,19 +1,19 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} -- | Auxiliary definitions to make working with the Byron ledger easier -module Cardano.Chain.Byron.Auxiliary ( +module Cardano.Chain.Byron.API ( -- * Extract info from genesis config allowedDelegators , boundaryBlockSlot @@ -213,8 +213,7 @@ applyChainTick :: Gen.Config -> CC.ChainValidationState -> CC.ChainValidationState applyChainTick cfg slotNo cvs = cvs { - CC.cvsLastSlot = slotNo - , CC.cvsUpdateState = CC.epochTransition + CC.cvsUpdateState = CC.epochTransition (mkEpochEnvironment cfg cvs) (CC.cvsUpdateState cvs) slotNo @@ -580,7 +579,7 @@ fromCBORABlockOrBoundaryHdr epochSlots = do fromCBOR @Word >>= \case 0 -> ABOBBoundaryHdr <$> CC.fromCBORABoundaryHeader 1 -> ABOBBlockHdr <$> CC.fromCBORAHeader epochSlots - t -> panic $ "Unknown tag in encoded HeaderOrBoundary" <> show t + t -> fail $ "Unknown tag in encoded HeaderOrBoundary" <> show t -- | The analogue of 'Data.Either.either' aBlockOrBoundaryHdr :: (CC.AHeader a -> b) diff --git a/cardano-ledger/src/Cardano/Chain/Delegation/Validation/Interface.hs b/cardano-ledger/src/Cardano/Chain/Delegation/Validation/Interface.hs index 9461ccd9..4970b88e 100644 --- a/cardano-ledger/src/Cardano/Chain/Delegation/Validation/Interface.hs +++ b/cardano-ledger/src/Cardano/Chain/Delegation/Validation/Interface.hs @@ -169,7 +169,7 @@ tickDelegation currentEpoch currentSlot = let ss' = pruneScheduledDelegations currentEpoch currentSlot (schedulingState s) in s{ schedulingState = ss'} --- Activate certificates up to this slot +-- | Activate certificates up to this slot activateDelegations :: SlotNumber -> State -> State activateDelegations currentSlot s@(State ss as) = let Scheduling.State delegations _keyEpochs = ss @@ -177,7 +177,7 @@ activateDelegations currentSlot s@(State ss as) = (Seq.filter ((<= currentSlot) . Scheduling.sdSlot) delegations) in s { activationState = as' } --- Remove stale values from 'Scheduling.State' +-- | Remove stale values from 'Scheduling.State' pruneScheduledDelegations :: EpochNumber -> SlotNumber diff --git a/cardano-ledger/test/Test/Cardano/Chain/Byron/Auxiliary.hs b/cardano-ledger/test/Test/Cardano/Chain/Byron/API.hs similarity index 95% rename from cardano-ledger/test/Test/Cardano/Chain/Byron/Auxiliary.hs rename to cardano-ledger/test/Test/Cardano/Chain/Byron/API.hs index 31d974a6..22c869df 100644 --- a/cardano-ledger/test/Test/Cardano/Chain/Byron/Auxiliary.hs +++ b/cardano-ledger/test/Test/Cardano/Chain/Byron/API.hs @@ -3,7 +3,7 @@ {-# Language RankNTypes #-} -module Test.Cardano.Chain.Byron.Auxiliary +module Test.Cardano.Chain.Byron.API ( genApplyMempoolPayloadErr , ts_roundTripApplyMempoolPayloadErrCompat , ts_scheduledDelegations @@ -12,10 +12,9 @@ module Test.Cardano.Chain.Byron.Auxiliary where import Cardano.Prelude - -- import Test.Cardano.Prelude import Cardano.Crypto (ProtocolMagicId) -import Cardano.Chain.Byron.Auxiliary +import Cardano.Chain.Byron.API ( ApplyMempoolPayloadErr (..) , getDelegationMap , applyChainTick @@ -50,7 +49,7 @@ import Cardano.Chain.Genesis (configSlotSecurityParam) import qualified Cardano.Chain.Genesis as Genesis tests :: TSGroup -tests scenario = Group "Test.Cardano.Chain.Byron.Auxiliary" +tests scenario = Group "Test.Cardano.Chain.Byron.API" [ ( "ts_chainTick", ts_chainTick scenario) , ( "ts_roundTripApplyMempoolPayloadErrCompat", ts_roundTripApplyMempoolPayloadErrCompat scenario) , ( "ts_scheduledDelegations", ts_scheduledDelegations scenario) @@ -87,7 +86,6 @@ setupChainValidationState sampleTrace = -- | getDelegationMap . applyChainTick slot == previewDelegationMap slot ts_scheduledDelegations :: TSProperty - --FIXME: This is a failing test. ts_scheduledDelegations = withTestsTS 100 . property $ do let traceLength = 10 :: Word64 sampleTrace <- forAll $ STS.trace @CHAIN () traceLength diff --git a/cardano-ledger/test/cardano-ledger-test.cabal b/cardano-ledger/test/cardano-ledger-test.cabal index 85f7e2ff..2006d999 100644 --- a/cardano-ledger/test/cardano-ledger-test.cabal +++ b/cardano-ledger/test/cardano-ledger-test.cabal @@ -25,7 +25,7 @@ library Test.Cardano.Chain.Block.Validation Test.Cardano.Chain.Block.ValidationMode - Test.Cardano.Chain.Byron.Auxiliary + Test.Cardano.Chain.Byron.API Test.Cardano.Chain.Buildable diff --git a/cardano-ledger/test/test.hs b/cardano-ledger/test/test.hs index c15fbf3a..a3504694 100644 --- a/cardano-ledger/test/test.hs +++ b/cardano-ledger/test/test.hs @@ -34,7 +34,7 @@ import qualified Test.Cardano.Chain.UTxO.ValidationMode import qualified Test.Cardano.Chain.Update.CBOR import qualified Test.Cardano.Chain.Update.Properties import qualified Test.Cardano.Chain.Elaboration.Delegation -import qualified Test.Cardano.Chain.Byron.Auxiliary +import qualified Test.Cardano.Chain.Byron.API main :: IO () main = @@ -66,5 +66,5 @@ main = , Test.Cardano.Chain.UTxO.ValidationMode.tests , Test.Cardano.Chain.Update.CBOR.tests , Test.Cardano.Chain.Update.Properties.tests - , Test.Cardano.Chain.Byron.Auxiliary.tests + , Test.Cardano.Chain.Byron.API.tests ]