fix compilation errors

2022-08-03 20:59:37 +08:00 · 2022-08-03 20:59:37 +08:00 · 33e4ed037e
commit 33e4ed037e
parent caae87d564
36 changed files with 1325 additions and 1271 deletions
--- a/agora-specs/Property/Generator.hs
+++ b/agora-specs/Property/Generator.hs
@ -114,8 +114,10 @@ genInput = do
  val <- genSingletonValue
  return $
    input $
-      credential cred
-        . withValue val
+      mconcat
+        [ credential cred
+        , withValue val
+        ]

 genOutput :: Builder a => Gen a
 genOutput = do
@ -123,8 +125,10 @@ genOutput = do
  val <- genSingletonValue
  return $
    output $
-      credential cred
-        . withValue val
+      mconcat
+        [ credential cred
+        , withValue val
+        ]

 genOutRef :: Gen TxOutRef
 genOutRef = do
--- a/agora-specs/Property/Governor.hs
+++ b/agora-specs/Property/Governor.hs
@ -157,7 +157,13 @@ governorMintingProperty =
    -}
    gst = assetClassValue govAssetClass 1
    mintAmount x = mint . mconcat $ replicate x gst
-    outputToGov = output $ script govValidatorHash . withValue gst . withDatum govDatum
+    outputToGov =
+      output $
+        mconcat
+          [ script govValidatorHash
+          , withValue gst
+          , withDatum govDatum
+          ]
    referencedInput = input $ withOutRef gstUTXORef

    govDatum :: GovernorDatum
--- a/agora-specs/Sample/Effect/GovernorMutation.hs
+++ b/agora-specs/Sample/Effect/GovernorMutation.hs
@ -51,7 +51,7 @@ import Test.Util (datumPair, toDatumHash)

 -- | The effect validator instance.
 effectValidator :: Validator
-effectValidator = mkValidator $ mutateGovernorValidator governor
+effectValidator = mkValidator def $ mutateGovernorValidator governor

 -- | The hash of the validator instance.
 effectValidatorHash :: ValidatorHash
--- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs
+++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs
@ -23,6 +23,7 @@ import Agora.Effect.TreasuryWithdrawal (
  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
  treasuryWithdrawalValidator,
 )
+import Data.Default (def)
 import Plutarch.Api.V1 (mkValidator, validatorHash)
 import PlutusLedgerApi.V1 (
  Address (Address),
@ -147,7 +148,7 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs

 -- | Effect validator instance.
 validator :: Validator
-validator = mkValidator $ treasuryWithdrawalValidator currSymbol
+validator = mkValidator def $ treasuryWithdrawalValidator currSymbol

 -- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator.
 validatorHashTN :: TokenName
--- a/agora-specs/Sample/Governor/Initialize.hs
+++ b/agora-specs/Sample/Governor/Initialize.hs
@ -114,7 +114,7 @@ govValidatorHash :: ValidatorHash
 govValidatorHash = governorValidatorHash governor

 govPolicy :: MintingPolicy
-govPolicy = mkMintingPolicy (governorPolicy governor)
+govPolicy = mkMintingPolicy def (governorPolicy governor)

 govSymbol :: CurrencySymbol
 govSymbol = mintingPolicySymbol govPolicy
@ -169,12 +169,16 @@ mintGST ps = builder
        then
          mconcat
            [ input $
-                pubKey witnessPubKey
-                  . withValue witnessValue
-                  . withOutRef witnessRef
+                mconcat
+                  [ pubKey witnessPubKey
+                  , withValue witnessValue
+                  , withOutRef witnessRef
+                  ]
            , output $
-                pubKey witnessPubKey
-                  . withValue witnessValue
+                mconcat
+                  [ pubKey witnessPubKey
+                  , withValue witnessValue
+                  ]
            ]
        else mempty

@ -184,11 +188,13 @@ mintGST ps = builder
      let datum =
            if ps.withGovernorDatum
              then withDatum governorOutputDatum
-              else id
+              else mempty
       in output $
-            script govValidatorHash
-              . withValue governorValue
-              . datum
+            mconcat
+              [ script govValidatorHash
+              , withValue governorValue
+              , datum
+              ]
    --
    builder =
      mconcat
--- a/agora-specs/Sample/Governor/Mutate.hs
+++ b/agora-specs/Sample/Governor/Mutate.hs
@ -49,7 +49,7 @@ import Sample.Shared (
  minAda,
 )
 import Test.Specification (SpecificationTree, testValidator)
-import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes, withOptional)
+import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes)

 --------------------------------------------------------------------------------

