tests

input-output-hk · Jan 27, 2022 · d3e97dc · d3e97dc
1 parent 70e9b86
commit d3e97dc
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 13 deletions.
diff --git a/marlowe/src/Language/Marlowe/Client.hs b/marlowe/src/Language/Marlowe/Client.hs
@@ -46,9 +46,9 @@ import Language.Marlowe.Semantics
 import qualified Language.Marlowe.Semantics as Marlowe
 import Language.Marlowe.SemanticsTypes hiding (Contract, getAction)
 import qualified Language.Marlowe.SemanticsTypes as Marlowe
-import Language.Marlowe.Util (extractNonMerkleizedContractRoles, merkleizedInput)
+import Language.Marlowe.Util (extractNonMerkleizedContractRoles)
 import Ledger (CurrencySymbol, Datum (..), PaymentPubKeyHash (..), PubKeyHash, Slot (..), TokenName, TxOut (..),
-               TxOutRef, inScripts, txOutValue)
+               TxOutRef, dataHash, inScripts, txOutValue)
 import qualified Ledger
 import Ledger.Ada (adaSymbol, adaToken, adaValueOf, lovelaceValueOf)
 import Ledger.Address (pubKeyHashAddress, scriptHashAddress)
@@ -701,13 +701,18 @@ mkStep params typedValidator slotInterval@(minSlot, maxSlot) input = do
         Just (onChainState, utxo) -> do
             let OnChainState{ocsTxOut=TypedScriptTxOut{tyTxOutData=currentState}, ocsTxOutRef} = onChainState
             let MarloweData{..} = currentState
-            let asdf (ClientInput i)             = NormalInput i
-                asdf (ClientMerkleizedInput i c) = merkleizedInput i c
+
+            let asdf :: MarloweClientInput -> ([Input], TxConstraints Void Void)
+                asdf (ClientInput i)             = ([NormalInput i], mempty)
+                asdf (ClientMerkleizedInput input continuation) = let
+                        builtin = PlutusTx.toBuiltinData continuation
+                        hash = dataHash builtin
+                        in ([MerkleizedInput input hash continuation], singleton (MustIncludeDatum (Datum builtin)))
 
             let inputToTxInput (NormalInput i)         = Input i
                 inputToTxInput (MerkleizedInput i h _) = MerkleizedTxInput i h
 
-            let inputs = fmap asdf input
+            let (inputs, datumConstraints) = foldMap asdf input
             let redeemerInputs = fmap inputToTxInput inputs
             let txInput = TransactionInput {
                     txInterval = slotInterval,
@@ -728,12 +733,12 @@ mkStep params typedValidator slotInterval@(minSlot, maxSlot) input = do
                                     outputsConstraints = payoutConstraints payoutsByParty
                                     totalIncome = P.foldMap (collectDeposits . getInputContent) inputs
                                     totalPayouts = P.foldMap snd payoutsByParty
-                                    inputBalance = totalBalance (accounts txOutState)
+                                    inputBalance = totalBalance (accounts marloweState)
                                     finalBalance = inputBalance P.+ totalIncome P.- totalPayouts
                                     in (outputsConstraints, finalBalance)
 
                     let inputsConstraints = validateInputs params inputs
-                    let newConstraints = inputsConstraints <> outputsConstraints <> mustValidateIn times
+                    let newConstraints = datumConstraints <> inputsConstraints <> outputsConstraints <> mustValidateIn times
                     let isFinal = isClose txOutContract
                         lookups1 =
                             Constraints.typedValidatorLookups typedValidator

diff --git a/marlowe/src/Language/Marlowe/Util.hs b/marlowe/src/Language/Marlowe/Util.hs
@@ -121,8 +121,3 @@ merkleizedCase :: Action -> Contract -> Case Contract
 merkleizedCase action continuation = let
     hash = dataHash (PlutusTx.toBuiltinData continuation)
     in MerkleizedCase action hash
-
-merkleizedInput :: InputContent -> Contract -> Input
-merkleizedInput input continuation = let
-    hash = dataHash (PlutusTx.toBuiltinData continuation)
-    in MerkleizedInput input hash continuation
diff --git a/marlowe/test/Spec/Marlowe/Marlowe.hs b/marlowe/test/Spec/Marlowe/Marlowe.hs
@@ -344,7 +344,7 @@ typedValidatorSize :: IO ()
 typedValidatorSize = do
     let validator = Scripts.validatorScript $ smallTypedValidator defaultMarloweParams
     let vsize = SBS.length. SBS.toShort . LB.toStrict $ Serialise.serialise validator
-    assertBool ("smallTypedValidator is too large " <> show vsize) (vsize < 16000)
+    assertBool ("smallTypedValidator is too large " <> show vsize) (vsize < 17200)
 
 untypedValidatorSize :: IO ()
 untypedValidatorSize = do