Add PlutusLedgerApi QuickCheck instances #6624
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,7 @@ | ||
| ### Removed | ||
|
|
||
| - `Arbitrary` instances from `PlutusLedgerApi.Test.V1.Value` and `PlutusLedgerApi.Test.V3.MintValue`. Import `PlutusLedgerApi.Test.QuickCheck` instead. | ||
|
|
||
| ### Added | ||
|
|
||
| - `PlutusLedgerApi.Test.QuickCheck` module to testlib with quickcheck instances for all ledger types. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,110 @@ | ||
| {-# LANGUAGE BangPatterns #-} | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE DerivingVia #-} | ||
| {-# LANGUAGE KindSignatures #-} | ||
| {-# LANGUAGE PatternSynonyms #-} | ||
| {-# LANGUAGE RoleAnnotations #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE ViewPatterns #-} | ||
|
|
||
| module PlutusLedgerApi.Test.Common.QuickCheck.Utils ( | ||
| SizedByteString (SizedByteString), | ||
| unSizedByteString, | ||
| AsWord64 (AsWord64), | ||
| fromAsWord64, | ||
| ) where | ||
|
|
||
| import Data.ByteString (ByteString) | ||
| import Data.ByteString qualified as BS | ||
| import Data.Coerce (coerce) | ||
| import Data.Proxy (Proxy (Proxy)) | ||
| import Data.Word (Word64) | ||
| import GHC.TypeNats (KnownNat, Nat, natVal) | ||
| import Test.QuickCheck (Arbitrary (arbitrary, shrink), CoArbitrary, Function (function), | ||
| functionMap, vectorOf) | ||
| import Test.QuickCheck.Instances.ByteString () | ||
|
|
||
| {- | Helper for 'ByteString's of a fixed length. We don't expose the | ||
| constructor, instead providing a read-only pattern, as well as an accessor | ||
| function, to ensure that the size invariant is maintained. | ||
| -} | ||
| newtype SizedByteString (n :: Nat) = UnsafeSizedByteString ByteString | ||
| deriving | ||
| (Eq | ||
| ,Ord | ||
| ) | ||
| via ByteString | ||
| deriving stock | ||
| (Show | ||
| ) | ||
|
|
||
| type role SizedByteString nominal | ||
|
|
||
| instance KnownNat n => Arbitrary (SizedByteString n) where | ||
| {-# INLINEABLE arbitrary #-} | ||
| arbitrary = | ||
| UnsafeSizedByteString . BS.pack <$> do | ||
| let !len = fromIntegral . natVal $ Proxy @n | ||
| vectorOf len arbitrary | ||
|
There was a problem hiding this comment.
|
||
| {-# INLINEABLE shrink #-} | ||
| shrink = | ||
| fmap (UnsafeSizedByteString . BS.pack) | ||
| . traverse shrink | ||
| . BS.unpack | ||
| . unSizedByteString | ||
|
|
||
| deriving via ByteString instance CoArbitrary (SizedByteString n) | ||
|
|
||
|
|
||
| instance Function (SizedByteString n) where | ||
| {-# INLINEABLE function #-} | ||
| function = functionMap coerce UnsafeSizedByteString | ||
|
|
||
| {- | Read-only pattern for accessing the underlying 'ByteString'. Use it just | ||
| like you would use a data constructor in a pattern match. | ||
| -} | ||
| pattern SizedByteString :: forall (n :: Nat). ByteString -> SizedByteString n | ||
| pattern SizedByteString bs <- UnsafeSizedByteString bs | ||
|
|
||
| {-# COMPLETE SizedByteString #-} | ||
|
|
||
| {- | Get the underlying 'ByteString'. It is guaranteed to have the length | ||
| specified in its type. | ||
| -} | ||
| unSizedByteString :: | ||
| forall (n :: Nat). | ||
| SizedByteString n -> | ||
| ByteString | ||
| unSizedByteString = coerce | ||
|
|
||
| {- | Plutus' ledger API often has to \'fake\' 'Word64' using the much larger | ||
| 'Integer' type. This helper is designed to generate 'Integer's that fit into | ||
| 'Word64'. | ||
|
|
||
| We don't expose the constructor directly; instead, we provide a read-only | ||
| pattern and an accessor function. | ||
| -} | ||
| newtype AsWord64 = UnsafeAsWord64 Word64 | ||
| deriving | ||
| (Eq | ||
| ,Ord | ||
| ,Arbitrary | ||
| ,CoArbitrary | ||
| ) | ||
| via Word64 | ||
| deriving stock | ||
| (Show | ||
| ) | ||
|
|
||
| instance Function AsWord64 where | ||
| {-# INLINEABLE function #-} | ||
| function = functionMap coerce UnsafeAsWord64 | ||
|
|
||
| {- | Read-only pattern for accessing the underlying 'Integer'. Use it just like | ||
| you would use a data constructor in a pattern match. | ||
| -} | ||
| pattern AsWord64 :: Integer -> AsWord64 | ||
| pattern AsWord64 i <- (fromAsWord64 -> i) | ||
|
|
||
| fromAsWord64 :: AsWord64 -> Integer | ||
| fromAsWord64 = fromIntegral . coerce @_ @Word64 | ||
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Note to self: when we generate
ByteStrings normally we useText.encodeUtf8 <$> arbitrary. Why? Should we do the same here?There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
This guarantees that you get
ByteStrings that are UTF-8 encodings of text, which is probably what you often want. However, in a lot of situations here, we're generating arbitrary hashes, which most certainly do not follow this rule.There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Then we should change this rule in our code in the first place. Thanks!