@ -142,18 +142,22 @@ mkGovernorBuilder ps =
          then pubKey $ head pubKeyHashes
          else script govValidatorHash
      withGSTDatum =
-        withOptional withDatum $
+        maybe mempty withDatum $
          mkGovernorOutputDatum ps.governorOutputDatumValidity
   in mconcat
        [ input $
-            script govValidatorHash
-              . withDatum governorInputDatum
-              . withValue value
-              . withOutRef governorRef
+            mconcat
+              [ script govValidatorHash
+              , withDatum governorInputDatum
+              , withValue value
+              , withOutRef governorRef
+              ]
        , output $
-            gstOutput
-              . withGSTDatum
-              . withValue value
+            mconcat
+              [ gstOutput
+              , withGSTDatum
+              , withValue value
+              ]
        ]

 --------------------------------------------------------------------------------
@ -162,7 +166,7 @@ mockEffectValidator :: ClosedTerm PValidator
 mockEffectValidator = noOpValidator authorityTokenSymbol

 mockEffectValidatorHash :: ValidatorHash
-mockEffectValidatorHash = validatorHash $ mkValidator mockEffectValidator
+mockEffectValidatorHash = validatorHash $ mkValidator def mockEffectValidator

 mkGATValue :: GATValidity -> Integer -> Value
 mkGATValue NoGAT _ = mempty
@ -187,11 +191,15 @@ mkMockEffectBuilder ps =
   in mconcat
        [ mint burnt
        , input $
-            script mockEffectValidatorHash
-              . withValue inputValue
+            mconcat
+              [ script mockEffectValidatorHash
+              , withValue inputValue
+              ]
        , output $
-            script mockEffectValidatorHash
-              . withValue outputValue
+            mconcat
+              [ script mockEffectValidatorHash
+              , withValue outputValue
+              ]
        ]

 --------------------------------------------------------------------------------
--- a/agora-specs/Sample/Proposal/Advance.hs
+++ b/agora-specs/Sample/Proposal/Advance.hs
@ -321,14 +321,18 @@ mkProposalBuilder ps =
      value = sortValue $ minAda <> pst
   in mconcat
        [ input $
-            script proposalValidatorHash
-              . withOutRef proposalRef
-              . withDatum (mkProposalInputDatum ps)
-              . withValue value
+            mconcat
+              [ script proposalValidatorHash
+              , withOutRef proposalRef
+              , withDatum (mkProposalInputDatum ps)
+              , withValue value
+              ]
        , output $
-            script proposalValidatorHash
-              . withDatum (mkProposalOutputDatum ps)
-              . withValue value
+            mconcat
+              [ script proposalValidatorHash
+              , withDatum (mkProposalOutputDatum ps)
+              , withValue value
+              ]
        ]

 {- | The proposal redeemer used to spend the proposal UTXO, which is always
@ -400,14 +404,18 @@ mkStakeBuilder ps =
         in mconcat
              [ withSig
              , input $
-                  script stakeValidatorHash
-                    . withOutRef (mkStakeRef idx)
-                    . withValue perStakeValue
-                    . withDatum i
+                  mconcat
+                    [ script stakeValidatorHash
+                    , withOutRef (mkStakeRef idx)
+                    , withValue perStakeValue
+                    , withDatum i
+                    ]
              , output $
-                  script stakeValidatorHash
-                    . withValue perStakeValue
-                    . withDatum o
+                  mconcat
+                    [ script stakeValidatorHash
+                    , withValue perStakeValue
+                    , withDatum o
+                    ]
              ]
   in mconcat $
        zipWith3
@ -457,15 +465,19 @@ mkGovernorBuilder ps =
      value = sortValue $ gst <> minAda
   in mconcat
        [ input $
-            script govValidatorHash
-              . withValue value
-              . withOutRef governorRef
-              . withDatum governorInputDatum
+            mconcat
+              [ script govValidatorHash
+              , withValue value
+              , withOutRef governorRef
+              , withDatum governorInputDatum
+              ]
        , output $
-            script govValidatorHash
-              . withValue value
-              . withOutRef governorRef
-              . withDatum (mkGovernorOutputDatum ps)
+            mconcat
+              [ script govValidatorHash
+              , withValue value
+              , withOutRef governorRef
+              , withDatum (mkGovernorOutputDatum ps)
+              ]
        ]

 {- | The proposal redeemer used to spend the governor UTXO, which is always
@ -501,9 +513,11 @@ mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) =
       in mconcat
            [ mint minted
            , output $
-                script vh
-                  . maybe id withDatum mdt
-                  . withValue value
+                mconcat
+                  [ script vh
+                  , maybe mempty withDatum mdt
+                  , withValue value
+                  ]
            ]

 -- | The redeemer used while running the authority token policy.
--- a/agora-specs/Sample/Proposal/Cosign.hs
+++ b/agora-specs/Sample/Proposal/Cosign.hs
@ -162,15 +162,19 @@ cosign ps = builder
                    else stakeDatum
             in mconcat
                  [ input $
-                      script stakeValidatorHash
-                        . withValue stakeValue
-                        . withDatum stakeDatum
-                        . withTxId stakeTxRef
-                        . withOutRef (mkStakeRef refIdx)
+                      mconcat
+                        [ script stakeValidatorHash
+                        , withValue stakeValue
+                        , withDatum stakeDatum
+                        , withTxId stakeTxRef
+                        , withOutRef (mkStakeRef refIdx)
+                        ]
                  , output $
-                      script stakeValidatorHash
-                        . withValue stakeValue
-                        . withDatum stakeOutputDatum
+                      mconcat
+                        [ script stakeValidatorHash
+                        , withValue stakeValue
+                        , withDatum stakeOutputDatum
+                        ]
                  , signedWith stakeDatum.owner
                  ]
        )
