bumped Plutus and fixed EnglishAuction

code/week01/cabal.project

@@ -1,4 +1,4 @@
-index-state: 2021-02-24T00:00:00Z
+index-state: 2021-06-10T00:00:00Z
 
 packages: ./.
 
@@ -15,6 +15,7 @@ source-repository-package
   subdir:
     freer-extras
     playground-common
+    plutus-chain-index
     plutus-core
     plutus-contract
     plutus-ledger
@@ -23,7 +24,8 @@ source-repository-package
     plutus-tx-plugin
     prettyprinter-configurable
     quickcheck-dynamic
-  tag: 0c3c310cab61dbff8cbc1998a3678b367be6815a
+    word-array
+  tag: eaf2c901d9d51a6132e3290927887e8924219599
 
 -- The following sections are copied from the 'plutus' repository cabal.project at the revision
 -- given above.
@@ -31,22 +33,44 @@ source-repository-package
 -- not on Hackage, and so need to be pulled in as `source-repository-package`s themselves. Make sure to
 -- re-update this section from the template when you do an upgrade.
 
+-- This is also needed so evenful-sql-common will build with a
+-- newer version of persistent. See stack.yaml for the mirrored
+-- configuration.
 package eventful-sql-common
-  ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances
+  ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances -XMultiParamTypeClasses
 
 allow-newer:
-           -- Has a commit to allow newer aeson, not on Hackage yet
-           monoidal-containers:aeson
            -- Pins to an old version of Template Haskell, unclear if/when it will be updated
-           , size-based:template-haskell
+           size-based:template-haskell
 
            -- The following two dependencies are needed by plutus.
            , eventful-sql-common:persistent
            , eventful-sql-common:persistent-template
+           , ouroboros-consensus-byron:formatting
+           , beam-core:aeson
+           , beam-sqlite:aeson
+           , beam-sqlite:dlist
+           , beam-migrate:aeson
 
 constraints:
-  -- aws-lambda-haskell-runtime-wai doesn't compile with newer versions
+  -- big breaking change here, inline-r doens't have an upper bound
-  aws-lambda-haskell-runtime <= 3.0.3
+  singletons < 3.0
+  -- breaks eventful even more than it already was
+  , persistent-template < 2.12
+  -- bizarre issue: in earlier versions they define their own 'GEq', in newer
+  -- ones they reuse the one from 'some', but there isn't e.g. a proper version
+  -- constraint from dependent-sum-template (which is the library we actually use).
+  , dependent-sum > 0.6.2.0
+
+-- See the note on nix/pkgs/default.nix:agdaPackages for why this is here.
+-- (NOTE this will change to ieee754 in newer versions of nixpkgs).
+extra-packages: ieee, filemanip
+
+-- Drops an instance breaking our code. Should be released to Hackage eventually.
+source-repository-package
+  type: git
+  location: https://github.com/Quid2/flat.git
+  tag: 95e5d7488451e43062ca84d5376b3adcc465f1cd
 
 -- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year)
 source-repository-package
