Playground error

README.md

This is the "fix" (diff between DoesntWork and Works): https://imgur.com/a/mtRPItY

DoesntWork.hs

-- DOESNT WORK
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Tutorial.Solutions0 where

import           Data.Foldable                (traverse_)
import qualified Language.PlutusTx            as P
import qualified Ledger.Interval              as P
import           Ledger                       (Address, DataScript(..), PubKey(..), RedeemerScript(..), Signature(..), Slot(..), TxId, ValidatorScript(..))
import qualified Ledger                       as L
import qualified Ledger.Ada.TH                as Ada
import           Ledger.Ada.TH                (Ada)
import qualified Ledger.Interval              as Interval
import           Ledger.Validation            (PendingTx(..), PendingTxIn(..), PendingTxOut)
import qualified Ledger.Validation            as V
import           Wallet                       (WalletAPI(..), WalletDiagnostics(..), MonadWallet, EventHandler(..), EventTrigger)
import qualified Wallet                       as W
import           Prelude                      hiding ((&&))
import           GHC.Generics                 (Generic)
import Playground.Contract
data CampaignTarget = CampaignTarget Slot Ada
    deriving (Generic, ToJSON, FromJSON, ToSchema)
P.makeLift ''CampaignTarget

data Campaign = Campaign {
      fundingTargets     :: CampaignTarget, --[CampaignTarget],
      collectionDeadline :: Slot,
      campaignOwner      :: PubKey
 } deriving (Generic, ToJSON, FromJSON, ToSchema)

P.makeLift ''Campaign

data CampaignAction = Collect Signature | Refund Signature
P.makeLift ''CampaignAction

data Contributor = Contributor PubKey
P.makeLift ''Contributor

mkValidatorScript :: Campaign -> ValidatorScript
mkValidatorScript campaign = ValidatorScript val where
  val = L.applyScript mkValidator (L.lifted campaign)
  mkValidator = L.fromCompiledCode $$(P.compile [||
              \(c :: Campaign) (con :: Contributor) (act :: CampaignAction) (p :: PendingTx) -> 
      let
                isValid = case act of
                    Collect _ -> True
                    Refund  _ -> True

      in if isValid then () else ($$(P.error) ()) ||])

campaignAddress :: Campaign -> Address
campaignAddress cmp = L.scriptAddress (mkValidatorScript cmp)

mkDataScript :: PubKey -> DataScript
mkDataScript pk = DataScript (L.lifted (Contributor pk))

mkRedeemer :: CampaignAction -> RedeemerScript
mkRedeemer action = RedeemerScript (L.lifted action)

refundHandler :: MonadWallet m => TxId -> Campaign -> EventHandler m
refundHandler txid cmp = EventHandler (\_ -> do
    W.logMsg "Claiming refund"
    sig <- W.ownSignature
    currentSlot <- W.slot
    let redeemer  = mkRedeemer (Refund sig)
        range     = W.intervalFrom currentSlot
    W.collectFromScriptTxn range (mkValidatorScript cmp) redeemer txid)

refundTrigger :: Campaign -> EventTrigger
refundTrigger c = W.andT
    (W.fundsAtAddressT (campaignAddress c) (W.intervalFrom ($$(Ada.toValue) 1)))
    (W.slotRangeT (W.intervalFrom (collectionDeadline c)))

contribute :: MonadWallet m => Campaign -> Ada -> m ()
contribute cmp adaAmount = do
        pk <- W.ownPubKey
        let dataScript = mkDataScript pk
            amount = $$(Ada.toValue) adaAmount

        -- payToScript returns the transaction that was submitted
        -- (unlike payToScript_ which returns unit)
        tx <- W.payToScript W.defaultSlotRange (campaignAddress cmp) amount dataScript
        W.logMsg "Submitted contribution"

        -- L.hashTx gives the `TxId` of a transaction
        let txId = L.hashTx tx

        W.register (refundTrigger cmp) (refundHandler txId cmp)
        W.logMsg "Registered refund trigger"

{-

    We will define a collection trigger for each '(Slot, Ada)' entry in the 
    'fundingTargets' list. This trigger fires if the specified amount has been
    contributed before the slot.

    That means we collect the funds as soon as the validator script allows it.

-}
mkCollectTrigger :: Address -> Slot -> Ada -> EventTrigger
mkCollectTrigger addr sl target = W.andT
    -- We use `W.intervalFrom` to create an open-ended interval that starts 
    -- at the funding target.
    (W.fundsAtAddressT addr (W.intervalFrom ($$(Ada.toValue) target)))
    -- With `W.intervalTo` we create an interval from now to the target slot 'sl'
    (W.slotRangeT (W.intervalTo sl))

{- 
    Each '(Slot, Ada)' entry in 'fundingTargets' also gets its own handler. In 
    the handler we create a transaction that must be validated before the slot,
    using 'W.interval'
-}
collectionHandler :: MonadWallet m => Campaign -> Slot -> EventHandler m
collectionHandler cmp targetSlot = EventHandler (\_ -> do
    W.logMsg "Collecting funds"
    sig <- W.ownSignature
    currentSlot <- W.slot
    let redeemerScript = mkRedeemer (Collect sig)
        range          = W.interval currentSlot targetSlot
    W.collectFromScript range (mkValidatorScript cmp) redeemerScript)

scheduleCollection :: MonadWallet m => Campaign -> m ()
scheduleCollection cmp = 
    let 
        addr = campaignAddress cmp
        ts = (CampaignTarget 10 10) --fundingTargets cmp 
        regTarget (CampaignTarget targetSlot ada) = W.register (mkCollectTrigger addr targetSlot ada) (collectionHandler cmp targetSlot)
    in
    traverse_ regTarget [ts]

