Skip to content

Commit 642bc6d

Browse files
gilligangilligan
committed
Extend haddock docs
Add haddock comments for - AlwaysFailingScripts - AlwaysPassingScripts - Utils
1 parent aab441b commit 642bc6d

File tree

3 files changed

+216
-35
lines changed

3 files changed

+216
-35
lines changed

‎onchain/src/TrustlessSidechain/AlwaysFailingScripts.hs

Lines changed: 72 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,18 @@
11
{-# LANGUAGE TemplateHaskell #-}
22

3+
-- |
4+
-- Module : TrustlessSidechain.AlwaysFailingScripts
5+
-- Description : Always-failing Plutus scripts for integration testing
6+
--
7+
-- This module defines always-failing Plutus validator and minting policy scripts.
8+
-- These are useful for testing scenarios where script validation must fail deliberately.
39
module TrustlessSidechain.AlwaysFailingScripts (
10+
-- * Validator
411
mkAlwaysFailingValidator,
512
mkAlwaysFailingValidatorUntyped,
613
serialisableAlwaysFailingValidator,
14+
15+
-- * MintingPolicy
716
mkAlwaysFailingPolicy,
817
mkAlwaysFailingPolicyUntyped,
918
serialisableAlwaysFailingPolicy,
@@ -16,37 +25,92 @@ import PlutusLedgerApi.V2 (
1625
import PlutusTx qualified
1726
import TrustlessSidechain.PlutusPrelude
1827

19-
-- Always Failing Validator and Always Failing Minting Policy
20-
-- are scripts that unconditionally fail. Such scripts are
21-
-- useful in integration tests.
28+
--------------------------------------------------------------------------------
29+
-- Always-Failing Validator
30+
--------------------------------------------------------------------------------
2231

23-
-- Both scripts are parametrized by an Integer. That allows for
24-
-- obtaining different currency symbols.
32+
-- | A typed validator function that always fails.
33+
--
34+
-- All arguments are ignored. The function always returns False. Intended for testing validation
35+
-- failure paths.
2536
mkAlwaysFailingValidator ::
37+
-- | Arbitrary seed (ignored)
2638
BuiltinData ->
39+
-- | Datum (ignored)
2740
BuiltinData ->
41+
-- | Redeemer (ignored)
2842
BuiltinData ->
43+
-- | Script context (ignored)
2944
BuiltinData ->
45+
-- | Always returns false
3046
Bool
3147
mkAlwaysFailingValidator _ _ _ _ = False
3248

33-
mkAlwaysFailingValidatorUntyped :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
49+
-- | An untyped version of 'mkAlwaysFailingValidator' that conforms to the Plutus
50+
-- script interface.
51+
--
52+
-- This wraps the result in a unit via 'check', which throws an error when given 'False'.
53+
-- Suitable for compilation into on-chain code.
54+
mkAlwaysFailingValidatorUntyped ::
55+
-- | Arbitrary seed/parameter (ignored)
56+
BuiltinData ->
57+
-- | Datum (ignored)
58+
BuiltinData ->
59+
-- | Redeemer (ignored)
60+
BuiltinData ->
61+
-- | Script context (ignored)
62+
BuiltinData ->
63+
-- | Always fails via 'check'
64+
BuiltinUnit
3465
mkAlwaysFailingValidatorUntyped seed datum redeemer ctx =
3566
check $ mkAlwaysFailingValidator seed datum redeemer ctx
3667

68+
-- | A compiled and serialised version of the always-failing validator script.
3769
serialisableAlwaysFailingValidator :: SerialisedScript
3870
serialisableAlwaysFailingValidator =
3971
serialiseCompiledCode $$(PlutusTx.compile [||mkAlwaysFailingValidatorUntyped||])
4072

73+
--------------------------------------------------------------------------------
74+
-- Always-Failing Minting Policy
75+
--------------------------------------------------------------------------------
76+
77+
-- | A typed minting policy function that always fails.
78+
--
79+
-- All arguments (a parameter, redeemer, and script context) are ignored.
80+
-- Always returns 'False', causing the minting policy to fail.
81+
--
82+
-- Useful for testing failure conditions in minting transactions.
4183
{-# INLINEABLE mkAlwaysFailingPolicy #-}
42-
mkAlwaysFailingPolicy :: BuiltinData -> BuiltinData -> BuiltinData -> Bool
84+
mkAlwaysFailingPolicy ::
85+
-- | Arbitrary seed/parameter (ignored)
86+
BuiltinData ->
87+
-- | Redeemer (ignored)
88+
BuiltinData ->
89+
-- | Script context (ignored)
90+
BuiltinData ->
91+
-- | Always returns False
92+
Bool
4393
mkAlwaysFailingPolicy _ _ _ = False
4494

95+
-- | An untyped version of 'mkAlwaysFailingPolicy', suitable for Plutus script compilation.
96+
--
97+
-- Wraps the result with 'check' to throw on 'False'.
4598
{-# INLINEABLE mkAlwaysFailingPolicyUntyped #-}
46-
mkAlwaysFailingPolicyUntyped :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
99+
mkAlwaysFailingPolicyUntyped ::
100+
-- | Arbitrary seed/parameter (ignored)
101+
BuiltinData ->
102+
-- | Redeemer (ignored)
103+
BuiltinData ->
104+
-- | Script context (ignored)
105+
BuiltinData ->
106+
-- | Always fails via 'check'
107+
BuiltinUnit
47108
mkAlwaysFailingPolicyUntyped seed redeemer ctx =
48109
check $ mkAlwaysFailingPolicy seed redeemer ctx
49110

111+
-- | A compiled and serialised version of the always-failing minting policy.
112+
--
113+
-- Useful for producing minting policies in tests where validation is expected to fail.
50114
serialisableAlwaysFailingPolicy :: SerialisedScript
51115
serialisableAlwaysFailingPolicy =
52116
serialiseCompiledCode $$(PlutusTx.compile [||mkAlwaysFailingPolicyUntyped||])

‎onchain/src/TrustlessSidechain/AlwaysPassingScripts.hs

Lines changed: 64 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,18 @@
11
{-# LANGUAGE TemplateHaskell #-}
22

3+
-- |
4+
-- Module : TrustlessSidechain.AlwaysPassingScripts
5+
--
6+
-- This module provides Plutus scripts (validator and minting policy) that always succeed.
7+
-- These scripts are useful for integration testing in mock chains, where validation
8+
-- success needs to be ensured regardless of inputs.
39
module TrustlessSidechain.AlwaysPassingScripts (
10+
-- * Validator
411
mkAlwaysPassingValidator,
512
mkAlwaysPassingValidatorUntyped,
613
serialisableAlwaysPassingValidator,
14+
15+
-- * Minting Policy
716
mkAlwaysPassingPolicy,
817
mkAlwaysPassingPolicyUntyped,
918
serialisableAlwaysPassingPolicy,
@@ -22,21 +31,40 @@ import TrustlessSidechain.PlutusPrelude (
2231
($),
2332
)
2433

25-
-- Always Passing Validator and Always Passing Minting Policy
26-
-- are scripts that unconditionally pass. Such scripts are
27-
-- useful in integration tests.
34+
--------------------------------------------------------------------------------
35+
-- Always-Passing Validator
36+
--------------------------------------------------------------------------------
2837

29-
-- Both scripts are parametrized by an Integer. That allows for
30-
-- obtaining different currency symbols.
38+
-- | A typed validator function that always passes.
39+
--
40+
-- All arguments are ignored. The function always returns 'True'.
3141
mkAlwaysPassingValidator ::
42+
-- | Arbitrary seed/parameter (ignored)
3243
BuiltinData ->
44+
-- | Datum (ignored)
3345
BuiltinData ->
46+
-- | Redeemer (ignored)
3447
BuiltinData ->
48+
-- | Script context (ignored)
3549
BuiltinData ->
50+
-- | Always returns True
3651
Bool
3752
mkAlwaysPassingValidator _ _ _ _ = True
3853

39-
mkAlwaysPassingValidatorUntyped :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
54+
-- | An untyped version of 'mkAlwaysPassingValidator' conforming to the Plutus script interface.
55+
--
56+
-- Wraps the result in 'check', which succeeds when the result is 'True'.
57+
mkAlwaysPassingValidatorUntyped ::
58+
-- | Arbitrary seed/parameter (ignored)
59+
BuiltinData ->
60+
-- | Datum (ignored)
61+
BuiltinData ->
62+
-- | Redeemer (ignored)
63+
BuiltinData ->
64+
-- | Script context (ignored)
65+
BuiltinData ->
66+
-- | Always succeeds
67+
BuiltinUnit
4068
mkAlwaysPassingValidatorUntyped seed datum redeemer ctx =
4169
check
4270
$ mkAlwaysPassingValidator
@@ -45,23 +73,51 @@ mkAlwaysPassingValidatorUntyped seed datum redeemer ctx =
4573
redeemer
4674
ctx
4775

76+
-- | A serialised version of the always-passing validator script.
4877
serialisableAlwaysPassingValidator :: SerialisedScript
4978
serialisableAlwaysPassingValidator =
5079
serialiseCompiledCode $$(PlutusTx.compile [||mkAlwaysPassingValidatorUntyped||])
5180

81+
--------------------------------------------------------------------------------
82+
-- Always-Passing Minting Policy
83+
--------------------------------------------------------------------------------
84+
85+
-- | A typed minting policy that always allows minting.
86+
--
87+
-- All arguments are ignored. The policy always returns 'True'.
5288
{-# INLINEABLE mkAlwaysPassingPolicy #-}
53-
mkAlwaysPassingPolicy :: BuiltinData -> BuiltinData -> BuiltinData -> Bool
89+
mkAlwaysPassingPolicy ::
90+
-- | Arbitrary seed/parameter (ignored)
91+
BuiltinData ->
92+
-- | Redeemer (ignored)
93+
BuiltinData ->
94+
-- | Script context (ignored)
95+
BuiltinData ->
96+
-- | Always returns True
97+
Bool
5498
mkAlwaysPassingPolicy _ _ _ = True
5599

100+
-- | An untyped version of 'mkAlwaysPassingPolicy', suitable for Plutus compilation.
101+
--
102+
-- Wraps the result in 'check', which passes when the result is 'True'.
56103
{-# INLINEABLE mkAlwaysPassingPolicyUntyped #-}
57-
mkAlwaysPassingPolicyUntyped :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
104+
mkAlwaysPassingPolicyUntyped ::
105+
-- | Arbitrary seed/parameter (ignored)
106+
BuiltinData ->
107+
-- | Redeemer (ignored)
108+
BuiltinData ->
109+
-- | Script context (ignored)
110+
BuiltinData ->
111+
-- | Always succeeds
112+
BuiltinUnit
58113
mkAlwaysPassingPolicyUntyped seed redeemer ctx =
59114
check
60115
$ mkAlwaysPassingPolicy
61116
seed
62117
redeemer
63118
ctx
64119

120+
-- | A serialised version of the always-passing minting policy.
65121
serialisableAlwaysPassingPolicy :: SerialisedScript
66122
serialisableAlwaysPassingPolicy =
67123
serialiseCompiledCode $$(PlutusTx.compile [||mkAlwaysPassingPolicyUntyped||])

‎onchain/src/TrustlessSidechain/Utils.hs

Lines changed: 80 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
11
{-# OPTIONS_GHC -fno-specialise #-}
22

3+
-- |
4+
-- Module : TrustlessSidechain.Utils
5+
-- Description : Utility functions for Plutus scripts and test logic
6+
--
7+
-- This module provides utility functions for working with Plutus data structures.
38
module TrustlessSidechain.Utils (
49
fromSingleton,
510
fromSingletonData,
@@ -30,59 +35,115 @@ import PlutusLedgerApi.V2 (
3035
import PlutusTx.AssocMap qualified as Map
3136
import PlutusTx.Data.List qualified as List
3237

33-
-- | Unwrap a singleton list, or produce an error if not possible.
38+
-- | Unwrap a singleton list, or fail with a custom error.
39+
fromSingleton ::
40+
-- | Error message used if the list is not a singleton.
41+
BuiltinString ->
42+
-- | Input list
43+
[a] ->
44+
-- | The only element in the list (or error)
45+
a
3446
{-# INLINEABLE fromSingleton #-}
35-
fromSingleton :: BuiltinString -> [a] -> a
3647
fromSingleton _ [x] = x
3748
fromSingleton msg _ = traceError msg
3849

39-
-- | Unwrap a singleton list, or produce an error if not possible.
50+
-- | Unwrap a singleton Plutus list, or fail with a custom error.
51+
fromSingletonData ::
52+
(UnsafeFromData a) =>
53+
-- \| Error message used if the list is not a singleton.
54+
BuiltinString ->
55+
-- | Plutus list
56+
List.List a ->
57+
-- | The only element in the list (or error)
58+
a
4059
{-# INLINEABLE fromSingletonData #-}
41-
fromSingletonData :: (UnsafeFromData a) => BuiltinString -> List.List a -> a
4260
fromSingletonData msg list = case List.uncons list of
4361
Just (x, rest) | List.null rest -> x
4462
_ -> traceError msg
4563

46-
-- | Unwrap a Just ctor, or produce an error if not possible.
64+
-- | Unwrap a 'Maybe' value, or fail with a custom error.
65+
fromJust ::
66+
-- | Error message used if the value is 'Nothing'
67+
BuiltinString ->
68+
-- | Input optional value
69+
Maybe a ->
70+
-- | The contained value (or error)
71+
a
4772
{-# INLINEABLE fromJust #-}
48-
fromJust :: forall a. BuiltinString -> Maybe a -> a
4973
fromJust err m =
5074
case m of
5175
Just d -> d
5276
Nothing -> traceError err
5377

54-
-- | Get amount of given currency in a value, ignoring token names.
78+
-- | Get the total amount of a given currency symbol in a value, ignoring token names.
79+
currencySymbolValueOf ::
80+
-- | Value to inspect
81+
Value ->
82+
-- | Currency symbol to extract total quantity for
83+
CurrencySymbol ->
84+
-- | Total quantity of that currency symbol
85+
Integer
5586
{-# INLINEABLE currencySymbolValueOf #-}
56-
currencySymbolValueOf :: Value -> CurrencySymbol -> Integer
5787
currencySymbolValueOf v c = maybe 0 sum $ Map.lookup c $ getValue v
5888

59-
-- | Check that exactly on specified asset was minted by a transaction. Note
60-
-- that transaction is also allowed to mint/burn tokens of the same
61-
-- 'CurrencySymbol', but with different 'TokenName's.
89+
-- | Check that exactly one token of the specified currency and token name was minted.
90+
oneTokenMinted ::
91+
-- | Transaction info
92+
DataV2.TxInfo ->
93+
-- | Currency symbol
94+
DataV1.CurrencySymbol ->
95+
-- | Token name
96+
DataV1.TokenName ->
97+
-- | True if exactly one token was minted
98+
Bool
6299
{-# INLINEABLE oneTokenMinted #-}
63-
oneTokenMinted :: DataV2.TxInfo -> DataV1.CurrencySymbol -> DataV1.TokenName -> Bool
64100
oneTokenMinted txInfo cs tn =
65101
DataV1.valueOf (DataV2.txInfoMint txInfo) cs tn == 1
66102

67-
-- | Check that exactly one specified asset was burned by a transaction. Note
68-
-- that transaction is also allowed to burn tokens of the same 'CurrencySymbol',
69-
-- but with different 'TokenName's.
103+
-- | Check that exactly one token of the specified currency and token name was burned.
104+
oneTokenBurned ::
105+
-- | The 'txInfoMint' field of the transaction, treated as a 'Value'
106+
Value ->
107+
-- | Currency symbol
108+
CurrencySymbol ->
109+
-- | Token name
110+
TokenName ->
111+
-- | True if exactly one token was burned
112+
Bool
70113
{-# INLINEABLE oneTokenBurned #-}
71-
oneTokenBurned :: Value -> CurrencySymbol -> TokenName -> Bool
72114
oneTokenBurned txInfoMint cs tn =
73115
valueOf txInfoMint cs tn == -1
74116

75-
scriptToPlutusScript :: SerialisedScript -> PlutusScript PlutusScriptV2
117+
-- | Convert a serialized Plutus script to a 'PlutusScript' suitable for submission via the Cardano API.
118+
scriptToPlutusScript ::
119+
-- | Serialized script (from 'PlutusTx.compile')
120+
SerialisedScript ->
121+
-- | Wrapped script for use in transactions
122+
PlutusScript PlutusScriptV2
76123
scriptToPlutusScript =
77124
PlutusScriptSerialised @PlutusScriptV2
78125

126+
-- | Get all outputs that pay to the specified address.
127+
getOutputsAt ::
128+
-- | Transaction info
129+
DataV2.TxInfo ->
130+
-- | Address to filter for
131+
DataV2.Address ->
132+
-- | Outputs paying to that address
133+
List.List DataV2.TxOut
79134
{-# INLINEABLE getOutputsAt #-}
80-
getOutputsAt :: DataV2.TxInfo -> DataV2.Address -> List.List DataV2.TxOut
81135
getOutputsAt txInfo address =
82136
((== address) . DataV2.txOutAddress) `List.filter` DataV2.txInfoOutputs txInfo
83137

138+
-- | Get all resolved inputs that come from the specified address.
139+
getInputsAt ::
140+
-- | Transaction info
141+
DataV2.TxInfo ->
142+
-- | Address to filter for
143+
DataV2.Address ->
144+
-- | Inputs that were spent from that address
145+
List.List DataV2.TxOut
84146
{-# INLINEABLE getInputsAt #-}
85-
getInputsAt :: DataV2.TxInfo -> DataV2.Address -> List.List DataV2.TxOut
86147
getInputsAt txInfo address =
87148
DataV2.txInInfoResolved
88149
`List.map` List.filter ((== address) . DataV2.txOutAddress . DataV2.txInInfoResolved) (DataV2.txInfoInputs txInfo)

0 commit comments

Comments
 (0)