{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Cardano.Ledger.Conway.Proposals where import Cardano.Ledger.Conway import Cardano.Ledger.Conway.Governance import Control.DeepSeq (force) import Control.Exception (AssertionFailed (..), evaluate) import Data.Either (isRight) import Data.Foldable as F (foldl', toList) import qualified Data.Map.Strict as Map import Data.MapExtras (fromElems) import Data.Maybe (fromMaybe) import Data.Sequence (fromList) import qualified Data.Sequence as Seq import qualified Data.Sequence.Strict as SSeq import qualified Data.Set as Set import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Conway.Arbitrary ( ProposalsForEnactment (..), ProposalsNewActions (..), ) spec :: Spec spec :: Spec spec = do forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Proposals" forall a b. (a -> b) -> a -> b $ do forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Construction" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Adding new nodes keeps Proposals consistent" forall a b. (a -> b) -> a -> b $ \(ProposalsNewActions Proposals Conway ps [GovActionState Conway] actions :: ProposalsNewActions Conway) -> let ps' :: Proposals Conway ps' = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b F.foldl' (\Proposals Conway p GovActionState Conway action -> forall a. a -> Maybe a -> a fromMaybe (forall a. HasCallStack => String -> a error String "Unable to add action") forall a b. (a -> b) -> a -> b $ forall era. (EraPParams era, HasCallStack) => GovActionState era -> Proposals era -> Maybe (Proposals era) proposalsAddAction GovActionState Conway action Proposals Conway p) Proposals Conway ps [GovActionState Conway] actions actionsMap :: Map (GovActionId StandardCrypto) (GovActionState Conway) actionsMap = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b F.foldl' (\Map (GovActionId StandardCrypto) (GovActionState Conway) accum GovActionState Conway gas -> forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert (forall era. GovActionState era -> GovActionId (EraCrypto era) gasId GovActionState Conway gas) GovActionState Conway gas Map (GovActionId StandardCrypto) (GovActionState Conway) accum) forall k a. Map k a Map.empty [GovActionState Conway] actions in Map (GovActionId StandardCrypto) (GovActionState Conway) actionsMap forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` (Map (GovActionId StandardCrypto) (GovActionState Conway) actionsMap forall k a b. Ord k => Map k a -> Map k b -> Map k a `Map.intersection` forall era. Proposals era -> Map (GovActionId (EraCrypto era)) (GovActionState era) proposalsActionsMap Proposals Conway ps') forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Removal" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Removing leaf nodes keeps Proposals consistent" forall a b. (a -> b) -> a -> b $ \(Proposals Conway ps :: Proposals Conway) -> do let gais :: Set (GovActionId StandardCrypto) gais = forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> [a] toList forall a b. (a -> b) -> a -> b $ forall a. Int -> StrictSeq a -> StrictSeq a SSeq.takeLast Int 4 forall a b. (a -> b) -> a -> b $ forall era. Proposals era -> StrictSeq (GovActionId (EraCrypto era)) proposalsIds Proposals Conway ps ps' :: Proposals Conway ps' = forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall era. EraPParams era => Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsRemoveWithDescendants Set (GovActionId StandardCrypto) gais Proposals Conway ps forall era. Proposals era -> Int proposalsSize Proposals Conway ps' forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall era. Proposals era -> Int proposalsSize Proposals Conway ps forall a. Num a => a -> a -> a - forall a. Set a -> Int Set.size Set (GovActionId StandardCrypto) gais forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Removing root nodes keeps Proposals consistent" forall a b. (a -> b) -> a -> b $ \(Proposals Conway ps :: Proposals Conway) -> do let gais :: Set (GovActionId StandardCrypto) gais = forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> [a] toList forall a b. (a -> b) -> a -> b $ forall a. Int -> StrictSeq a -> StrictSeq a SSeq.take Int 4 forall a b. (a -> b) -> a -> b $ forall era. Proposals era -> StrictSeq (GovActionId (EraCrypto era)) proposalsIds Proposals Conway ps ps' :: Proposals Conway ps' = forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall era. EraPParams era => Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsRemoveWithDescendants Set (GovActionId StandardCrypto) gais Proposals Conway ps forall era. Proposals era -> Int proposalsSize Proposals Conway ps' forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation `shouldSatisfy` (forall a. Ord a => a -> a -> Bool <= forall era. Proposals era -> Int proposalsSize Proposals Conway ps) forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Removing non-member nodes throws an AssertionFailure" forall a b. (a -> b) -> a -> b $ \(ProposalsNewActions Proposals Conway ps [GovActionState Conway] actions :: ProposalsNewActions Conway) -> (forall a. a -> IO a evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. NFData a => a -> a force) (forall era. EraPParams era => Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsRemoveWithDescendants (forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b $ forall era. GovActionState era -> GovActionId (EraCrypto era) gasId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [GovActionState Conway] actions) Proposals Conway ps) forall e a. (HasCallStack, Exception e) => IO a -> Selector e -> Expectation `shouldThrow` \AssertionFailed {} -> Bool True forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Enactment" forall a b. (a -> b) -> a -> b $ do forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Adding votes preserves consistency" forall a b. (a -> b) -> a -> b $ \( ProposalsForEnactment {Proposals Conway pfeProposals :: forall era. ProposalsForEnactment era -> Proposals era pfeProposals :: Proposals Conway pfeProposals, Seq (GovActionState Conway) pfeToEnact :: forall era. ProposalsForEnactment era -> Seq (GovActionState era) pfeToEnact :: Seq (GovActionState Conway) pfeToEnact} :: ProposalsForEnactment Conway , Voter StandardCrypto voter :: Voter era , Vote vote :: Vote ) -> do case Seq (GovActionState Conway) pfeToEnact of GovActionState Conway gas Seq.:<| Seq (GovActionState Conway) _gass -> forall a b. Either a b -> Bool isRight forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Era era => Proposals era -> Either String (GovRelation TreeMaybe era) toGovRelationTreeEither forall a b. (a -> b) -> a -> b $ forall era. Voter (EraCrypto era) -> Vote -> GovActionId (EraCrypto era) -> Proposals era -> Proposals era proposalsAddVote Voter StandardCrypto voter Vote vote (forall era. GovActionState era -> GovActionId (EraCrypto era) gasId GovActionState Conway gas) Proposals Conway pfeProposals Seq (GovActionState Conway) _ -> Bool True forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Enacting exhaustive lineages reduces Proposals to their roots" forall a b. (a -> b) -> a -> b $ \( ProposalsForEnactment {Proposals Conway pfeProposals :: Proposals Conway pfeProposals :: forall era. ProposalsForEnactment era -> Proposals era pfeProposals, Seq (GovActionState Conway) pfeToEnact :: Seq (GovActionState Conway) pfeToEnact :: forall era. ProposalsForEnactment era -> Seq (GovActionState era) pfeToEnact, Set (GovActionId (EraCrypto Conway)) pfeToRemove :: forall era. ProposalsForEnactment era -> Set (GovActionId (EraCrypto era)) pfeToRemove :: Set (GovActionId (EraCrypto Conway)) pfeToRemove, Set (GovActionId (EraCrypto Conway)) pfeToRetain :: forall era. ProposalsForEnactment era -> Set (GovActionId (EraCrypto era)) pfeToRetain :: Set (GovActionId (EraCrypto Conway)) pfeToRetain} :: ProposalsForEnactment Conway ) -> do let (Proposals Conway ps', Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) enacted, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) removedDueToEnactment, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) expiredRemoved) = forall era. EraPParams era => Seq (GovActionState era) -> Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsApplyEnactment Seq (GovActionState Conway) pfeToEnact forall a. Set a Set.empty Proposals Conway pfeProposals Map (GovActionId StandardCrypto) (GovActionState Conway) expiredRemoved forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation `shouldSatisfy` forall k a. Map k a -> Bool Map.null Map (GovActionId StandardCrypto) (GovActionState Conway) enacted forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall (f :: * -> *) k v. (Foldable f, Ord k) => (v -> k) -> f v -> Map k v fromElems forall era. GovActionState era -> GovActionId (EraCrypto era) gasId Seq (GovActionState Conway) pfeToEnact forall k a. Map k a -> Set k Map.keysSet Map (GovActionId StandardCrypto) (GovActionState Conway) removedDueToEnactment forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` Set (GovActionId (EraCrypto Conway)) pfeToRemove forall era. Proposals era -> Int proposalsSize Proposals Conway ps' forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a. Set a -> Int Set.size Set (GovActionId (EraCrypto Conway)) pfeToRetain forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Enacting non-member nodes throws an AssertionFailure" forall a b. (a -> b) -> a -> b $ \(ProposalsNewActions Proposals Conway ps [GovActionState Conway] actions :: ProposalsNewActions Conway) -> (forall a. a -> IO a evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. NFData a => a -> a force) (forall era. EraPParams era => Seq (GovActionState era) -> Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsApplyEnactment (forall a. [a] -> Seq a fromList [GovActionState Conway] actions) forall a. Set a Set.empty Proposals Conway ps) forall e a. (HasCallStack, Exception e) => IO a -> Selector e -> Expectation `shouldThrow` \AssertionFailed {} -> Bool True forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Expiring compliments of exhaustive lineages keeps proposals consistent" forall a b. (a -> b) -> a -> b $ \( ProposalsForEnactment {Proposals Conway pfeProposals :: Proposals Conway pfeProposals :: forall era. ProposalsForEnactment era -> Proposals era pfeProposals, Seq (GovActionState Conway) pfeToEnact :: Seq (GovActionState Conway) pfeToEnact :: forall era. ProposalsForEnactment era -> Seq (GovActionState era) pfeToEnact, Set (GovActionId (EraCrypto Conway)) pfeToRemove :: Set (GovActionId (EraCrypto Conway)) pfeToRemove :: forall era. ProposalsForEnactment era -> Set (GovActionId (EraCrypto era)) pfeToRemove, Set (GovActionId (EraCrypto Conway)) pfeToRetain :: Set (GovActionId (EraCrypto Conway)) pfeToRetain :: forall era. ProposalsForEnactment era -> Set (GovActionId (EraCrypto era)) pfeToRetain} :: ProposalsForEnactment Conway ) -> do let (Proposals Conway ps', Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) enacted, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) removedDueToEnactment, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) expiredRemoved) = forall era. EraPParams era => Seq (GovActionState era) -> Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsApplyEnactment forall a. Seq a Seq.Empty Set (GovActionId (EraCrypto Conway)) pfeToRemove Proposals Conway pfeProposals Map (GovActionId StandardCrypto) (GovActionState Conway) enacted forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a. Monoid a => a mempty Map (GovActionId StandardCrypto) (GovActionState Conway) removedDueToEnactment forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a. Monoid a => a mempty forall k a. Map k a -> Set k Map.keysSet Map (GovActionId StandardCrypto) (GovActionState Conway) expiredRemoved forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` Set (GovActionId (EraCrypto Conway)) pfeToRemove Proposals Conway ps' forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a b. (a, b) -> a fst (forall era. EraPParams era => Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsRemoveWithDescendants Set (GovActionId (EraCrypto Conway)) pfeToRemove Proposals Conway pfeProposals) let enactMap :: Map (GovActionId StandardCrypto) (GovActionState Conway) enactMap = forall (f :: * -> *) k v. (Foldable f, Ord k) => (v -> k) -> f v -> Map k v fromElems forall era. GovActionState era -> GovActionId (EraCrypto era) gasId Seq (GovActionState Conway) pfeToEnact let (Proposals Conway emptyProposals, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) enactedMap) = forall era. EraPParams era => Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsRemoveWithDescendants (forall k a. Map k a -> Set k Map.keysSet Map (GovActionId StandardCrypto) (GovActionState Conway) enactMap) Proposals Conway ps' forall era. Proposals era -> Int proposalsSize Proposals Conway emptyProposals forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a. Set a -> Int Set.size Set (GovActionId (EraCrypto Conway)) pfeToRetain Map (GovActionId StandardCrypto) (GovActionState Conway) enactedMap forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` Map (GovActionId StandardCrypto) (GovActionState Conway) enactMap forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Expiring non-member nodes throws an AssertionFailure" forall a b. (a -> b) -> a -> b $ \(ProposalsNewActions Proposals Conway ps [GovActionState Conway] actions :: ProposalsNewActions Conway) -> (forall a. a -> IO a evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. NFData a => a -> a force) (forall era. EraPParams era => Seq (GovActionState era) -> Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsApplyEnactment forall a. Seq a Seq.Empty (forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b $ forall era. GovActionState era -> GovActionId (EraCrypto era) gasId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [GovActionState Conway] actions) Proposals Conway ps) forall e a. (HasCallStack, Exception e) => IO a -> Selector e -> Expectation `shouldThrow` \AssertionFailed {} -> Bool True forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Enacting and expiring conflicting proposals does not lead to removal due to enactment" forall a b. (a -> b) -> a -> b $ \( ProposalsForEnactment {Proposals Conway pfeProposals :: Proposals Conway pfeProposals :: forall era. ProposalsForEnactment era -> Proposals era pfeProposals, Seq (GovActionState Conway) pfeToEnact :: Seq (GovActionState Conway) pfeToEnact :: forall era. ProposalsForEnactment era -> Seq (GovActionState era) pfeToEnact, Set (GovActionId (EraCrypto Conway)) pfeToRemove :: Set (GovActionId (EraCrypto Conway)) pfeToRemove :: forall era. ProposalsForEnactment era -> Set (GovActionId (EraCrypto era)) pfeToRemove, Set (GovActionId (EraCrypto Conway)) pfeToRetain :: Set (GovActionId (EraCrypto Conway)) pfeToRetain :: forall era. ProposalsForEnactment era -> Set (GovActionId (EraCrypto era)) pfeToRetain} :: ProposalsForEnactment Conway ) -> do let (Proposals Conway ps', Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) enacted, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) enactedRemoved, Map (GovActionId (EraCrypto Conway)) (GovActionState Conway) expiredRemoved) = forall era. EraPParams era => Seq (GovActionState era) -> Set (GovActionId (EraCrypto era)) -> Proposals era -> (Proposals era, Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era), Map (GovActionId (EraCrypto era)) (GovActionState era)) proposalsApplyEnactment Seq (GovActionState Conway) pfeToEnact Set (GovActionId (EraCrypto Conway)) pfeToRemove Proposals Conway pfeProposals forall k a. Map k a -> Set k Map.keysSet Map (GovActionId StandardCrypto) (GovActionState Conway) expiredRemoved forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` Set (GovActionId (EraCrypto Conway)) pfeToRemove Map (GovActionId StandardCrypto) (GovActionState Conway) enactedRemoved forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a. Monoid a => a mempty Map (GovActionId StandardCrypto) (GovActionState Conway) enacted forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall (f :: * -> *) k v. (Foldable f, Ord k) => (v -> k) -> f v -> Map k v fromElems forall era. GovActionState era -> GovActionId (EraCrypto era) gasId Seq (GovActionState Conway) pfeToEnact forall era. Proposals era -> Int proposalsSize Proposals Conway ps' forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` forall a. Set a -> Int Set.size Set (GovActionId (EraCrypto Conway)) pfeToRetain