FortyTwo contract

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

@@ -11,6 +11,7 @@ License-files:       LICENSE
 library
   hs-source-dirs:      src
   exposed-modules:     Week02.Burn
+                     , Week02.FortyTwo
                      , Week02.Gift
   build-depends:       aeson
                      , base ^>=4.14.1.0

code/week02/src/Week02/Burn.hs

@@ -11,6 +11,7 @@
 module Week02.Burn
     ( burn
     , grab
+    , BurnSchema
     , endpoints
     , schemas
     , registeredKnownCurrencies
@@ -51,14 +52,14 @@ giftHash = Scripts.validatorHash giftValidator
 giftAddress :: Ledger.Address
 giftAddress = ScriptAddress giftHash
 
-type GiftSchema =
+type BurnSchema =
     BlockchainActions
         .\/ Endpoint "burn" Integer
         .\/ Endpoint "grab" ()
 
 burn :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 burn amount = do
-    let tx = mustPayToOtherScript giftHash (Datum $ I 42) $ Ada.lovelaceValueOf amount
+    let tx = mustPayToOtherScript giftHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
     ledgerTx <- submitTx tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ printf "burnt %d lovelace" amount
@@ -75,12 +76,12 @@ grab = do
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ "collected gifts"
 
-endpoints :: Contract () GiftSchema Text ()
+endpoints :: Contract () BurnSchema Text ()
 endpoints = (give' `select` grab') >> endpoints
   where
     give' = endpoint @"burn" >>= burn
     grab' = endpoint @"grab" >>  grab
 
-mkSchemaDefinitions ''GiftSchema
+mkSchemaDefinitions ''BurnSchema
 
 mkKnownCurrencies []

code/week02/src/Week02/FortyTwo.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+
+module Week02.FortyTwo
+    ( give
+    , grab
+    , FortyTwoSchema
+    , endpoints
+    , schemas
+    , registeredKnownCurrencies
+    , printJson
+    , printSchemas
+    , ensureKnownCurrencies
+    , stage
+    ) 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           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 mkGiftValidator #-}
+mkGiftValidator :: Data -> Data -> Data -> ()
+mkGiftValidator _ (I n) _
+    | n == 42             = ()
+mkGiftValidator _ _     _ = traceError "UNEXPECTED REDEEMER!"
+
+giftValidator :: Validator
+giftValidator = mkValidatorScript $$(PlutusTx.compile [|| mkGiftValidator ||])
+
+giftHash :: Ledger.ValidatorHash
+giftHash = Scripts.validatorHash giftValidator
+
+giftAddress :: Ledger.Address
+giftAddress = ScriptAddress giftHash
+
+type FortyTwoSchema =
+    BlockchainActions
+        .\/ Endpoint "give" Integer
+        .\/ Endpoint "grab" Integer
+
+give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
+give amount = do
+    let tx = mustPayToOtherScript giftHash (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 giftHash
+    let orefs   = fst <$> Map.toList utxos
+        lookups = Constraints.unspentOutputs utxos      <>
+                  Constraints.otherScript giftValidator
+        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 = (give' `select` grab') >> endpoints
+  where
+    give' = endpoint @"give" >>= give
+    grab' = endpoint @"grab" >>= grab
+
+mkSchemaDefinitions ''FortyTwoSchema
+
+mkKnownCurrencies []

code/week02/src/Week02/Gift.hs

@@ -10,6 +10,7 @@
 module Week02.Gift
     ( give
     , grab
+    , GiftSchema
     , endpoints
     , schemas
     , registeredKnownCurrencies
@@ -57,7 +58,7 @@ type GiftSchema =
 
 give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
 give amount = do
-    let tx = mustPayToOtherScript giftHash (Datum $ I 42) $ Ada.lovelaceValueOf amount
+    let tx = mustPayToOtherScript giftHash (Datum $ Constr 0 []) $ Ada.lovelaceValueOf amount
     ledgerTx <- submitTx tx
     void $ awaitTxConfirmed $ txId ledgerTx
     logInfo @String $ printf "made a gift of %d lovelace" amount