feat(#22): update to PlutusV3

bet-ref/betref.cabal

@@ -1,9 +1,9 @@
-cabal-version:      3.6
-name:               betref
-version:            0.1.0
+cabal-version: 3.6
+name: betref
+version: 0.1.0
 
 common common
-  default-language:   GHC2021
+  default-language: GHC2021
   default-extensions:
     DataKinds
     DeriveAnyClass
@@ -19,92 +19,105 @@ common common
     UndecidableInstances
     ViewPatterns
 
-  ghc-options:        -Wall -Wincomplete-uni-patterns -Wunused-packages
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wunused-packages
 
   -- speed-ups GHCi considerably
-  ghc-options:        -fno-show-valid-hole-fits
+  ghc-options: -fno-show-valid-hole-fits
 
 common plutus-ghc-options
   -- so unfoldings are present even when compiled without optmizations
   ghc-options:
-    -fno-ignore-interface-pragmas -fno-omit-interface-pragmas
+    -fno-ignore-interface-pragmas
+    -fno-omit-interface-pragmas
     -Wno-partial-type-signatures
 
   -- expose all unfoldings, so plutustx compiler can do its job
   ghc-options:
-    -fexpose-all-unfoldings -fobject-code
-    -fplugin-opt PlutusTx.Plugin:defer-errors
-
-  -- set target plutus-core version
-  ghc-options: -fplugin-opt PlutusTx.Plugin:target-version=1.0.0
+    -fexpose-all-unfoldings
+    -fobject-code
+    -fplugin-opt
+    PlutusTx.Plugin:defer-errors
 
 library betref-onchain
-  import:           common, plutus-ghc-options
-  hs-source-dirs:   onchain
+  import: common, plutus-ghc-options
+  hs-source-dirs: onchain
   exposed-modules:
     BetRef.OnChain.BetRef
     BetRef.OnChain.BetRef.Compiled
+
   build-depends:
-    , base
-    , plutus-core
-    , plutus-ledger-api
-    , plutus-tx
-    , plutus-tx-plugin
+    base,
+    plutus-core,
+    plutus-ledger-api,
+    plutus-tx,
+    plutus-tx-plugin,
 
 library betref-server-lib
-  import:           common
-  hs-source-dirs:   server-lib
+  import: common
+  hs-source-dirs: server-lib
   exposed-modules:
     BetRef.Api.Api
     BetRef.Api.BetRef
     BetRef.Api.Context
     BetRef.Api.Operations
     BetRef.Api.Tx
+
   build-depends:
-    , base
-    , aeson
-    , betref:betref-onchain
-    , atlas-cardano
-    , swagger2
-    , servant-server
-    , servant-swagger
-    , containers
-    , text
+    aeson,
+    atlas-cardano,
+    base,
+    betref:betref-onchain,
+    containers,
+    servant-server,
+    servant-swagger,
+    swagger2,
+    text,
 
 executable betref-server
-  import:           common
-  hs-source-dirs:   server
-  main-is:          server-main.hs
+  import: common
+  hs-source-dirs: server
+  main-is: server-main.hs
   ghc-options:
-    -O2 -threaded -rtsopts -with-rtsopts=-T
+    -O2
+    -threaded
+    -rtsopts
+    -with-rtsopts=-T
+
   build-depends:
-    , aeson-pretty
-    , base
-    , bytestring
-    , atlas-cardano
-    , betref:betref-server-lib
-    , servant-server
-    , transformers
-    , wai-cors
-    , http-types
-    , warp
+    aeson-pretty,
+    atlas-cardano,
+    base,
+    betref:betref-server-lib,
+    bytestring,
+    http-types,
+    servant-server,
+    transformers,
+    wai-cors,
+    warp,
 
 test-suite betref-tests
-  import:         common
-  ghc-options:    -threaded -rtsopts
-  type:           exitcode-stdio-1.0
-  main-is:        betref-tests.hs
+  import: common
+  ghc-options:
+    -threaded
+    -rtsopts
+
+  type: exitcode-stdio-1.0
+  main-is: betref-tests.hs
   hs-source-dirs: tests
   other-modules:
     BetRef.Tests.PlaceBet
     BetRef.Tests.TakeBetPot
+
   build-depends:
-    , base
-    , containers
-    , betref:betref-onchain
-    , betref:betref-server-lib
-    , extra
-    , text
-    , atlas-cardano
-    , mtl
-    , tasty
+    atlas-cardano,
+    base,
+    betref:betref-onchain,
+    betref:betref-server-lib,
+    containers,
+    extra,
+    mtl,
+    tasty,
+    text,

bet-ref/onchain/BetRef/OnChain/BetRef.hs

@@ -19,8 +19,8 @@ module BetRef.OnChain.BetRef (
 import PlutusLedgerApi.V1.Address (toPubKeyHash)
 import PlutusLedgerApi.V1.Interval (contains)
 import PlutusLedgerApi.V1.Value (geq)
-import PlutusLedgerApi.V2
-import PlutusLedgerApi.V2.Contexts (
+import PlutusLedgerApi.V3
+import PlutusLedgerApi.V3.Contexts (
   findDatum,
   findOwnInput,
   getContinuingOutputs,
@@ -48,7 +48,7 @@ data BetRefParams = BetRefParams
   , brpBetStep :: Value
   -- ^ Each newly placed bet must be more than previous bet by `brpBetStep` amount.
   }
-  deriving stock Show
+  deriving stock (Show)
 
 -- PlutusTx.makeLift ''BetRefParams
 PlutusTx.unstableMakeIsData ''BetRefParams
@@ -75,80 +75,81 @@ PlutusTx.unstableMakeIsData ''BetRefAction
 {-# INLINEABLE mkBetRefValidator #-}
 
 -- | Untyped wrapper around `mkBetRefValidator'`.
-mkBetRefValidator :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinData -> ()
-mkBetRefValidator params dat' red' ctx'
-  | mkBetRefValidator' (unsafeFromBuiltinData params) (unsafeFromBuiltinData dat') (unsafeFromBuiltinData red') (unsafeFromBuiltinData ctx') = ()
+mkBetRefValidator :: BuiltinData -> BuiltinData -> ()
+mkBetRefValidator params ctx'
+  | mkBetRefValidator' (unsafeFromBuiltinData params) (unsafeFromBuiltinData ctx') = ()
   | otherwise = error ()
 
 {-# INLINEABLE mkBetRefValidator' #-}
 
 -- | Core smart contract logic. Read its description from Atlas guide.
-mkBetRefValidator' :: BetRefParams -> BetRefDatum -> BetRefAction -> ScriptContext -> Bool
-mkBetRefValidator' (BetRefParams oraclePkh betUntil betReveal betStep) (BetRefDatum previousGuesses previousBet) brAction ctx =
-  case brAction of
-    Bet guess ->
-      let
-        sOut = case getContinuingOutputs ctx of
-          [sOut'] -> sOut'
-          _anyOtherMatch -> traceError "Expected only one continuing output."
-        outValue = txOutValue sOut
-        -- Using the 'maybe' utility here makes validation fail... for some reason...
-        -- Why is PlutusTx still allowed to exist?
-        inValue = case findOwnInput ctx of
-          Nothing -> traceError "Joever!"
-          Just x -> txOutValue (txInInfoResolved x)
-        -- inValue = txOutValue sIn
-        (guessesOut, betOut) = case outputToDatum sOut of
-          Nothing -> traceError "Could not resolve for script output datum"
-          Just (BetRefDatum guessesOut' betOut') -> (guessesOut', betOut')
-       in
-        traceIfFalse
-          "Must be before `BetUntil` time"
-          (to betUntil `contains` validRange)
-          && traceIfFalse
-            "Guesses update is wrong"
-            ((signerPkh, guess) : previousGuesses == guessesOut)
-          && traceIfFalse
-            "The current bet must be more than the previous bet by atleast `brpBetStep` amount"
-            (outValue `geq` (inValue <> previousBet <> betStep))
-          && traceIfFalse
-            "Out bet is wrong"
-            (inValue == outValue - betOut)
-    Take ->
-      let
-        -- Note that `find` returns the first match. Since we were always prepending, this is valid.
-        Just guess = find ((== signerPkh) . fst) previousGuesses
-        oracleIn = case filter (isNothing . txOutReferenceScript) (txInInfoResolved <$> txInfoReferenceInputs info) of
-          [oracleIn'] -> oracleIn'
-          [] -> traceError "No reference input provided"
-          _anyOtherMatch -> traceError "Expected only one reference input"
-        oracleAnswer = case outputToDatum oracleIn of
-          Nothing -> traceError "Could not resolve for datum"
-          (Just (OracleAnswerDatum oracleAnswer')) -> oracleAnswer'
-        guessDiff = getGuessDiff $ snd guess
-        getGuessDiff (OracleAnswerDatum g) = abs (oracleAnswer - g)
-        -- Unwrapping the 'Maybe' here to extract the 'Just' (and trace error for 'Nothing') kills PlutusTx compilation
-        -- the issue is that GHC will fire the worker wrapper transformation combining this with the equality with 'oraclePkh'
-        -- code down below. Which will cause issues with BuiltinByteString also being unwrapped into primitive pointers.
-        -- See: https://github.com/IntersectMBO/plutus/issues/4193
-        mOracleInPkh = toPubKeyHash (txOutAddress oracleIn)
-       in
-        traceIfFalse
-          "Must be after `RevealTime`"
-          (from betReveal `contains` validRange)
-          && traceIfFalse
-            "Must fully spend Script"
-            (null (getContinuingOutputs ctx))
-          && traceIfFalse
-            "Reference input must be from Oracle address (wrt Payment part)"
-            (mOracleInPkh == Just oraclePkh)
-          && traceIfFalse
-            "Guess is not closest"
-            (all (\pg -> getGuessDiff (snd pg) >= guessDiff) previousGuesses)
+mkBetRefValidator' :: BetRefParams -> ScriptContext -> Bool
+mkBetRefValidator' (BetRefParams oraclePkh betUntil betReveal betStep) ctx@(ScriptContext info red purpose) =
+  let brAction :: BetRefAction = unsafeFromBuiltinData (getRedeemer red)
+      (BetRefDatum previousGuesses previousBet) = case purpose of
+        SpendingScript _ (Just dat) -> unsafeFromBuiltinData (getDatum dat)
+        _anyOther -> traceError "Expected SpendingScript with Just Datum"
+   in case brAction of
+        Bet guess ->
+          let
+            sOut = case getContinuingOutputs ctx of
+              [sOut'] -> sOut'
+              _anyOtherMatch -> traceError "Expected only one continuing output."
+            outValue = txOutValue sOut
+            -- Using the 'maybe' utility here makes validation fail... for some reason...
+            -- Why is PlutusTx still allowed to exist?
+            inValue = case findOwnInput ctx of
+              Nothing -> traceError "Joever!"
+              Just x -> txOutValue (txInInfoResolved x)
+            -- inValue = txOutValue sIn
+            (guessesOut, betOut) = case outputToDatum sOut of
+              Nothing -> traceError "Could not resolve for script output datum"
+              Just (BetRefDatum guessesOut' betOut') -> (guessesOut', betOut')
+           in
+            traceIfFalse
+              "Must be before `BetUntil` time"
+              (to betUntil `contains` validRange)
+              && traceIfFalse
+                "Guesses update is wrong"
+                ((signerPkh, guess) : previousGuesses == guessesOut)
+              && traceIfFalse
+                "The current bet must be more than the previous bet by atleast `brpBetStep` amount"
+                (outValue `geq` (inValue <> previousBet <> betStep))
+              && traceIfFalse
+                "Out bet is wrong"
+                (inValue == outValue - betOut)
+        Take ->
+          let
+            -- Note that `find` returns the first match. Since we were always prepending, this is valid.
+            Just guess = find ((== signerPkh) . fst) previousGuesses
+            oracleIn = case filter (isNothing . txOutReferenceScript) (txInInfoResolved <$> txInfoReferenceInputs info) of
+              [oracleIn'] -> oracleIn'
+              [] -> traceError "No reference input provided"
+              _anyOtherMatch -> traceError "Expected only one reference input"
+            oracleAnswer = case outputToDatum oracleIn of
+              Nothing -> traceError "Could not resolve for datum"
+              (Just (OracleAnswerDatum oracleAnswer')) -> oracleAnswer'
+            guessDiff = getGuessDiff $ snd guess
+            getGuessDiff (OracleAnswerDatum g) = abs (oracleAnswer - g)
+            -- Unwrapping the 'Maybe' here to extract the 'Just' (and trace error for 'Nothing') kills PlutusTx compilation
+            -- the issue is that GHC will fire the worker wrapper transformation combining this with the equality with 'oraclePkh'
+            -- code down below. Which will cause issues with BuiltinByteString also being unwrapped into primitive pointers.
+            -- See: https://github.com/IntersectMBO/plutus/issues/4193
+            mOracleInPkh = toPubKeyHash (txOutAddress oracleIn)
+           in
+            traceIfFalse
+              "Must be after `RevealTime`"
+              (from betReveal `contains` validRange)
+              && traceIfFalse
+                "Must fully spend Script"
+                (null (getContinuingOutputs ctx))
+              && traceIfFalse
+                "Reference input must be from Oracle address (wrt Payment part)"
+                (mOracleInPkh == Just oraclePkh)
+              && traceIfFalse
+                "Guess is not closest"
+                (all (\pg -> getGuessDiff (snd pg) >= guessDiff) previousGuesses)
  where
-  info :: TxInfo
-  info = scriptContextTxInfo ctx
-
   validRange :: POSIXTimeRange
   validRange = txInfoValidRange info
 
@@ -158,7 +159,7 @@ mkBetRefValidator' (BetRefParams oraclePkh betUntil betReveal betStep) (BetRefDa
     [] -> traceError "No signatory"
     _anyOtherMatch -> traceError "Expected only one signatory"
 
-  outputToDatum :: FromData b => TxOut -> Maybe b
+  outputToDatum :: (FromData b) => TxOut -> Maybe b
   outputToDatum o = case txOutDatum o of
     NoOutputDatum -> Nothing
     OutputDatum d -> processDatum d

bet-ref/onchain/BetRef/OnChain/BetRef/Compiled.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}
 
 module BetRef.OnChain.BetRef.Compiled (
   betRefValidator,
@@ -12,13 +11,13 @@ module BetRef.OnChain.BetRef.Compiled (
   BetRefAction (..),
 ) where
 
-import PlutusCore.Version (plcVersion100)
+import PlutusCore.Version (plcVersion110)
 import PlutusTx qualified
 
 import BetRef.OnChain.BetRef
 
 -- Since makeLift doesn't seem to work on BetRefParams. We just convert it to data and apply that instead.
-betRefValidator :: BetRefParams -> PlutusTx.CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> ())
+betRefValidator :: BetRefParams -> PlutusTx.CompiledCode (PlutusTx.BuiltinData -> ())
 betRefValidator betRefParams =
   $$(PlutusTx.compile [||mkBetRefValidator||])
-    `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion100 (PlutusTx.toBuiltinData betRefParams)
+    `PlutusTx.unsafeApplyCode` PlutusTx.liftCode plcVersion110 (PlutusTx.toBuiltinData betRefParams)

bet-ref/server-lib/BetRef/Api/BetRef.hs

@@ -149,7 +149,7 @@ handleAddRefScript ctx AddRefScriptParams{..} = do
       pure $
         addRefScript' arsPutAddress validator
   let refs = findRefScriptsInBody txBody
-  outRef <- case Map.lookup (GYPlutusScript (validatorToScript validator)) refs of
+  outRef <- case Map.lookup (GYPlutusScript validator) refs of
     Nothing -> fail "Shouldn't happen: No reference for added Script in body"
     Just ref -> return ref
   pure $ unSignedTxWithFee txBody $ Just outRef