finished code for week 2

README.md

@@ -31,6 +31,7 @@
 ## Some Plutus Modules
 
 - [`PlutusTx.Data`](https://github.com/input-output-hk/plutus/blob/master/plutus-tx/src/PlutusTx/Data.hs), contains the definition of the `Data` type.
+- [`PlutusTx.IsData.Class`](https://github.com/input-output-hk/plutus/blob/master/plutus-tx/src/PlutusTx/IsData/Class.hs), defines the `IsData` class.
 
 ## Additional Resources
 

code/week02/plutus-pioneer-program-week02.cabal

@@ -12,8 +12,10 @@ library
   hs-source-dirs:      src
   exposed-modules:     Week02.Burn
                      , Week02.FortyTwo
+                     , Week02.Homework1
+                     , Week02.Homework2
                      , Week02.Gift
-                     , Week02.Parameterized
+                     , Week02.IsData
                      , Week02.Typed
   build-depends:       aeson
                      , base ^>=4.14.1.0

code/week02/src/Week02/Burn.hs

@@ -8,18 +8,7 @@
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 
-module Week02.Burn
+module Week02.Burn where
-    ( burn
-    , grab
-    , BurnSchema
-    , endpoints
-    , schemas
-    , registeredKnownCurrencies
-    , printJson
-    , printSchemas
-    , ensureKnownCurrencies
-    , stage
-    ) where
 
 import           Control.Monad       hiding (fmap)
 import           Data.Map            as Map
@@ -39,49 +28,49 @@ import           Playground.Types    (KnownCurrency (..))
 import           Prelude             (Semigroup (..))
 import           Text.Printf         (printf)
 
-{-# INLINABLE mkBurnValidator #-}
+{-# INLINABLE mkValidator #-}
-mkBurnValidator :: Data -> Data -> Data -> ()
+mkValidator :: Data -> Data -> Data -> ()
-mkBurnValidator _ _ _ = traceError "NO WAY!"
+mkValidator _ _ _ = traceError "NO WAY!"
 
-burnValidator :: Validator
+validator :: Validator
-burnValidator = mkValidatorScript $$(PlutusTx.compile [|| mkBurnValidator ||])
+validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
 
-burnHash :: Ledger.ValidatorHash
+valHash :: Ledger.ValidatorHash
-burnHash = Scripts.validatorHash burnValidator
+valHash = Scripts.validatorHash validator
 
-burnAddress :: Ledger.Address
+scrAddress :: Ledger.Address
-burnAddress = ScriptAddress burnHash
+scrAddress = ScriptAddress valHash
 
-type BurnSchema =
+type GiftSchema =
     BlockchainActions
-        .\/ Endpoint "burn" Integer
+        .\/ Endpoint "give" Integer
         .\/ Endpoint "grab" ()
 
-burn :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
+give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
-burn amount = do
+give amount = do
-    let tx = mustPayToOtherScript burnHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
+    let tx = mustPayToOtherScript valHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
     ledgerTx <- submitTx tx
     void $ awaitTxConfirmed $ txId ledgerTx
-    logInfo @String $ printf "burnt %d lovelace" amount
+    logInfo @String $ printf "made a gift of %d lovelace" amount
 
 grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => Contract w s e ()
 grab = do
-    utxos <- utxoAt $ ScriptAddress burnHash
+    utxos <- utxoAt scrAddress
     let orefs   = fst <$> Map.toList utxos
         lookups = Constraints.unspentOutputs utxos      <>
-                  Constraints.otherScript burnValidator
+                  Constraints.otherScript validator
         tx :: TxConstraints Void Void
         tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ I 17 | oref <- orefs]
     ledgerTx <- submitTxConstraintsWith @Void lookups tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ "collected gifts"
 
-endpoints :: Contract () BurnSchema Text ()
+endpoints :: Contract () GiftSchema Text ()
 endpoints = (give' `select` grab') >> endpoints
   where
-    give' = endpoint @"burn" >>= burn
+    give' = endpoint @"give" >>= give
     grab' = endpoint @"grab" >>  grab
 
-mkSchemaDefinitions ''BurnSchema
+mkSchemaDefinitions ''GiftSchema
 
 mkKnownCurrencies []

code/week02/src/Week02/FortyTwo.hs

@@ -8,18 +8,7 @@
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 
-module Week02.FortyTwo
+module Week02.FortyTwo where
-    ( give
-    , grab
-    , FortyTwoSchema
-    , endpoints
-    , schemas
-    , registeredKnownCurrencies
-    , printJson
-    , printSchemas
-    , ensureKnownCurrencies
-    , stage
-    ) where
 
 import           Control.Monad       hiding (fmap)
 import           Data.Map            as Map
@@ -39,51 +28,51 @@ import           Playground.Types    (KnownCurrency (..))
 import           Prelude             (Semigroup (..))
 import           Text.Printf         (printf)
 
-{-# INLINABLE mkFortyTwoValidator #-}
+{-# INLINABLE mkValidator #-}
-mkFortyTwoValidator :: Data -> Data -> Data -> ()
+mkValidator :: Data -> Data -> Data -> ()
-mkFortyTwoValidator _ (I n) _
+mkValidator _ r _
-    | n == 42                 = ()
+    | r == I 42 = ()
-mkFortyTwoValidator _ _     _ = traceError "UNEXPECTED REDEEMER!"
+    | otherwise = traceError "wrong redeemer"
 
-fortyTwoValidator :: Validator
+validator :: Validator
-fortyTwoValidator = mkValidatorScript $$(PlutusTx.compile [|| mkFortyTwoValidator ||])
+validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
 
-fortyTwoHash :: Ledger.ValidatorHash
+valHash :: Ledger.ValidatorHash
-fortyTwoHash = Scripts.validatorHash fortyTwoValidator
+valHash = Scripts.validatorHash validator
 
-fortyTwoAddress :: Ledger.Address
+scrAddress :: Ledger.Address
-fortyTwoAddress = ScriptAddress fortyTwoHash
+scrAddress = ScriptAddress valHash
 
-type FortyTwoSchema =
+type GiftSchema =
     BlockchainActions
         .\/ Endpoint "give" Integer
         .\/ Endpoint "grab" Integer
 
 give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 give amount = do
-    let tx = mustPayToOtherScript fortyTwoHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
+    let tx = mustPayToOtherScript valHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
     ledgerTx <- submitTx tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ printf "made a gift of %d lovelace" amount
 
 grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 grab r = do
-    utxos <- utxoAt $ ScriptAddress fortyTwoHash
+    utxos <- utxoAt scrAddress
     let orefs   = fst <$> Map.toList utxos
         lookups = Constraints.unspentOutputs utxos      <>
-                  Constraints.otherScript fortyTwoValidator
+                  Constraints.otherScript validator
         tx :: TxConstraints Void Void
         tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ I r | oref <- orefs]
     ledgerTx <- submitTxConstraintsWith @Void lookups tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ "collected gifts"
 
-endpoints :: Contract () FortyTwoSchema Text ()
+endpoints :: Contract () GiftSchema Text ()
 endpoints = (give' `select` grab') >> endpoints
   where
     give' = endpoint @"give" >>= give
     grab' = endpoint @"grab" >>= grab
 
-mkSchemaDefinitions ''FortyTwoSchema
+mkSchemaDefinitions ''GiftSchema
 
 mkKnownCurrencies []

code/week02/src/Week02/Gift.hs

@@ -7,18 +7,7 @@
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 
-module Week02.Gift
+module Week02.Gift where
-    ( give
-    , grab
-    , GiftSchema
-    , endpoints
-    , schemas
-    , registeredKnownCurrencies
-    , printJson
-    , printSchemas
-    , ensureKnownCurrencies
-    , stage
-    ) where
 
 import           Control.Monad       hiding (fmap)
 import           Data.Map            as Map
@@ -38,18 +27,18 @@ import           Playground.Types    (KnownCurrency (..))
 import           Prelude             (Semigroup (..))
 import           Text.Printf         (printf)
 
-{-# INLINABLE mkGiftValidator #-}
+{-# INLINABLE mkValidator #-}
-mkGiftValidator :: Data -> Data -> Data -> ()
+mkValidator :: Data -> Data -> Data -> ()
-mkGiftValidator _ _ _ = ()
+mkValidator _ _ _ = ()
 
-giftValidator :: Validator
+validator :: Validator
-giftValidator = mkValidatorScript $$(PlutusTx.compile [|| mkGiftValidator ||])
+validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
 
-giftHash :: Ledger.ValidatorHash
+valHash :: Ledger.ValidatorHash
-giftHash = Scripts.validatorHash giftValidator
+valHash = Scripts.validatorHash validator
 
-giftAddress :: Ledger.Address
+scrAddress :: Ledger.Address
-giftAddress = ScriptAddress giftHash
+scrAddress = ScriptAddress valHash
 
 type GiftSchema =
     BlockchainActions
@@ -58,17 +47,17 @@ type GiftSchema =
 
 give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 give amount = do
-    let tx = mustPayToOtherScript giftHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
+    let tx = mustPayToOtherScript valHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
     ledgerTx <- submitTx tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ printf "made a gift of %d lovelace" amount
 
 grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => Contract w s e ()
 grab = do
-    utxos <- utxoAt $ ScriptAddress giftHash
+    utxos <- utxoAt scrAddress
     let orefs   = fst <$> Map.toList utxos
         lookups = Constraints.unspentOutputs utxos      <>
-                  Constraints.otherScript giftValidator
+                  Constraints.otherScript validator
         tx :: TxConstraints Void Void
         tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ I 17 | oref <- orefs]
     ledgerTx <- submitTxConstraintsWith @Void lookups tx

code/week02/src/Week02/Homework1.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+
+module Week02.Homework1 where
+
+import           Control.Monad        hiding (fmap)
+import           Data.Map             as Map
+import           Data.Text            (Text)
+import           Data.Void            (Void)
+import           Plutus.Contract      hiding (when)
+import           PlutusTx             (Data (..))
+import qualified PlutusTx
+import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
+import           Ledger               hiding (singleton)
+import           Ledger.Constraints   as Constraints
+import qualified Ledger.Scripts       as Scripts
+import qualified Ledger.Typed.Scripts as Scripts
+import           Ledger.Ada           as Ada
+import           Playground.Contract  (printJson, printSchemas, ensureKnownCurrencies, stage)
+import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
+import           Playground.Types     (KnownCurrency (..))
+import           Prelude              (Semigroup (..))
+import           Text.Printf          (printf)
+
+{-# INLINABLE mkValidator #-}
+-- This should validate if and only if the two Booleans in the redeemer are equal!
+mkValidator :: () -> (Bool, Bool) -> ValidatorCtx -> Bool
+mkValidator _ _ _ = True -- FIX ME!
+
+data Typed
+instance Scripts.ScriptType Typed where
+-- Implement the instance!
+
+inst :: Scripts.ScriptInstance Typed
+inst = undefined -- FIX ME!
+
+validator :: Validator
+validator = undefined -- FIX ME!
+
+valHash :: Ledger.ValidatorHash
+valHash = undefined -- FIX ME!
+
+scrAddress :: Ledger.Address
+scrAddress = undefined -- FIX ME!
+
+type GiftSchema =
+    BlockchainActions
+        .\/ Endpoint "give" Integer
+        .\/ Endpoint "grab" (Bool, Bool)
+
+give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
+give amount = do
+    let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount
+    ledgerTx <- submitTxConstraints inst tx
+    void $ awaitTxConfirmed $ txId ledgerTx
+    logInfo @String $ printf "made a gift of %d lovelace" amount
+
+grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => (Bool, Bool) -> Contract w s e ()
+grab bs = do
+    utxos <- utxoAt scrAddress
+    let orefs   = fst <$> Map.toList utxos
+        lookups = Constraints.unspentOutputs utxos      <>
+                  Constraints.otherScript validator
+        tx :: TxConstraints Void Void
+        tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData bs | oref <- orefs]
+    ledgerTx <- submitTxConstraintsWith @Void lookups tx
+    void $ awaitTxConfirmed $ txId ledgerTx
+    logInfo @String $ "collected gifts"
+
+endpoints :: Contract () GiftSchema Text ()
+endpoints = (give' `select` grab') >> endpoints
+  where
+    give' = endpoint @"give" >>= give
+    grab' = endpoint @"grab" >>= grab
+
+mkSchemaDefinitions ''GiftSchema
+
+mkKnownCurrencies []

code/week02/src/Week02/Homework2.hs

@@ -0,0 +1,96 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveAnyClass      #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+
+module Week02.Homework2 where
+
+import           Control.Monad        hiding (fmap)
+import           Data.Aeson           (FromJSON, ToJSON)
+import           Data.Map             as Map
+import           Data.Text            (Text)
+import           Data.Void            (Void)
+import           GHC.Generics         (Generic)
+import           Plutus.Contract      hiding (when)
+import           PlutusTx             (Data (..))
+import qualified PlutusTx
+import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
+import           Ledger               hiding (singleton)
+import           Ledger.Constraints   as Constraints
+import qualified Ledger.Scripts       as Scripts
+import qualified Ledger.Typed.Scripts as Scripts
+import           Ledger.Ada           as Ada
+import           Playground.Contract  (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
+import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
+import           Playground.Types     (KnownCurrency (..))
+import           Prelude              (Semigroup (..))
+import           Text.Printf          (printf)
+
+data MyRedeemer = MyRedeemer
+    { flag1 :: Bool
+    , flag2 :: Bool
+    } deriving (Generic, FromJSON, ToJSON, ToSchema)
+
+PlutusTx.unstableMakeIsData ''MyRedeemer
+
+{-# INLINABLE mkValidator #-}
+-- This should validate if and only if the two Booleans in the redeemer are equal!
+mkValidator :: () -> MyRedeemer -> ValidatorCtx -> Bool
+mkValidator _ _ _ = True -- FIX ME!
+
+data Typed
+instance Scripts.ScriptType Typed where
+    -- Implement me!
+
+inst :: Scripts.ScriptInstance Typed
+inst = undefined -- FIX ME!
+
+validator :: Validator
+validator = undefined -- FIX ME!
+
+valHash :: Ledger.ValidatorHash
+valHash = undefined -- FIX ME!
+
+scrAddress :: Ledger.Address
+scrAddress = undefined -- FIX ME!
+
+type GiftSchema =
+    BlockchainActions
+        .\/ Endpoint "give" Integer
+        .\/ Endpoint "grab" MyRedeemer
+
+give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
+give amount = do
+    let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount
+    ledgerTx <- submitTxConstraints inst tx
+    void $ awaitTxConfirmed $ txId ledgerTx
+    logInfo @String $ printf "made a gift of %d lovelace" amount
+
+grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => MyRedeemer -> Contract w s e ()
+grab r = do
+    utxos <- utxoAt scrAddress
+    let orefs   = fst <$> Map.toList utxos
+        lookups = Constraints.unspentOutputs utxos      <>
+                  Constraints.otherScript validator
+        tx :: TxConstraints Void Void
+        tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData r | oref <- orefs]
+    ledgerTx <- submitTxConstraintsWith @Void lookups tx
+    void $ awaitTxConfirmed $ txId ledgerTx
+    logInfo @String $ "collected gifts"
+
+endpoints :: Contract () GiftSchema Text ()
+endpoints = (give' `select` grab') >> endpoints
+  where
+    give' = endpoint @"give" >>= give
+    grab' = endpoint @"grab" >>= grab
+
+mkSchemaDefinitions ''GiftSchema
+
+mkKnownCurrencies []

code/week02/src/Week02/IsData.hs

@@ -0,0 +1,94 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+
+module Week02.IsData where
+
+import           Control.Monad        hiding (fmap)
+import           Data.Map             as Map
+import           Data.Text            (Text)
+import           Data.Void            (Void)
+import           Plutus.Contract      hiding (when)
+import           PlutusTx             (Data (..))
+import qualified PlutusTx
+import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
+import           Ledger               hiding (singleton)
+import           Ledger.Constraints   as Constraints
+import qualified Ledger.Scripts       as Scripts
+import qualified Ledger.Typed.Scripts as Scripts
+import           Ledger.Ada           as Ada
+import           Playground.Contract  (printJson, printSchemas, ensureKnownCurrencies, stage)
+import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
+import           Playground.Types     (KnownCurrency (..))
+import           Prelude              (Semigroup (..))
+import           Text.Printf          (printf)
+
+newtype MySillyRedeemer = MySillyRedeemer Integer
+    deriving Show
+
+PlutusTx.unstableMakeIsData ''MySillyRedeemer
+
+{-# INLINABLE mkValidator #-}
+mkValidator :: () -> MySillyRedeemer -> ValidatorCtx -> Bool
+mkValidator () (MySillyRedeemer r) _ = traceIfFalse "wrong redeemer" $ r == 42
+
+data Typed
+instance Scripts.ScriptType Typed where
+    type instance DatumType Typed = ()
+    type instance RedeemerType Typed = MySillyRedeemer
+
+inst :: Scripts.ScriptInstance Typed
+inst = Scripts.validator @Typed
+    $$(PlutusTx.compile [|| mkValidator ||])
+    $$(PlutusTx.compile [|| wrap ||])
+  where
+    wrap = Scripts.wrapValidator @() @MySillyRedeemer
+
+validator :: Validator
+validator = Scripts.validatorScript inst
+
+valHash :: Ledger.ValidatorHash
+valHash = Scripts.validatorHash validator
+
+scrAddress :: Ledger.Address
+scrAddress = ScriptAddress valHash
+
+type GiftSchema =
+    BlockchainActions
+        .\/ Endpoint "give" Integer
+        .\/ Endpoint "grab" Integer
+
+give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
+give amount = do
+    let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount
+    ledgerTx <- submitTxConstraints inst tx
+    void $ awaitTxConfirmed $ txId ledgerTx
+    logInfo @String $ printf "made a gift of %d lovelace" amount
+
+grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
+grab r = do
+    utxos <- utxoAt scrAddress
+    let orefs   = fst <$> Map.toList utxos
+        lookups = Constraints.unspentOutputs utxos      <>
+                  Constraints.otherScript validator
+        tx :: TxConstraints Void Void
+        tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData $ MySillyRedeemer r | oref <- orefs]
+    ledgerTx <- submitTxConstraintsWith @Void lookups tx
+    void $ awaitTxConfirmed $ txId ledgerTx
+    logInfo @String $ "collected gifts"
+
+endpoints :: Contract () GiftSchema Text ()
+endpoints = (give' `select` grab') >> endpoints
+  where
+    give' = endpoint @"give" >>= give
+    grab' = endpoint @"grab" >>= grab
+
+mkSchemaDefinitions ''GiftSchema
+
+mkKnownCurrencies []

code/week02/src/Week02/Parameterized.hs

@@ -1,119 +0,0 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveAnyClass      #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE TypeApplications    #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
-
-module Week02.Parameterized
-    ( give
-    , grab
-    , ParameterizedSchema
-    , endpoints
-    , schemas
-    , registeredKnownCurrencies
-    , printJson
-    , printSchemas
-    , ensureKnownCurrencies
-    , stage
-    ) where
-
-import           Control.Monad        hiding (fmap)
-import           Data.Aeson           (ToJSON, FromJSON)
-import           Data.Map             as Map
-import           Data.Text            (Text)
-import           Data.Void            (Void)
-import           GHC.Generics         (Generic)
-import           Plutus.Contract      hiding (when)
-import           PlutusTx             (Data (..))
-import qualified PlutusTx
-import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
-import           Ledger               hiding (singleton)
-import           Ledger.Constraints   as Constraints
-import qualified Ledger.Scripts       as Scripts
-import qualified Ledger.Typed.Scripts as Scripts
-import           Ledger.Ada           as Ada
-import           Playground.Contract  (printJson, printSchemas, ensureKnownCurrencies, stage)
-import           Playground.TH        (mkKnownCurrencies, mkSchemaDefinitions)
-import           Playground.Types     (KnownCurrency (..))
-import           Prelude              (Semigroup (..))
-import           Schema               (ToSchema)
-import           Text.Printf          (printf)
-
-{-# INLINABLE mkParameterizedValidator #-}
-mkParameterizedValidator :: Integer -> () -> Integer -> ValidatorCtx -> Bool
-mkParameterizedValidator r () n _ = traceIfFalse "UNEXPECTED REDEEMER" (n == r)
-
-data Parameterizing
-instance Scripts.ScriptType Parameterizing where
-    type instance RedeemerType Parameterizing = Integer
-    type instance DatumType Parameterizing = ()
-
-parameterizedInstance :: Integer -> Scripts.ScriptInstance Parameterizing
-parameterizedInstance r = Scripts.validator @Parameterizing
-    ($$(PlutusTx.compile [|| mkParameterizedValidator ||])
-        `PlutusTx.applyCode`
-            PlutusTx.liftCode r)
-    $$(PlutusTx.compile [|| wrap ||])
-  where
-    wrap = Scripts.wrapValidator @() @Integer
-
-parameterizedValidator :: Integer -> Validator
-parameterizedValidator = Scripts.validatorScript . parameterizedInstance
-
-parameterizedHash :: Integer -> Ledger.ValidatorHash
-parameterizedHash = Scripts.validatorHash . parameterizedValidator
-
-parameterizedAddress :: Integer -> Ledger.Address
-parameterizedAddress = ScriptAddress . parameterizedHash
-
-type ParameterizedSchema =
-    BlockchainActions
-        .\/ Endpoint "give" GiveParams
-        .\/ Endpoint "grab" GrabParams
-
-data GiveParams = GiveParams
-    { giveAmount    :: Integer
-    , giveParameter :: Integer
-    } deriving (Generic, ToJSON, FromJSON, ToSchema)
-
-data GrabParams = GrabParams
-    { grabParameter :: Integer
-    , grabRedeemer  :: Integer
-    } deriving (Generic, ToJSON, FromJSON, ToSchema)
-
-give :: (HasBlockchainActions s, AsContractError e) => GiveParams -> Contract w s e ()
-give p = do
-    let amount = giveAmount p
-    let tx     = mustPayToTheScript () $ Ada.lovelaceValueOf amount
-    ledgerTx <- submitTxConstraints (parameterizedInstance $ giveParameter p) tx
-    void $ awaitTxConfirmed $ txId ledgerTx
-    logInfo @String $ printf "made a gift of %d lovelace" amount
-
-grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => GrabParams -> Contract w s e ()
-grab p = do
-    let par = grabParameter p
-    utxos <- utxoAt $ ScriptAddress $ parameterizedHash par
-    let orefs   = fst <$> Map.toList utxos
-        lookups = Constraints.unspentOutputs utxos <>
-                  Constraints.otherScript (parameterizedValidator par)
-        tx :: TxConstraints Void Void
-        tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ I $ grabRedeemer p | oref <- orefs]
-    ledgerTx <- submitTxConstraintsWith @Void lookups tx
-    void $ awaitTxConfirmed $ txId ledgerTx
-    logInfo @String $ "collected gifts"
-
-endpoints :: Contract () ParameterizedSchema Text ()
-endpoints = (give' `select` grab') >> endpoints
-  where
-    give' = endpoint @"give" >>= give
-    grab' = endpoint @"grab" >>= grab
-
-mkSchemaDefinitions ''ParameterizedSchema
-
-mkKnownCurrencies []

code/week02/src/Week02/Typed.hs

@@ -8,18 +8,7 @@
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 
-module Week02.Typed
+module Week02.Typed where
-    ( give
-    , grab
-    , TypedSchema
-    , endpoints
-    , schemas
-    , registeredKnownCurrencies
-    , printJson
-    , printSchemas
-    , ensureKnownCurrencies
-    , stage
-    ) where
 
 import           Control.Monad        hiding (fmap)
 import           Data.Map             as Map
@@ -40,32 +29,34 @@ import           Playground.Types     (KnownCurrency (..))
 import           Prelude              (Semigroup (..))
 import           Text.Printf          (printf)
 
-{-# INLINABLE mkTypedValidator #-}
+{-# INLINABLE mkValidator #-}
-mkTypedValidator :: () -> Integer -> ValidatorCtx -> Bool
+mkValidator :: () -> Integer -> ValidatorCtx -> Bool
-mkTypedValidator () n _ = traceIfFalse "UNEXPECTED REDEEMER" (n == 42)
+mkValidator () r _
+    | r == 42   = True
+    | otherwise = False
 
-data Typing
+data Typed
-instance Scripts.ScriptType Typing where
+instance Scripts.ScriptType Typed where
-    type instance RedeemerType Typing = Integer
+    type instance DatumType Typed = ()
-    type instance DatumType Typing = ()
+    type instance RedeemerType Typed = Integer
 
-typedInstance :: Scripts.ScriptInstance Typing
+inst :: Scripts.ScriptInstance Typed
-typedInstance = Scripts.validator @Typing
+inst = Scripts.validator @Typed
-    $$(PlutusTx.compile [|| mkTypedValidator ||])
+    $$(PlutusTx.compile [|| mkValidator ||])
     $$(PlutusTx.compile [|| wrap ||])
   where
     wrap = Scripts.wrapValidator @() @Integer
 
-typedValidator :: Validator
+validator :: Validator
-typedValidator = Scripts.validatorScript typedInstance
+validator = Scripts.validatorScript inst
 
-typedHash :: Ledger.ValidatorHash
+valHash :: Ledger.ValidatorHash
-typedHash = Scripts.validatorHash typedValidator
+valHash = Scripts.validatorHash validator
 
-typedAddress :: Ledger.Address
+scrAddress :: Ledger.Address
-typedAddress = ScriptAddress typedHash
+scrAddress = ScriptAddress valHash
 
-type TypedSchema =
+type GiftSchema =
     BlockchainActions
         .\/ Endpoint "give" Integer
         .\/ Endpoint "grab" Integer
@@ -73,28 +64,28 @@ type TypedSchema =
 give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 give amount = do
     let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount
-    ledgerTx <- submitTxConstraints typedInstance tx
+    ledgerTx <- submitTxConstraints inst tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ printf "made a gift of %d lovelace" amount
 
 grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 grab r = do
-    utxos <- utxoAt $ ScriptAddress typedHash
+    utxos <- utxoAt scrAddress
     let orefs   = fst <$> Map.toList utxos
         lookups = Constraints.unspentOutputs utxos      <>
-                  Constraints.otherScript typedValidator
+                  Constraints.otherScript validator
         tx :: TxConstraints Void Void
         tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ I r | oref <- orefs]
     ledgerTx <- submitTxConstraintsWith @Void lookups tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ "collected gifts"
 
-endpoints :: Contract () TypedSchema Text ()
+endpoints :: Contract () GiftSchema Text ()
 endpoints = (give' `select` grab') >> endpoints
   where
     give' = endpoint @"give" >>= give
     grab' = endpoint @"grab" >>= grab
 
-mkSchemaDefinitions ''TypedSchema
+mkSchemaDefinitions ''GiftSchema
 
 mkKnownCurrencies []