@ -189,15 +193,19 @@ cosign ps = builder
    proposalBuilder =
      mconcat
        [ input $
-            script proposalValidatorHash
-              . withValue pst
-              . withDatum proposalInputDatum
-              . withTxId proposalTxRef
-              . withOutRef proposalRef
+            mconcat
+              [ script proposalValidatorHash
+              , withValue pst
+              , withDatum proposalInputDatum
+              , withTxId proposalTxRef
+              , withOutRef proposalRef
+              ]
        , output $
-            script proposalValidatorHash
-              . withValue (sortValue (pst <> minAda))
-              . withDatum proposalOutputDatum
+            mconcat
+              [ script proposalValidatorHash
+              , withValue (sortValue (pst <> minAda))
+              , withDatum proposalOutputDatum
+              ]
        ]

    validTimeRange :: POSIXTimeRange
--- a/agora-specs/Sample/Proposal/Create.hs
+++ b/agora-specs/Sample/Proposal/Create.hs
@ -302,29 +302,39 @@ createProposal ps = builder
        , ---
          timeRange $ mkTimeRange ps
        , input $
-            script govValidatorHash
-              . withValue governorValue
-              . withDatum governorInputDatum
-              . withOutRef governorRef
+            mconcat
+              [ script govValidatorHash
+              , withValue governorValue
+              , withDatum governorInputDatum
+              , withOutRef governorRef
+              ]
        , output $
-            script govValidatorHash
-              . withValue governorValue
-              . withDatum (mkGovernorOutputDatum ps)
+            mconcat
+              [ script govValidatorHash
+              , withValue governorValue
+              , withDatum (mkGovernorOutputDatum ps)
+              ]
        , ---
          input $
-            script stakeValidatorHash
-              . withValue stakeValue
-              . withDatum (mkStakeInputDatum ps)
-              . withOutRef stakeRef
+            mconcat
+              [ script stakeValidatorHash
+              , withValue stakeValue
+              , withDatum (mkStakeInputDatum ps)
+              , withOutRef stakeRef
+              ]
        , output $
-            script stakeValidatorHash
-              . withValue stakeValue
-              . withDatum (mkStakeOutputDatum ps)
+            mconcat
+              [ script stakeValidatorHash
+              , withValue stakeValue
+              , withDatum (mkStakeOutputDatum ps)
+              ]
        , ---
          output $
-            script proposalValidatorHash
-              . withValue proposalValue
-              . withDatum (mkProposalOutputDatum ps)
+            mconcat
+              [ script proposalValidatorHash
+              , withValue proposalValue
+              , withDatum (mkProposalOutputDatum ps)
+              ]
        ]

 --------------------------------------------------------------------------------
