Plutus Pioneer program: lecture 2, homework 2 annotated

homework2.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}

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
import qualified PlutusTx
import           PlutusTx.Prelude     hiding (Semigroup(..), unless)
import           Ledger               hiding (singleton)
import           Ledger.Constraints   as Constraints
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              (IO, Semigroup (..), String, undefined)
import           Text.Printf          (printf)

-- Custom redeemer type
data CustomRedeemer = CustomRedeemer {
    flag1 :: Bool,
    flag2 :: Bool
} deriving (Generic, FromJSON, ToJSON, ToSchema)

PlutusTx.unstableMakeIsData ''CustomRedeemer

-- define your own validation logic
{-# INLINABLE validator #-}
validator :: () -> CustomRedeemer -> ScriptContext -> Bool
validator _ (CustomRedeemer f1 f2) _ = traceIfFalse "wrong redemeer" f1 == f2


-- define a type to represent your validator
data ValidatorType
instance Scripts.ValidatorTypes ValidatorType where
    type instance DatumType ValidatorType = ()
    type instance RedeemerType ValidatorType = CustomRedeemer


-- compile your validator with the proper type information
typedValidator :: Scripts.TypedValidator ValidatorType
typedValidator = Scripts.mkTypedValidator @ValidatorType
    $$(PlutusTx.compile [|| validator ||])
    $$(PlutusTx.compile [|| wrap ||])
  where
    wrap = Scripts.wrapValidator @() @CustomRedeemer

-- calc the validator hash
validatorHash :: Ledger.ValidatorHash
validatorHash = Scripts.validatorHash typedValidator

-- make a validator script
validatorScript :: Validator
validatorScript = Scripts.validatorScript typedValidator

-- calc the validator address (which is a wrapper around the hash)
validatorScriptAddress :: Ledger.Address
validatorScriptAddress = scriptAddress validatorScript



give :: forall w s e. AsContractError e => Integer -> Contract w s e ()
give amount = do
    -- build a transaction that pays "amount" of lovelace to the contract
    let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount
    -- submit transaction and validate
    ledgerTx <- submitTxConstraints typedValidator tx
    -- await for the transaction to be confirmed (what does confirmation
    -- in cardano really mean? x blocks after this transaction was processed?)
    -- void tells haskell that we don't care about the return value of the following
    -- functions in the context of a monad (functor to be correct)
    void $ awaitTxConfirmed $ txId ledgerTx
    -- logs!
    logInfo @String $ printf "made a gift of %d lovelace" amount

grab :: forall w s e. AsContractError e => CustomRedeemer -> Contract w s e ()
grab r = do
    -- get all the utxos of our contract (in our case
    -- the amount of lovelace people have "give" to it
    utxos <- utxoAt validatorScriptAddress
    -- get a list of "references" for the utxos
    let orefs   = fst <$> Map.toList utxos
        -- ???
        lookups = Constraints.unspentOutputs utxos      <>
                  Constraints.otherScript validatorScript
        -- build the transaction
        -- it loos like we are building a list of utxos (refs) that are going to be grabbed by
        -- the address (person) that called this endpoint.
        -- TLDR: sum all utox available at the contract and let them be taken by the grabber
        tx :: TxConstraints Void Void
        tx      = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData r | oref <- orefs]
    -- submit the transaction, it looks like `lookups` is
    -- extra information we provide to the "built transaction"
    ledgerTx <- submitTxConstraintsWith @Void lookups tx
    -- await for the transaction to be done!
    void $ awaitTxConfirmed $ txId ledgerTx
    -- logs!
    logInfo @String $ "collected gifts"

-- lets define the contract interface
-- in our case we will be interacting with these "actions"
-- from the playground, and the playground itself acts like a
-- front end for the smart contract we are building
type GiftSchema =
            Endpoint "give" Integer
        .\/ Endpoint "grab" CustomRedeemer

mkSchemaDefinitions ''GiftSchema

-- hook up the endpoints
endpoints :: Contract () GiftSchema Text ()
endpoints = (give' `select` grab') >> endpoints
  where
    give' = endpoint @"give" >>= give
    grab' = endpoint @"grab" >>= grab


mkKnownCurrencies []