Skip to content

Commit

Permalink
Add property test for categorizeUTxOEntries.
Browse files Browse the repository at this point in the history
We demonstrate that `uncategorize . categorize == id`.

In response to review feedback:

#2618 (comment)
  • Loading branch information
jonathanknowles committed Apr 20, 2021
1 parent 3237ed1 commit 3636188
Showing 1 changed file with 60 additions and 1 deletion.
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
Expand Down Expand Up @@ -26,6 +27,7 @@ import Cardano.Wallet.Primitive.Migration.Selection
import Cardano.Wallet.Primitive.Migration.SelectionSpec
( MockInputId
, MockTxConstraints (..)
, Pretty (..)
, conjoinMap
, counterexampleMap
, genCoinRange
Expand All @@ -51,6 +53,8 @@ import Data.Set
( Set )
import Fmt
( padLeftF, pretty )
import GHC.Generics
( Generic )
import Test.Hspec
( Spec, describe, it )
import Test.Hspec.Core.QuickCheck
Expand All @@ -69,7 +73,9 @@ import Test.QuickCheck
, label
, oneof
, property
, shrinkList
, withMaxSuccess
, (===)
)

import qualified Cardano.Wallet.Primitive.Migration.Selection as Selection
Expand Down Expand Up @@ -99,6 +105,8 @@ spec = describe "Cardano.Wallet.Primitive.Migration.PlanningSpec" $

parallel $ describe "Categorizing UTxO entries" $ do

it "prop_categorizeUTxOEntries" $
property prop_categorizeUTxOEntries
it "prop_categorizeUTxOEntry" $
property prop_categorizeUTxOEntry

Expand Down Expand Up @@ -319,7 +327,58 @@ prop_createPlan mockArgs =
]

--------------------------------------------------------------------------------
-- Categorizing UTxO entries
-- Categorizing multiple UTxO entries
--------------------------------------------------------------------------------

data ArgsForCategorizeUTxOEntries = ArgsForCategorizeUTxOEntries
{ mockConstraints :: MockTxConstraints
, mockEntries :: [(MockInputId, TokenBundle)]
}
deriving (Eq, Generic, Show)

instance Arbitrary ArgsForCategorizeUTxOEntries where
arbitrary = genArgsForCategorizeUTxOEntries
shrink = shrinkArgsForCategorizeUTxOEntries

genArgsForCategorizeUTxOEntries :: Gen ArgsForCategorizeUTxOEntries
genArgsForCategorizeUTxOEntries = do
mockConstraints <- genMockTxConstraints
mockEntryCount <- choose (0, 100)
mockEntries <- replicateM mockEntryCount (genMockInput mockConstraints)
pure ArgsForCategorizeUTxOEntries {mockConstraints, mockEntries}

shrinkArgsForCategorizeUTxOEntries
:: ArgsForCategorizeUTxOEntries -> [ArgsForCategorizeUTxOEntries]
shrinkArgsForCategorizeUTxOEntries args = do
mockEntriesShrunk <- shrinkList shrinkInput (mockEntries args)
pure ArgsForCategorizeUTxOEntries
{ mockConstraints = view #mockConstraints args
, mockEntries = mockEntriesShrunk
}
where
shrinkInput :: (MockInputId, TokenBundle) -> [(MockInputId, TokenBundle)]
shrinkInput (inputId, TokenBundle c m)
| c /= Coin 0, m /= mempty =
[(inputId, TokenBundle c mempty)]
| c /= Coin 0, m == mempty =
[(inputId, TokenBundle (Coin 0) mempty)]
| otherwise =
[]

prop_categorizeUTxOEntries :: Pretty ArgsForCategorizeUTxOEntries -> Property
prop_categorizeUTxOEntries args =
Pretty (L.sortOn fst (uncategorizeUTxOEntries categorizedEntries))
=== Pretty (L.sortOn fst mockEntries)
where
categorizedEntries = categorizeUTxOEntries constraints mockEntries
Pretty ArgsForCategorizeUTxOEntries
{ mockConstraints
, mockEntries
} = args
constraints = unMockTxConstraints mockConstraints

--------------------------------------------------------------------------------
-- Categorizing individual UTxO entries
--------------------------------------------------------------------------------

data ArgsForCategorizeUTxOEntry = ArgsForCategorizeUTxOEntry
Expand Down

0 comments on commit 3636188

Please sign in to comment.