@@ -62,29 +86,25 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-crypto.git
-  tag: f73079303f663e028288f9f4a9e08bcca39a923e
+  tag: ce8f1934e4b6252084710975bd9bbc0a4648ece4
-
--- Needs a fix (https://github.com/wenkokke/unlit/pull/11) and a Hackage release
-source-repository-package
-  type: git
-  location: https://github.com/michaelpj/unlit.git
-  tag: 9ca1112093c5ffd356fc99c7dafa080e686dd748
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 4251c0bb6e4f443f00231d28f5f70d42876da055
+  tag: a715c7f420770b70bbe95ca51d3dec83866cb1bd
   subdir:
     binary
     binary/test
     slotting
     cardano-crypto-class
     cardano-crypto-praos
+    cardano-crypto-tests
+    strict-containers
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-prelude
-  tag: ee4e7b547a991876e6b05ba542f4e62909f4a571
+  tag: fd773f7a58412131512b9f694ab95653ac430852
   subdir:
     cardano-prelude
     cardano-prelude-test
@@ -92,32 +112,39 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 6cb9052bde39472a0555d19ade8a42da63d3e904
+  tag: e50613562d6d4a0f933741fcf590b0f69a1eda67
   subdir:
     typed-protocols
     typed-protocols-examples
     ouroboros-network
     ouroboros-network-testing
     ouroboros-network-framework
+    ouroboros-consensus
+    ouroboros-consensus-byron
+    ouroboros-consensus-cardano
+    ouroboros-consensus-shelley
     io-sim
     io-sim-classes
     network-mux
-    Win32-network
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/iohk-monitoring-framework
-  tag: a89c38ed5825ba17ca79fddb85651007753d699d
+  tag: 34abfb7f4f5610cabb45396e0496472446a0b2ca
   subdir:
     iohk-monitoring
     tracer-transformers
     contra-tracer
+    plugins/backend-aggregation
     plugins/backend-ekg
+    plugins/backend-monitoring
+    plugins/backend-trace-forwarder
+    plugins/scribe-systemd
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 097890495cbb0e8b62106bcd090a5721c3f4b36f
+  tag: a3ef848542961079b7cd53d599e5385198a3035c
   subdir:
     byron/chain/executable-spec
     byron/crypto
@@ -129,8 +156,37 @@ source-repository-package
     semantics/small-steps-test
     shelley/chain-and-ledger/dependencies/non-integer
     shelley/chain-and-ledger/executable-spec
+    shelley/chain-and-ledger/shelley-spec-ledger-test
     shelley-ma/impl
+    cardano-ledger-core
+    alonzo/impl
 
+-- A lot of plutus dependencies have to be synchronized with the dependencies of
+-- cardano-node. If you update cardano-node, please make sure that all dependencies
+-- of cardano-node are also updated.
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/cardano-node.git
+  tag: b3cabae6b3bf30a0b1b4e78bc4b67282dabad0a6
+  subdir:
+    cardano-api/test
+    cardano-api
+    cardano-node
+    cardano-cli
+    cardano-config
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/Win32-network
+  tag: 94153b676617f8f33abe8d8182c37377d2784bd1
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/hedgehog-extras
+  tag: 8bcd3c9dc22cc44f9fcfe161f4638a384fc7a187
+
+-- The following dependencies are not mirrored in the
+-- stack.yaml file, but they are needed regardless by cabal.
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/goblins

code/week01/src/Week01/EnglishAuction.hs

@@ -15,19 +15,7 @@
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 
-module Week01.EnglishAuction
+module Week01.EnglishAuction where
-    ( Auction (..)
-    , StartParams (..), BidParams (..), CloseParams (..)
-    , AuctionSchema
-    , start, bid, close
-    , endpoints
-    , schemas
-    , ensureKnownCurrencies
-    , printJson
-    , printSchemas
-    , registeredKnownCurrencies
-    , stage
-    ) where
 
 import           Control.Monad        hiding (fmap)
 import           Data.Aeson           (ToJSON, FromJSON)
@@ -35,26 +23,26 @@ import           Data.List.NonEmpty   (NonEmpty (..))
 import           Data.Map             as Map
 import           Data.Text            (pack, Text)
 import           GHC.Generics         (Generic)
-import           Plutus.Contract      hiding (when)
+import           Plutus.Contract
 import qualified PlutusTx             as PlutusTx
 import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
 import qualified PlutusTx.Prelude     as Plutus
 import           Ledger               hiding (singleton)
 import           Ledger.Constraints   as Constraints
 import qualified Ledger.Scripts       as Scripts
-import qualified Ledger.Typed.Scripts as Scripts
+import qualified Ledger.Typed.Scripts as Scripts hiding (validatorHash)
 import           Ledger.Value         as Value
 import           Ledger.Ada           as Ada
 import           Playground.Contract  (ensureKnownCurrencies, printSchemas, stage, printJson)
 import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
 import           Playground.Types     (KnownCurrency (..))
-import           Prelude              (Semigroup (..))
+import           Prelude              (IO, Semigroup (..), Show (..), String)
 import           Schema               (ToSchema)
 import           Text.Printf          (printf)
 
 data Auction = Auction
     { aSeller   :: !PubKeyHash
-    , aDeadline :: !Slot
+    , aDeadline :: !POSIXTime
     , aMinBid   :: !Integer
     , aCurrency :: !CurrencySymbol
     , aToken    :: !TokenName
@@ -99,7 +87,7 @@ PlutusTx.unstableMakeIsData ''AuctionDatum
 PlutusTx.makeLift ''AuctionDatum
 
 data Auctioning
-instance Scripts.ScriptType Auctioning where
+instance Scripts.ValidatorTypes Auctioning where
     type instance RedeemerType Auctioning = AuctionAction
     type instance DatumType Auctioning = AuctionDatum
 
@@ -212,24 +200,21 @@ mkAuctionValidator ad redeemer ctx =
       in
         txOutAddress o == pubKeyHashAddress h
 
-auctionInstance :: Scripts.ScriptInstance Auctioning
+auctionTypedValidator :: Scripts.TypedValidator Auctioning
-auctionInstance = Scripts.validator @Auctioning
+auctionTypedValidator = Scripts.mkTypedValidator @Auctioning
     $$(PlutusTx.compile [|| mkAuctionValidator ||])
     $$(PlutusTx.compile [|| wrap ||])
   where
-    wrap = Scripts.wrapValidator @AuctionDatum @AuctionAction
+    wrap = Scripts.wrapValidator
 
 auctionValidator :: Validator
-auctionValidator = Scripts.validatorScript auctionInstance
+auctionValidator = Scripts.validatorScript auctionTypedValidator
 
-auctionHash :: Ledger.ValidatorHash
+auctionAddress :: Ledger.ValidatorHash
-auctionHash = Scripts.validatorHash auctionValidator
+auctionAddress = Scripts.validatorHash auctionValidator
-
-auctionAddress :: Ledger.Address
-auctionAddress = scriptHashAddress auctionHash
 
 data StartParams = StartParams
-    { spDeadline :: !Slot
+    { spDeadline :: !POSIXTime
     , spMinBid   :: !Integer
     , spCurrency :: !CurrencySymbol
     , spToken    :: !TokenName
@@ -247,12 +232,11 @@ data CloseParams = CloseParams
     } deriving (Generic, ToJSON, FromJSON, ToSchema)
 
 type AuctionSchema =
-    BlockchainActions
+            Endpoint "start" StartParams
-        .\/ Endpoint "start" StartParams
         .\/ Endpoint "bid"   BidParams
         .\/ Endpoint "close" CloseParams
 
-start :: (HasBlockchainActions s, AsContractError e) => StartParams -> Contract w s e ()
+start :: AsContractError e => StartParams -> Contract w s e ()
 start StartParams{..} = do
     pkh <- pubKeyHash <$> ownPubKey
     let a = Auction
@@ -268,11 +252,11 @@ start StartParams{..} = do
                 }
         v = Value.singleton spCurrency spToken 1
         tx = mustPayToTheScript d v
-    ledgerTx <- submitTxConstraints auctionInstance tx
+    ledgerTx <- submitTxConstraints auctionTypedValidator tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ printf "started auction %s for token %s" (show a) (show v)
 
-bid :: forall w s. HasBlockchainActions s => BidParams -> Contract w s Text ()
+bid :: forall w s. BidParams -> Contract w s Text ()
 bid BidParams{..} = do
     (oref, o, d@AuctionDatum{..}) <- findAuction bpCurrency bpToken
     logInfo @String $ printf "found auction utxo with datum %s" (show d)
@@ -285,8 +269,8 @@ bid BidParams{..} = do
         v  = Value.singleton bpCurrency bpToken 1 <> Ada.lovelaceValueOf bpBid
         r  = Redeemer $ PlutusTx.toData $ MkBid b
 
-        lookups = Constraints.scriptInstanceLookups auctionInstance <>
+        lookups = Constraints.typedValidatorLookups auctionTypedValidator <>
-                  Constraints.otherScript auctionValidator          <>
+                  Constraints.otherScript auctionValidator                <>
                   Constraints.unspentOutputs (Map.singleton oref o)
         tx      = case adHighestBid of
                     Nothing      -> mustPayToTheScript d' v                            <>
@@ -304,7 +288,7 @@ bid BidParams{..} = do
         (show bpCurrency)
         (show bpToken)
 
-close :: forall w s. HasBlockchainActions s => CloseParams -> Contract w s Text ()
+close :: forall w s. CloseParams -> Contract w s Text ()
 close CloseParams{..} = do
     (oref, o, d@AuctionDatum{..}) <- findAuction cpCurrency cpToken
     logInfo @String $ printf "found auction utxo with datum %s" (show d)
@@ -313,8 +297,8 @@ close CloseParams{..} = do
         r      = Redeemer $ PlutusTx.toData Close
         seller = aSeller adAuction
 
-        lookups = Constraints.scriptInstanceLookups auctionInstance <>
+        lookups = Constraints.typedValidatorLookups auctionTypedValidator <>
-                  Constraints.otherScript auctionValidator          <>
+                  Constraints.otherScript auctionValidator                <>
                   Constraints.unspentOutputs (Map.singleton oref o)
         tx      = case adHighestBid of
                     Nothing      -> mustPayToPubKey seller t                          <>
@@ -331,12 +315,9 @@ close CloseParams{..} = do
         (show cpCurrency)
         (show cpToken)
 
-findAuction :: HasBlockchainActions s
+findAuction :: CurrencySymbol -> TokenName -> Contract w s Text (TxOutRef, TxOutTx, AuctionDatum)
-            => CurrencySymbol
-            -> TokenName
-            -> Contract w s Text (TxOutRef, TxOutTx, AuctionDatum)
 findAuction cs tn = do
-    utxos <- utxoAt $ scriptHashAddress auctionHash
+    utxos <- utxoAt $ scriptAddress auctionValidator
     let xs = [ (oref, o)
              | (oref, o) <- Map.toList utxos
              , Value.valueOf (txOutValue $ txOutTxOut o) cs tn == 1