--- a/agora-specs/Sample/Proposal/UnlockStake.hs
+++ b/agora-specs/Sample/Proposal/UnlockStake.hs
@ -257,14 +257,18 @@ unlockStake ps =
          ( \((i, o), idx) ->
              mconcat
                [ input $
-                    script proposalValidatorHash
-                      . withValue pst
-                      . withDatum i
-                      . withOutRef (mkProposalRef idx)
+                    mconcat
+                      [ script proposalValidatorHash
+                      , withValue pst
+                      , withDatum i
+                      , withOutRef (mkProposalRef idx)
+                      ]
                , output $
-                    script proposalValidatorHash
-                      . withValue (sortValue $ pst <> minAda)
-                      . withDatum o
+                    mconcat
+                      [ script proposalValidatorHash
+                      , withValue (sortValue $ pst <> minAda)
+                      , withDatum o
+                      ]
                ]
          )
          (zip pIODatums [0 ..])
@ -285,14 +289,18 @@ unlockStake ps =
      stakes =
        mconcat
          [ input $
-              script stakeValidatorHash
-                . withValue stakeValue
-                . withDatum sInDatum
-                . withOutRef stakeRef
+              mconcat
+                [ script stakeValidatorHash
+                , withValue stakeValue
+                , withDatum sInDatum
+                , withOutRef stakeRef
+                ]
          , output $
-              script stakeValidatorHash
-                . withValue stakeValue
-                . withDatum sOutDatum
+              mconcat
+                [ script stakeValidatorHash
+                , withValue stakeValue
+                , withDatum sOutDatum
+                ]
          ]

      builder =
--- a/agora-specs/Sample/Proposal/Vote.hs
+++ b/agora-specs/Sample/Proposal/Vote.hs
@ -219,23 +219,31 @@ vote params =
          , signedWith signer
          , timeRange validTimeRange
          , input $
-              script proposalValidatorHash
-                . withValue pst
-                . withDatum proposalInputDatum
-                . withOutRef proposalRef
+              mconcat
+                [ script proposalValidatorHash
+                , withValue pst
+                , withDatum proposalInputDatum
+                , withOutRef proposalRef
+                ]
          , input $
-              script stakeValidatorHash
-                . withValue stakeValue
-                . withDatum stakeInputDatum
-                . withOutRef stakeRef
+              mconcat
+                [ script stakeValidatorHash
+                , withValue stakeValue
+                , withDatum stakeInputDatum
+                , withOutRef stakeRef
+                ]
          , output $
-              script proposalValidatorHash
-                . withValue pst
-                . withDatum proposalOutputDatum
+              mconcat
+                [ script proposalValidatorHash
+                , withValue pst
+                , withDatum proposalOutputDatum
+                ]
          , output $
-              script stakeValidatorHash
-                . withValue stakeValue
-                . withDatum stakeOutputDatum
+              mconcat
+                [ script stakeValidatorHash
+                , withValue stakeValue
+                , withDatum stakeOutputDatum
+                ]
          ]
   in builder

--- a/agora-specs/Sample/Shared.hs
+++ b/agora-specs/Sample/Shared.hs
@ -141,10 +141,10 @@ governor = Governor oref gt mc
    mc = 20

 govPolicy :: MintingPolicy
-govPolicy = mkMintingPolicy (governorPolicy governor)
+govPolicy = mkMintingPolicy def (governorPolicy governor)

 govValidator :: Validator
-govValidator = mkValidator (governorValidator governor)
+govValidator = mkValidator def (governorValidator governor)

 govSymbol :: CurrencySymbol
 govSymbol = mintingPolicySymbol govPolicy
@ -239,7 +239,7 @@ gatCs :: CurrencySymbol
 gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"

 trValidator :: Validator
-trValidator = mkValidator (treasuryValidator gatCs)
+trValidator = mkValidator def (treasuryValidator gatCs)

 -- | `ScriptCredential` used for the dummy treasury validator.
 trCredential :: Credential
@ -251,7 +251,7 @@ gatTn = validatorHashToTokenName $ validatorHash mockTrEffect

 -- | Mock treasury effect script, used for testing.
 mockTrEffect :: Validator
-mockTrEffect = mkValidator $ noOpValidator gatCs
+mockTrEffect = mkValidator def $ noOpValidator gatCs

 -- | Mock treasury effect validator hash
 mockTrEffectHash :: ValidatorHash
--- a/agora-specs/Sample/Stake.hs
+++ b/agora-specs/Sample/Stake.hs
@ -26,6 +26,7 @@ import Agora.Stake (
  StakeDatum (StakeDatum, stakedAmount),
 )
 import Agora.Stake.Scripts (stakeValidator)
