Fix plutus-playground-server

IntersectMBO · Jun 12, 2021 · 59054fb · 59054fb
1 parent 70ab1f0
commit 59054fb
Show file tree

Hide file tree

Showing 4 changed files with 29 additions and 25 deletions.
diff --git a/plutus-playground-server/usecases/ErrorHandling.hs b/plutus-playground-server/usecases/ErrorHandling.hs
@@ -17,8 +17,7 @@ import           Data.Text                (Text)
 import qualified Data.Text                as T
 
 import           Playground.Contract
-import           Plutus.Contract          (AsContractError (_ContractError), ContractError, HasAwaitSlot, logInfo,
-                                           mapError, select)
+import           Plutus.Contract          (AsContractError (_ContractError), ContractError, logInfo, mapError, select)
 import           Prelude                  (Maybe (..), const, show, ($), (.), (<>), (>>), (>>=))
 
 -- Demonstrates how to deal with errors in Plutus contracts. We define a custom
@@ -69,7 +68,7 @@ throwAndCatch e =
 
 -- | Handle an error from 'awaitSlot' by wrapping it in the 'AContractError'
 --   constructor
-catchContractError :: (AsMyError e, HasAwaitSlot s) => Contract () s e ()
+catchContractError :: (AsMyError e) => Contract () s e ()
 catchContractError =
     catching _AContractError
         (void $ mapError (review _AContractError) $ awaitSlot 10)

diff --git a/plutus-playground-server/usecases/HelloWorld.hs b/plutus-playground-server/usecases/HelloWorld.hs
@@ -1,14 +1,19 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE KindSignatures    #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PolyKinds         #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE TypeOperators     #-}
 {-# options_ghc -fno-warn-unused-imports #-}
 
 module HelloWorld where
 
 -- TRIM TO HERE
 import qualified Data.Text           as T
 import           Playground.Contract
-import           Plutus.Contract     hiding (when)
+import           Plutus.Contract
 import           PlutusTx.Prelude
 import qualified Prelude             as Haskell
 
@@ -19,6 +24,12 @@ hello = logInfo @Haskell.String "Hello, world"
 endpoints :: Contract () EmptySchema T.Text ()
 endpoints = hello
 
-mkSchemaDefinitions ''EmptySchema
+-- 'mkSchemaDefinitions' doesn't work with 'EmptySchema'
+-- (that is, with 0 endpoints) so we define a
+-- dummy schema type with 1 endpoint to make it compile.
+-- TODO: Repair 'mkSchemaDefinitions'
+type DummySchema = Endpoint "dummy" ()
+
+mkSchemaDefinitions ''DummySchema
 
 $(mkKnownCurrencies [])
diff --git a/plutus-playground-server/usecases/SimulationUtils.hs b/plutus-playground-server/usecases/SimulationUtils.hs
@@ -2,17 +2,17 @@
 
 module SimulationUtils where
 
-import           Ledger.Scripts                         (ValidatorHash (ValidatorHash))
-import           Ledger.Value                           (CurrencySymbol (CurrencySymbol), TokenName, Value)
-import qualified Ledger.Value                           as Value
-import           Playground.Types                       (ContractCall (CallEndpoint), FunctionSchema (FunctionSchema),
-                                                         KnownCurrency (KnownCurrency), SimulatorAction,
-                                                         SimulatorWallet (SimulatorWallet), argument, argumentValues,
-                                                         caller, endpointDescription, hash, knownTokens,
-                                                         simulatorWalletBalance, simulatorWalletWallet)
-import           Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription)
-import           Schema                                 (ToArgument, toArgument)
-import           Wallet.Emulator.Types                  (Wallet)
+import           Ledger.Scripts        (ValidatorHash (ValidatorHash))
+import           Ledger.Value          (CurrencySymbol (CurrencySymbol), TokenName, Value)
+import qualified Ledger.Value          as Value
+import           Playground.Types      (ContractCall (CallEndpoint), FunctionSchema (FunctionSchema),
+                                        KnownCurrency (KnownCurrency), SimulatorAction,
+                                        SimulatorWallet (SimulatorWallet), argument, argumentValues, caller,
+                                        endpointDescription, hash, knownTokens, simulatorWalletBalance,
+                                        simulatorWalletWallet)
+import           Schema                (ToArgument, toArgument)
+import           Wallet.Emulator.Types (Wallet)
+import           Wallet.Types          (EndpointDescription)
 
 callEndpoint :: ToArgument a => Wallet -> EndpointDescription -> a -> SimulatorAction
 callEndpoint caller endpointDescription param =

diff --git a/plutus-playground-server/usecases/Vesting.hs b/plutus-playground-server/usecases/Vesting.hs
@@ -32,7 +32,7 @@ import qualified Ledger.Typed.Scripts     as Scripts
 import           Ledger.Value             (Value)
 import qualified Ledger.Value             as Value
 import           Playground.Contract
-import           Plutus.Contract          hiding (when)
+import           Plutus.Contract
 import qualified Plutus.Contract.Typed.Tx as Typed
 import qualified PlutusTx
 import           PlutusTx.Prelude         hiding (Semigroup (..), fold)
@@ -160,9 +160,7 @@ payIntoContract :: Value -> TxConstraints () ()
 payIntoContract = mustPayToTheScript ()
 
 vestFundsC
-    :: ( HasWriteTx s
-       )
-    => VestingParams
+    :: VestingParams
     -> Contract () s T.Text ()
 vestFundsC vesting = do
     let tx = payIntoContract (totalAmount vesting)
@@ -171,11 +169,7 @@ vestFundsC vesting = do
 data Liveness = Alive | Dead
 
 retrieveFundsC
-    :: ( HasAwaitSlot s
-       , HasUtxoAt s
-       , HasWriteTx s
-       )
-    => VestingParams
+    :: VestingParams
     -> Value
     -> Contract () s T.Text Liveness
 retrieveFundsC vesting payment = do