$(mkFunctions ['scheduleCollection, 'contribute])

Works2.hs

-- WORKS
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Tutorial.Solutions0 where

import           Data.Foldable                (traverse_)
import qualified Language.PlutusTx            as P
import qualified Ledger.Interval              as P
import           Ledger                       (Address, DataScript(..), PubKey(..), RedeemerScript(..), Signature(..), Slot(..), TxId, ValidatorScript(..))
import qualified Ledger                       as L
import qualified Ledger.Ada.TH                as Ada
import           Ledger.Ada.TH                (Ada)
import qualified Ledger.Interval              as Interval
import           Ledger.Validation            (PendingTx(..), PendingTxIn(..), PendingTxOut)
import qualified Ledger.Validation            as V
import           Wallet                       (WalletAPI(..), WalletDiagnostics(..), MonadWallet, EventHandler(..), EventTrigger)
import qualified Wallet                       as W
import           Prelude                      hiding ((&&))
import           GHC.Generics                 (Generic)
import Playground.Contract
data CampaignTarget = CampaignTarget Slot Ada
    deriving (Generic, ToJSON, FromJSON, ToSchema)
P.makeLift ''CampaignTarget

data Campaign = Campaign {
      fundingTargets     :: CampaignTarget, --[CampaignTarget],
      collectionDeadline :: Slot,
      campaignOwner      :: PubKey
 } deriving (Generic, ToJSON, FromJSON, ToSchema)

P.makeLift ''Campaign

data CampaignAction = Collect Signature | Refund Signature
P.makeLift ''CampaignAction

data Contributor = Contributor PubKey
P.makeLift ''Contributor

mkValidatorScript :: Campaign -> ValidatorScript
mkValidatorScript campaign = ValidatorScript val where
  val = L.applyScript mkValidator (L.lifted campaign)
  mkValidator = L.fromCompiledCode $$(P.compile [||
              \(c :: Campaign) (con :: Contributor) (act :: CampaignAction) (p :: PendingTx) -> 
      let
                isValid = True -- case act of
                    -- Collect _ -> True
                    -- Refund  _ -> True

      in if isValid then () else ($$(P.error) ()) ||])

campaignAddress :: Campaign -> Address
campaignAddress cmp = L.scriptAddress (mkValidatorScript cmp)

mkDataScript :: PubKey -> DataScript
mkDataScript pk = DataScript (L.lifted (Contributor pk))

mkRedeemer :: CampaignAction -> RedeemerScript
mkRedeemer action = RedeemerScript (L.lifted action)

refundHandler :: MonadWallet m => TxId -> Campaign -> EventHandler m
refundHandler txid cmp = EventHandler (\_ -> do
    W.logMsg "Claiming refund"
    sig <- W.ownSignature
    currentSlot <- W.slot
    let redeemer  = mkRedeemer (Refund sig)
        range     = W.intervalFrom currentSlot
    W.collectFromScriptTxn range (mkValidatorScript cmp) redeemer txid)

refundTrigger :: Campaign -> EventTrigger
refundTrigger c = W.andT
    (W.fundsAtAddressT (campaignAddress c) (W.intervalFrom ($$(Ada.toValue) 1)))
    (W.slotRangeT (W.intervalFrom (collectionDeadline c)))

contribute :: MonadWallet m => Campaign -> Ada -> m ()
contribute cmp adaAmount = do
        pk <- W.ownPubKey
        let dataScript = mkDataScript pk
            amount = $$(Ada.toValue) adaAmount

        -- payToScript returns the transaction that was submitted
        -- (unlike payToScript_ which returns unit)
        tx <- W.payToScript W.defaultSlotRange (campaignAddress cmp) amount dataScript
        W.logMsg "Submitted contribution"

        -- L.hashTx gives the `TxId` of a transaction
        let txId = L.hashTx tx

        W.register (refundTrigger cmp) (refundHandler txId cmp)
        W.logMsg "Registered refund trigger"

{-

    We will define a collection trigger for each '(Slot, Ada)' entry in the 
    'fundingTargets' list. This trigger fires if the specified amount has been
    contributed before the slot.

    That means we collect the funds as soon as the validator script allows it.

-}
mkCollectTrigger :: Address -> Slot -> Ada -> EventTrigger
mkCollectTrigger addr sl target = W.andT
    -- We use `W.intervalFrom` to create an open-ended interval that starts 
    -- at the funding target.
    (W.fundsAtAddressT addr (W.intervalFrom ($$(Ada.toValue) target)))
    -- With `W.intervalTo` we create an interval from now to the target slot 'sl'
    (W.slotRangeT (W.intervalTo sl))

{- 
    Each '(Slot, Ada)' entry in 'fundingTargets' also gets its own handler. In 
    the handler we create a transaction that must be validated before the slot,
    using 'W.interval'
-}
collectionHandler :: MonadWallet m => Campaign -> Slot -> EventHandler m
collectionHandler cmp targetSlot = EventHandler (\_ -> do
    W.logMsg "Collecting funds"
    sig <- W.ownSignature
    currentSlot <- W.slot
    let redeemerScript = mkRedeemer (Collect sig)
        range          = W.interval currentSlot targetSlot
    W.collectFromScript range (mkValidatorScript cmp) redeemerScript)

scheduleCollection :: MonadWallet m => Campaign -> m ()
scheduleCollection cmp = 
    let 
        addr = campaignAddress cmp
        ts = (CampaignTarget 10 10) --fundingTargets cmp 
        regTarget (CampaignTarget targetSlot ada) = W.register (mkCollectTrigger addr targetSlot ada) (collectionHandler cmp targetSlot)
    in
    traverse_ regTarget [ts]

$(mkFunctions ['scheduleCollection, 'contribute])