+import Data.Default (def)
 import Data.Tagged (Tagged, untag)
 import Plutarch.Api.V1 (mkValidator, validatorHash)
 import Plutarch.Context (
@ -69,7 +70,10 @@ import Sample.Shared (

 -- | 'TokenName' that represents the hash of the 'Stake' validator.
 validatorHashTN :: TokenName
-validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValidator stake) in TokenName vh
+validatorHashTN =
+  let validator = mkValidator def $ stakeValidator stake
+      ValidatorHash vh = validatorHash validator
+   in TokenName vh

 -- | This script context should be a valid transaction.
 stakeCreation :: ScriptContext
@ -85,9 +89,11 @@ stakeCreation =
          , signedWith signer
          , mint st
          , output $
-              script stakeValidatorHash
-                . withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242)
-                . withDatum datum
+              mconcat
+                [ script stakeValidatorHash
+                , withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242)
+                , withDatum datum
+                ]
          , withMinting stakeSymbol
          ]
   in buildMintingUnsafe builder
@ -143,14 +149,18 @@ stakeDepositWithdraw config =
          , signedWith signer
          , mint st
          , input $
-              script stakeValidatorHash
-                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
-                . withDatum stakeAfter
-                . withOutRef stakeRef
+              mconcat
+                [ script stakeValidatorHash
+                , withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
+                , withDatum stakeAfter
+                , withOutRef stakeRef
+                ]
          , output $
-              script stakeValidatorHash
-                . withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount))
-                . withDatum stakeAfter
+              mconcat
+                [ script stakeValidatorHash
+                , withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount))
+                , withDatum stakeAfter
+                ]
          , withSpendingOutRef stakeRef
          ]
   in buildSpendingUnsafe builder
--- a/agora-specs/Sample/Stake/SetDelegate.hs
+++ b/agora-specs/Sample/Stake/SetDelegate.hs
@ -129,14 +129,18 @@ setDelegate ps = buildSpendingUnsafe builder
        [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
        , signedWith signer
        , input $
-            script stakeValidatorHash
-              . withValue stakeValue
-              . withDatum stakeInput
-              . withOutRef stakeRef
+            mconcat
+              [ script stakeValidatorHash
+              , withValue stakeValue
+              , withDatum stakeInput
+              , withOutRef stakeRef
+              ]
        , output $
-            script stakeValidatorHash
-              . withValue stakeValue
-              . withDatum stakeOutput
+            mconcat
+              [ script stakeValidatorHash
+              , withValue stakeValue
+              , withDatum stakeOutput
+              ]
        , withSpendingOutRef stakeRef
        ]

--- a/agora-specs/Sample/Treasury.hs
+++ b/agora-specs/Sample/Treasury.hs
@ -19,7 +19,6 @@ module Sample.Treasury (

 import Plutarch.Context (
  MintingBuilder,
-  UTXO,
  buildMintingUnsafe,
  credential,
  input,
@ -57,11 +56,12 @@ import Sample.Shared (

 baseCtxBuilder :: MintingBuilder
 baseCtxBuilder =
-  let treasury :: UTXO -> UTXO
-      treasury =
-        credential trCredential
-          . withValue minAda
-          . withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+  let treasury =
+        mconcat
+          [ credential trCredential
+          , withValue minAda
+          , withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+          ]
   in mconcat
        [ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
        , signedWith signer
@ -81,9 +81,11 @@ validCtx =
        mconcat
          [ baseCtxBuilder
          , input $
-              script mockTrEffectHash
-                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
-                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+              mconcat
+                [ script mockTrEffectHash
+                , withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                , withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+                ]
          ]
   in buildMintingUnsafe builder

@ -122,8 +124,10 @@ trCtxGATNameNotAddress =
        mconcat
          [ baseCtxBuilder
          , input $
-              script wrongEffHash
-                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
-                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+              mconcat
+                [ script wrongEffHash
+                , withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                , withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+                ]
          ]
   in buildMintingUnsafe builder
--- a/agora-specs/Spec/AuthorityToken.hs
+++ b/agora-specs/Spec/AuthorityToken.hs
@ -10,7 +10,8 @@ Tests for Authority token functions
 module Spec.AuthorityToken (specs) where

 import Agora.AuthorityToken (singleAuthorityTokenBurned)
-import Plutarch (ClosedTerm, POpaque, compile, perror, popaque)
+import Plutarch (ClosedTerm, POpaque, perror, popaque)
+import Plutarch.Extra.Compile (mustCompile)
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1 (
  Address (Address),
@ -60,7 +61,7 @@ singleAuthorityTokenBurnedTest mint outs =
          actual
          (popaque (pconstant ()))
          perror
-   in compile s
+   in mustCompile s

 -- | The SpecificationTree exported by this module.
 specs :: [SpecificationTree]