-- | Crowdfunding contract implemented using the [[Plutus]] interface.
-- This is the fully parallel version that collects all contributions
-- in a single transaction. This is, of course, limited by the maximum
-- number of inputs a transaction can have.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE ViewPatterns        #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:debug-context #-}

module Plutus.Contracts.Crowdfunding (
    -- * Campaign parameters
      Campaign(..)
    , CrowdfundingSchema
    , crowdfunding
    , theCampaign
    -- * Functionality for campaign contributors
    , contribute
    , Contribution(..)
    -- * Functionality for campaign owners
    , scheduleCollection
    , campaignAddress
    -- * Validator script
    , contributionScript
    , mkValidator
    , mkCampaign
    , CampaignAction(..)
    , collectionRange
    , refundRange
    -- * Traces
    , startCampaign
    , makeContribution
    , successfulCampaign
    ) where

import Control.Applicative (Applicative (..))
import Control.Monad (void)
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics (Generic)

import Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), Validator, getCardanoTxId)
import Ledger qualified
import Ledger.Ada qualified as Ada
import Ledger.Constraints qualified as Constraints
import Ledger.Contexts as V
import Ledger.Interval qualified as Interval
import Ledger.Scripts qualified as Scripts
import Ledger.TimeSlot qualified as TimeSlot
import Ledger.Typed.Scripts qualified as Scripts hiding (validatorHash)
import Ledger.Value (Value)
import Plutus.Contract
import Plutus.Contract.Typed.Tx qualified as Typed
import Plutus.Trace.Effects.EmulatorControl (getSlotConfig)
import Plutus.Trace.Emulator (ContractHandle, EmulatorTrace)
import Plutus.Trace.Emulator qualified as Trace
import PlutusTx qualified
import PlutusTx.Prelude hiding (Applicative (..), Semigroup (..), return, (<$>), (>>), (>>=))
import Prelude (Semigroup (..), (<$>), (>>=))
import Prelude qualified as Haskell
import Schema (ToArgument, ToSchema)
import Wallet.Emulator (Wallet (..), knownWallet)
import Wallet.Emulator qualified as Emulator

-- | A crowdfunding campaign.
data Campaign = Campaign
    { Campaign -> POSIXTime
campaignDeadline           :: POSIXTime
    -- ^ The date by which the campaign funds can be contributed.
    , Campaign -> POSIXTime
campaignCollectionDeadline :: POSIXTime
    -- ^ The date by which the campaign owner has to collect the funds
    , Campaign -> PaymentPubKeyHash
campaignOwner              :: PaymentPubKeyHash
    -- ^ Public key of the campaign owner. This key is entitled to retrieve the
    --   funds if the campaign is successful.
    } deriving ((forall x. Campaign -> Rep Campaign x)
-> (forall x. Rep Campaign x -> Campaign) -> Generic Campaign
forall x. Rep Campaign x -> Campaign
forall x. Campaign -> Rep Campaign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Campaign x -> Campaign
$cfrom :: forall x. Campaign -> Rep Campaign x
Generic, [Campaign] -> Encoding
[Campaign] -> Value
Campaign -> Encoding
Campaign -> Value
(Campaign -> Value)
-> (Campaign -> Encoding)
-> ([Campaign] -> Value)
-> ([Campaign] -> Encoding)
-> ToJSON Campaign
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Campaign] -> Encoding
$ctoEncodingList :: [Campaign] -> Encoding
toJSONList :: [Campaign] -> Value
$ctoJSONList :: [Campaign] -> Value
toEncoding :: Campaign -> Encoding
$ctoEncoding :: Campaign -> Encoding
toJSON :: Campaign -> Value
$ctoJSON :: Campaign -> Value
ToJSON, Value -> Parser [Campaign]
Value -> Parser Campaign
(Value -> Parser Campaign)
-> (Value -> Parser [Campaign]) -> FromJSON Campaign
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Campaign]
$cparseJSONList :: Value -> Parser [Campaign]
parseJSON :: Value -> Parser Campaign
$cparseJSON :: Value -> Parser Campaign
FromJSON, FormSchema
FormSchema -> ToSchema Campaign
forall a. FormSchema -> ToSchema a
toSchema :: FormSchema
$ctoSchema :: FormSchema
ToSchema, Int -> Campaign -> ShowS
[Campaign] -> ShowS
Campaign -> String
(Int -> Campaign -> ShowS)
-> (Campaign -> String) -> ([Campaign] -> ShowS) -> Show Campaign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Campaign] -> ShowS
$cshowList :: [Campaign] -> ShowS
show :: Campaign -> String
$cshow :: Campaign -> String
showsPrec :: Int -> Campaign -> ShowS
$cshowsPrec :: Int -> Campaign -> ShowS
Haskell.Show)

PlutusTx.makeLift ''Campaign

-- | Action that can be taken by the participants in this contract. A value of
--   `CampaignAction` is provided as the redeemer. The validator script then
--   checks if the conditions for performing this action are met.
--
data CampaignAction = Collect | Refund

PlutusTx.unstableMakeIsData ''CampaignAction
PlutusTx.makeLift ''CampaignAction

type CrowdfundingSchema =
    Endpoint "schedule collection" ()
    .\/ Endpoint "contribute" Contribution

newtype Contribution = Contribution
        { Contribution -> Value
contribValue :: Value
        -- ^ how much to contribute
        } deriving stock (Contribution -> Contribution -> Bool
(Contribution -> Contribution -> Bool)
-> (Contribution -> Contribution -> Bool) -> Eq Contribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contribution -> Contribution -> Bool
$c/= :: Contribution -> Contribution -> Bool
== :: Contribution -> Contribution -> Bool
$c== :: Contribution -> Contribution -> Bool
Haskell.Eq, Int -> Contribution -> ShowS
[Contribution] -> ShowS
Contribution -> String
(Int -> Contribution -> ShowS)
-> (Contribution -> String)
-> ([Contribution] -> ShowS)
-> Show Contribution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contribution] -> ShowS
$cshowList :: [Contribution] -> ShowS
show :: Contribution -> String
$cshow :: Contribution -> String
showsPrec :: Int -> Contribution -> ShowS
$cshowsPrec :: Int -> Contribution -> ShowS
Haskell.Show, (forall x. Contribution -> Rep Contribution x)
-> (forall x. Rep Contribution x -> Contribution)
-> Generic Contribution
forall x. Rep Contribution x -> Contribution
forall x. Contribution -> Rep Contribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Contribution x -> Contribution
$cfrom :: forall x. Contribution -> Rep Contribution x
Generic)
          deriving anyclass ([Contribution] -> Encoding
[Contribution] -> Value
Contribution -> Encoding
Contribution -> Value
(Contribution -> Value)
-> (Contribution -> Encoding)
-> ([Contribution] -> Value)
-> ([Contribution] -> Encoding)
-> ToJSON Contribution
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Contribution] -> Encoding
$ctoEncodingList :: [Contribution] -> Encoding
toJSONList :: [Contribution] -> Value
$ctoJSONList :: [Contribution] -> Value
toEncoding :: Contribution -> Encoding
$ctoEncoding :: Contribution -> Encoding
toJSON :: Contribution -> Value
$ctoJSON :: Contribution -> Value
ToJSON, Value -> Parser [Contribution]
Value -> Parser Contribution
(Value -> Parser Contribution)
-> (Value -> Parser [Contribution]) -> FromJSON Contribution
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Contribution]
$cparseJSONList :: Value -> Parser [Contribution]
parseJSON :: Value -> Parser Contribution
$cparseJSON :: Value -> Parser Contribution
FromJSON, FormSchema
FormSchema -> ToSchema Contribution
forall a. FormSchema -> ToSchema a
toSchema :: FormSchema
$ctoSchema :: FormSchema
ToSchema, ToSchema Contribution
ToSchema Contribution
-> (Contribution -> Fix FormArgumentF) -> ToArgument Contribution
Contribution -> Fix FormArgumentF
forall a. ToSchema a -> (a -> Fix FormArgumentF) -> ToArgument a
toArgument :: Contribution -> Fix FormArgumentF
$ctoArgument :: Contribution -> Fix FormArgumentF
$cp1ToArgument :: ToSchema Contribution
ToArgument)

-- | Construct a 'Campaign' value from the campaign parameters,
--   using the wallet's public key.
mkCampaign :: POSIXTime -> POSIXTime -> Wallet -> Campaign
mkCampaign :: POSIXTime -> POSIXTime -> Wallet -> Campaign
mkCampaign POSIXTime
ddl POSIXTime
collectionDdl Wallet
ownerWallet =
    Campaign :: POSIXTime -> POSIXTime -> PaymentPubKeyHash -> Campaign
Campaign
        { campaignDeadline :: POSIXTime
campaignDeadline = POSIXTime
ddl
        , campaignCollectionDeadline :: POSIXTime
campaignCollectionDeadline = POSIXTime
collectionDdl
        , campaignOwner :: PaymentPubKeyHash
campaignOwner = Wallet -> PaymentPubKeyHash
Emulator.mockWalletPaymentPubKeyHash Wallet
ownerWallet
        }

-- | The 'POSIXTimeRange' during which the funds can be collected
{-# INLINABLE collectionRange #-}
collectionRange :: Campaign -> POSIXTimeRange
collectionRange :: Campaign -> POSIXTimeRange
collectionRange Campaign
cmp =
    POSIXTime -> POSIXTime -> POSIXTimeRange
forall a. a -> a -> Interval a
Interval.interval (Campaign -> POSIXTime
campaignDeadline Campaign
cmp) (Campaign -> POSIXTime
campaignCollectionDeadline Campaign
cmp POSIXTime -> POSIXTime -> POSIXTime
forall a. AdditiveGroup a => a -> a -> a
- POSIXTime
1)

-- | The 'POSIXTimeRange' during which a refund may be claimed
{-# INLINABLE refundRange #-}
refundRange :: Campaign -> POSIXTimeRange
refundRange :: Campaign -> POSIXTimeRange
refundRange Campaign
cmp =
    POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
Interval.from (Campaign -> POSIXTime
campaignCollectionDeadline Campaign
cmp)

data Crowdfunding
instance Scripts.ValidatorTypes Crowdfunding where
    type instance RedeemerType Crowdfunding = CampaignAction
    type instance DatumType Crowdfunding = PaymentPubKeyHash

typedValidator :: Campaign -> Scripts.TypedValidator Crowdfunding
typedValidator :: Campaign -> TypedValidator Crowdfunding
typedValidator = CompiledCode (Campaign -> ValidatorType Crowdfunding)
-> CompiledCode
     (ValidatorType Crowdfunding -> WrappedValidatorType)
-> Campaign
-> TypedValidator Crowdfunding
forall a param.
Lift DefaultUni param =>
CompiledCode (param -> ValidatorType a)
-> CompiledCode (ValidatorType a -> WrappedValidatorType)
-> param
-> TypedValidator a
Scripts.mkTypedValidatorParam @Crowdfunding
    $$(PlutusTx.compile [|| mkValidator ||])
    $$(PlutusTx.compile [|| wrap ||])
    where
        wrap :: (PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool)
-> WrappedValidatorType
wrap = (PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool)
-> WrappedValidatorType
forall d r.
(UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> ScriptContext -> Bool) -> WrappedValidatorType
Scripts.wrapValidator

{-# INLINABLE validRefund #-}
validRefund :: Campaign -> PaymentPubKeyHash -> TxInfo -> Bool
validRefund :: Campaign -> PaymentPubKeyHash -> TxInfo -> Bool
validRefund Campaign
campaign PaymentPubKeyHash
contributor TxInfo
txinfo =
    -- Check that the transaction falls in the refund range of the campaign
    Campaign -> POSIXTimeRange
refundRange Campaign
campaign POSIXTimeRange -> POSIXTimeRange -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
`Interval.contains` TxInfo -> POSIXTimeRange
txInfoValidRange TxInfo
txinfo
    -- Check that the transaction is signed by the contributor
    Bool -> Bool -> Bool
&& (TxInfo
txinfo TxInfo -> PubKeyHash -> Bool
`V.txSignedBy` PaymentPubKeyHash -> PubKeyHash
unPaymentPubKeyHash PaymentPubKeyHash
contributor)

{-# INLINABLE validCollection #-}
validCollection :: Campaign -> TxInfo -> Bool
validCollection :: Campaign -> TxInfo -> Bool
validCollection Campaign
campaign TxInfo
txinfo =
    -- Check that the transaction falls in the collection range of the campaign
    (Campaign -> POSIXTimeRange
collectionRange Campaign
campaign POSIXTimeRange -> POSIXTimeRange -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
`Interval.contains` TxInfo -> POSIXTimeRange
txInfoValidRange TxInfo
txinfo)
    -- Check that the transaction is signed by the campaign owner
    Bool -> Bool -> Bool
&& (TxInfo
txinfo TxInfo -> PubKeyHash -> Bool
`V.txSignedBy` PaymentPubKeyHash -> PubKeyHash
unPaymentPubKeyHash (Campaign -> PaymentPubKeyHash
campaignOwner Campaign
campaign))

{-# INLINABLE mkValidator #-}
-- | The validator script is of type 'CrowdfundingValidator', and is
-- additionally parameterized by a 'Campaign' definition. This argument is
-- provided by the Plutus client, using 'PlutusTx.applyCode'.
-- As a result, the 'Campaign' definition is part of the script address,
-- and different campaigns have different addresses. The Campaign{..} syntax
-- means that all fields of the 'Campaign' value are in scope
-- (for example 'campaignDeadline' in l. 70).
mkValidator :: Campaign -> PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool
mkValidator :: Campaign
-> PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool
mkValidator Campaign
c PaymentPubKeyHash
con CampaignAction
act ScriptContext{TxInfo
scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo :: TxInfo
scriptContextTxInfo} = case CampaignAction
act of
    -- the "refund" branch
    CampaignAction
Refund  -> Campaign -> PaymentPubKeyHash -> TxInfo -> Bool
validRefund Campaign
c PaymentPubKeyHash
con TxInfo
scriptContextTxInfo
    -- the "collection" branch
    CampaignAction
Collect -> Campaign -> TxInfo -> Bool
validCollection Campaign
c TxInfo
scriptContextTxInfo

-- | The validator script that determines whether the campaign owner can
--   retrieve the funds or the contributors can claim a refund.
--
contributionScript :: Campaign -> Validator
contributionScript :: Campaign -> Validator
contributionScript = TypedValidator Crowdfunding -> Validator
forall a. TypedValidator a -> Validator
Scripts.validatorScript (TypedValidator Crowdfunding -> Validator)
-> (Campaign -> TypedValidator Crowdfunding)
-> Campaign
-> Validator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Campaign -> TypedValidator Crowdfunding
typedValidator

-- | The address of a [[Campaign]]
campaignAddress :: Campaign -> Ledger.ValidatorHash
campaignAddress :: Campaign -> ValidatorHash
campaignAddress = Validator -> ValidatorHash
Scripts.validatorHash (Validator -> ValidatorHash)
-> (Campaign -> Validator) -> Campaign -> ValidatorHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Campaign -> Validator
contributionScript

-- | The crowdfunding contract for the 'Campaign'.
crowdfunding :: Campaign -> Contract () CrowdfundingSchema ContractError ()
crowdfunding :: Campaign -> Contract () CrowdfundingSchema ContractError ()
crowdfunding Campaign
c = [Promise
   ()
   ('R
      '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
         "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
   ContractError
   ()]
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall w (s :: Row *) e a. [Promise w s e a] -> Contract w s e a
selectList [Campaign -> Promise () CrowdfundingSchema ContractError ()
contribute Campaign
c, Campaign -> Promise () CrowdfundingSchema ContractError ()
scheduleCollection Campaign
c]

-- | A sample campaign
theCampaign :: POSIXTime -> Campaign
theCampaign :: POSIXTime -> Campaign
theCampaign POSIXTime
startTime = Campaign :: POSIXTime -> POSIXTime -> PaymentPubKeyHash -> Campaign
Campaign
    { campaignDeadline :: POSIXTime
campaignDeadline = POSIXTime
startTime POSIXTime -> POSIXTime -> POSIXTime
forall a. AdditiveSemigroup a => a -> a -> a
+ POSIXTime
20000
    , campaignCollectionDeadline :: POSIXTime
campaignCollectionDeadline = POSIXTime
startTime POSIXTime -> POSIXTime -> POSIXTime
forall a. AdditiveSemigroup a => a -> a -> a
+ POSIXTime
30000
    , campaignOwner :: PaymentPubKeyHash
campaignOwner = Wallet -> PaymentPubKeyHash
Emulator.mockWalletPaymentPubKeyHash (Integer -> Wallet
knownWallet Integer
1)
    }

-- | The "contribute" branch of the contract for a specific 'Campaign'. Exposes
--   an endpoint that allows the user to enter their public key and the
--   contribution. Then waits until the campaign is over, and collects the
--   refund if the funding was not collected.
contribute :: Campaign -> Promise () CrowdfundingSchema ContractError ()
contribute :: Campaign -> Promise () CrowdfundingSchema ContractError ()
contribute Campaign
cmp = forall a w (s :: Row *) e b.
(HasEndpoint "contribute" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"contribute" ((Contribution
  -> Contract
       ()
       ('R
          '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
             "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
       ContractError
       ())
 -> Promise
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> (Contribution
    -> Contract
         ()
         ('R
            '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
               "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
         ContractError
         ())
-> Promise
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ \Contribution{Value
contribValue :: Value
contribValue :: Contribution -> Value
contribValue} -> do
    forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e. ToJSON Text => Text -> Contract w s e ()
logInfo @Text (Text
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> Text
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ Text
"Contributing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Value -> String
forall a. Show a => a -> String
Haskell.show Value
contribValue)
    PaymentPubKeyHash
contributor <- Contract
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
  PaymentPubKeyHash
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e PaymentPubKeyHash
ownPaymentPubKeyHash
    let inst :: TypedValidator Crowdfunding
inst = Campaign -> TypedValidator Crowdfunding
typedValidator Campaign
cmp
        tx :: TxConstraints CampaignAction PaymentPubKeyHash
tx = PaymentPubKeyHash
-> Value -> TxConstraints CampaignAction PaymentPubKeyHash
forall i o. ToData o => o -> Value -> TxConstraints i o
Constraints.mustPayToTheScript PaymentPubKeyHash
contributor Value
contribValue
                TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
forall a. Semigroup a => a -> a -> a
<> POSIXTimeRange -> TxConstraints CampaignAction PaymentPubKeyHash
forall i o. POSIXTimeRange -> TxConstraints i o
Constraints.mustValidateIn (POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
Interval.to (Campaign -> POSIXTime
campaignDeadline Campaign
cmp))
    TxId
txid <- (CardanoTx -> TxId)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CardanoTx -> TxId
getCardanoTxId (Contract
   ()
   ('R
      '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
         "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
   ContractError
   CardanoTx
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      TxId)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     TxId
forall a b. (a -> b) -> a -> b
$ ScriptLookups Crowdfunding
-> TxConstraints
     (RedeemerType Crowdfunding) (DatumType Crowdfunding)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints (TypedValidator Crowdfunding -> ScriptLookups Crowdfunding
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Crowdfunding
inst) TxConstraints (RedeemerType Crowdfunding) (DatumType Crowdfunding)
TxConstraints CampaignAction PaymentPubKeyHash
tx
        Contract
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
  UnbalancedTx
-> (UnbalancedTx
    -> Contract
         ()
         ('R
            '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
               "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
         ContractError
         CardanoTx)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx (UnbalancedTx
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      CardanoTx)
-> (UnbalancedTx -> UnbalancedTx)
-> UnbalancedTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnbalancedTx -> UnbalancedTx
Constraints.adjustUnbalancedTx

    Map TxOutRef ChainIndexTxOut
utxo <- Address
-> POSIXTime
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
Address
-> POSIXTime -> Contract w s e (Map TxOutRef ChainIndexTxOut)
watchAddressUntilTime (TypedValidator Crowdfunding -> Address
forall a. TypedValidator a -> Address
Scripts.validatorAddress TypedValidator Crowdfunding
inst) (POSIXTime
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      (Map TxOutRef ChainIndexTxOut))
-> POSIXTime
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     (Map TxOutRef ChainIndexTxOut)
forall a b. (a -> b) -> a -> b
$ Campaign -> POSIXTime
campaignCollectionDeadline Campaign
cmp

    -- 'utxo' is the set of unspent outputs at the campaign address at the
    -- collection deadline. If 'utxo' still contains our own contribution
    -- then we can claim a refund.

    let flt :: TxOutRef -> ChainIndexTxOut -> Bool
flt Ledger.TxOutRef{TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId :: TxId
txOutRefId} ChainIndexTxOut
_ = TxId
txid TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
Haskell.== TxId
txOutRefId
        tx' :: TxConstraints CampaignAction PaymentPubKeyHash
tx' = (TxOutRef -> ChainIndexTxOut -> Bool)
-> Map TxOutRef ChainIndexTxOut
-> CampaignAction
-> TxConstraints CampaignAction PaymentPubKeyHash
forall i o.
(TxOutRef -> ChainIndexTxOut -> Bool)
-> Map TxOutRef ChainIndexTxOut -> i -> TxConstraints i o
Typed.collectFromScriptFilter TxOutRef -> ChainIndexTxOut -> Bool
flt Map TxOutRef ChainIndexTxOut
utxo CampaignAction
Refund
                TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
forall a. Semigroup a => a -> a -> a
<> POSIXTimeRange -> TxConstraints CampaignAction PaymentPubKeyHash
forall i o. POSIXTimeRange -> TxConstraints i o
Constraints.mustValidateIn (Campaign -> POSIXTimeRange
refundRange Campaign
cmp)
                TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
forall a. Semigroup a => a -> a -> a
<> PaymentPubKeyHash -> TxConstraints CampaignAction PaymentPubKeyHash
forall i o. PaymentPubKeyHash -> TxConstraints i o
Constraints.mustBeSignedBy PaymentPubKeyHash
contributor
    if TxConstraints CampaignAction PaymentPubKeyHash -> Bool
forall i o. TxConstraints i o -> Bool
Constraints.modifiesUtxoSet TxConstraints CampaignAction PaymentPubKeyHash
tx'
    then do
        Text
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Text Text
"Claiming refund"
        Contract
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
  CardanoTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   ()
   ('R
      '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
         "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
   ContractError
   CardanoTx
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ ScriptLookups Crowdfunding
-> TxConstraints
     (RedeemerType Crowdfunding) (DatumType Crowdfunding)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints (TypedValidator Crowdfunding -> ScriptLookups Crowdfunding
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Crowdfunding
inst
                             ScriptLookups Crowdfunding
-> ScriptLookups Crowdfunding -> ScriptLookups Crowdfunding
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef ChainIndexTxOut -> ScriptLookups Crowdfunding
forall a. Map TxOutRef ChainIndexTxOut -> ScriptLookups a
Constraints.unspentOutputs Map TxOutRef ChainIndexTxOut
utxo) TxConstraints (RedeemerType Crowdfunding) (DatumType Crowdfunding)
TxConstraints CampaignAction PaymentPubKeyHash
tx'
            Contract
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
  UnbalancedTx
-> (UnbalancedTx
    -> Contract
         ()
         ('R
            '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
               "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
         ContractError
         CardanoTx)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx (UnbalancedTx
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      CardanoTx)
-> (UnbalancedTx -> UnbalancedTx)
-> UnbalancedTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnbalancedTx -> UnbalancedTx
Constraints.adjustUnbalancedTx
    else ()
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | The campaign owner's branch of the contract for a given 'Campaign'. It
--   watches the campaign address for contributions and collects them if
--   the funding goal was reached in time.
scheduleCollection :: Campaign -> Promise () CrowdfundingSchema ContractError ()
scheduleCollection :: Campaign -> Promise () CrowdfundingSchema ContractError ()
scheduleCollection Campaign
cmp = forall a w (s :: Row *) e b.
(HasEndpoint "schedule collection" a s, AsContractError e,
 FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"schedule collection" ((()
  -> Contract
       ()
       ('R
          '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
             "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
       ContractError
       ())
 -> Promise
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> (()
    -> Contract
         ()
         ('R
            '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
               "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
         ContractError
         ())
-> Promise
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ \() -> do
    let inst :: TypedValidator Crowdfunding
inst = Campaign -> TypedValidator Crowdfunding
typedValidator Campaign
cmp

    -- Expose an endpoint that lets the user fire the starting gun on the
    -- campaign. (This endpoint isn't technically necessary, we could just
    -- run the 'trg' action right away)
    Text
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Text Text
"Campaign started. Waiting for campaign deadline to collect funds."

    POSIXTime
_ <- POSIXTime
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     POSIXTime
forall w (s :: Row *) e.
AsContractError e =>
POSIXTime -> Contract w s e POSIXTime
awaitTime (POSIXTime
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      POSIXTime)
-> POSIXTime
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     POSIXTime
forall a b. (a -> b) -> a -> b
$ Campaign -> POSIXTime
campaignDeadline Campaign
cmp
    Map TxOutRef ChainIndexTxOut
unspentOutputs <- Address
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
utxosAt (TypedValidator Crowdfunding -> Address
forall a. TypedValidator a -> Address
Scripts.validatorAddress TypedValidator Crowdfunding
inst)

    let tx :: TxConstraints CampaignAction PaymentPubKeyHash
tx = Map TxOutRef ChainIndexTxOut
-> CampaignAction -> TxConstraints CampaignAction PaymentPubKeyHash
forall i o. Map TxOutRef ChainIndexTxOut -> i -> TxConstraints i o
Typed.collectFromScript Map TxOutRef ChainIndexTxOut
unspentOutputs CampaignAction
Collect
            TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
-> TxConstraints CampaignAction PaymentPubKeyHash
forall a. Semigroup a => a -> a -> a
<> POSIXTimeRange -> TxConstraints CampaignAction PaymentPubKeyHash
forall i o. POSIXTimeRange -> TxConstraints i o
Constraints.mustValidateIn (Campaign -> POSIXTimeRange
collectionRange Campaign
cmp)

    Text
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Text Text
"Collecting funds"
    Contract
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
  CardanoTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   ()
   ('R
      '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
         "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
   ContractError
   CardanoTx
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ ScriptLookups Crowdfunding
-> TxConstraints
     (RedeemerType Crowdfunding) (DatumType Crowdfunding)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints (TypedValidator Crowdfunding -> ScriptLookups Crowdfunding
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Crowdfunding
inst
                         ScriptLookups Crowdfunding
-> ScriptLookups Crowdfunding -> ScriptLookups Crowdfunding
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef ChainIndexTxOut -> ScriptLookups Crowdfunding
forall a. Map TxOutRef ChainIndexTxOut -> ScriptLookups a
Constraints.unspentOutputs Map TxOutRef ChainIndexTxOut
unspentOutputs) TxConstraints (RedeemerType Crowdfunding) (DatumType Crowdfunding)
TxConstraints CampaignAction PaymentPubKeyHash
tx
        Contract
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
  UnbalancedTx
-> (UnbalancedTx
    -> Contract
         ()
         ('R
            '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
               "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
         ContractError
         CardanoTx)
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx (UnbalancedTx
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      CardanoTx)
-> (UnbalancedTx -> UnbalancedTx)
-> UnbalancedTx
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnbalancedTx -> UnbalancedTx
Constraints.adjustUnbalancedTx

-- | Call the "schedule collection" endpoint and instruct the campaign owner's
--   wallet (wallet 1) to start watching the campaign address.
startCampaign :: EmulatorTrace (ContractHandle () CrowdfundingSchema ContractError)
startCampaign :: EmulatorTrace (ContractHandle () CrowdfundingSchema ContractError)
startCampaign = do
    POSIXTime
startTime <- SlotConfig -> POSIXTime
TimeSlot.scSlotZeroTime (SlotConfig -> POSIXTime)
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     SlotConfig
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff
  '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
    EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
  SlotConfig
forall (effs :: [* -> *]).
Member EmulatorControl effs =>
Eff effs SlotConfig
getSlotConfig
    ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
hdl <- Wallet
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     (ContractHandle
        ()
        ('R
           '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
              "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
        ContractError)
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e
       (effs :: [* -> *]).
(IsContract contract, ContractConstraints s, Show e, ToJSON e,
 FromJSON e, ToJSON w, FromJSON w, Member StartContract effs,
 Monoid w) =>
Wallet -> contract w s e () -> Eff effs (ContractHandle w s e)
Trace.activateContractWallet (Integer -> Wallet
knownWallet Integer
1) (Campaign -> Contract () CrowdfundingSchema ContractError ()
Campaign
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
crowdfunding (Campaign
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> Campaign
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Campaign
theCampaign POSIXTime
startTime)
    ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
-> ()
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
forall (l :: Symbol) ep w (s :: Row *) e (effs :: [* -> *]).
(ToJSON ep, ContractConstraints s, HasEndpoint l ep s,
 Member RunContract effs) =>
ContractHandle w s e -> ep -> Eff effs ()
Trace.callEndpoint @"schedule collection" ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
hdl ()
    ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     (ContractHandle
        ()
        ('R
           '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
              "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
        ContractError)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
hdl

-- | Call the "contribute" endpoint, contributing the amount from the wallet
makeContribution :: Wallet -> Value -> EmulatorTrace ()
makeContribution :: Wallet
-> Value
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
makeContribution Wallet
w Value
v = do
    POSIXTime
startTime <- SlotConfig -> POSIXTime
TimeSlot.scSlotZeroTime (SlotConfig -> POSIXTime)
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     SlotConfig
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff
  '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
    EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
  SlotConfig
forall (effs :: [* -> *]).
Member EmulatorControl effs =>
Eff effs SlotConfig
getSlotConfig
    ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
hdl <- Wallet
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     (ContractHandle
        ()
        ('R
           '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
              "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
        ContractError)
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e
       (effs :: [* -> *]).
(IsContract contract, ContractConstraints s, Show e, ToJSON e,
 FromJSON e, ToJSON w, FromJSON w, Member StartContract effs,
 Monoid w) =>
Wallet -> contract w s e () -> Eff effs (ContractHandle w s e)
Trace.activateContractWallet Wallet
w (Campaign -> Contract () CrowdfundingSchema ContractError ()
Campaign
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
crowdfunding (Campaign
 -> Contract
      ()
      ('R
         '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
            "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
      ContractError
      ())
-> Campaign
-> Contract
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError
     ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Campaign
theCampaign POSIXTime
startTime)
    ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
-> Contribution
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
forall (l :: Symbol) ep w (s :: Row *) e (effs :: [* -> *]).
(ToJSON ep, ContractConstraints s, HasEndpoint l ep s,
 Member RunContract effs) =>
ContractHandle w s e -> ep -> Eff effs ()
Trace.callEndpoint @"contribute" ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
hdl Contribution :: Value -> Contribution
Contribution{contribValue :: Value
contribValue=Value
v}

-- | Run a successful campaign with contributions from wallets 2, 3 and 4.
successfulCampaign :: EmulatorTrace ()
successfulCampaign :: Eff
  '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
    EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
  ()
successfulCampaign = do
    ContractHandle
  ()
  ('R
     '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
        "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
  ContractError
_ <- EmulatorTrace (ContractHandle () CrowdfundingSchema ContractError)
Eff
  '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
    EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
  (ContractHandle
     ()
     ('R
        '[ "contribute" ':-> (EndpointValue Contribution, ActiveEndpoint),
           "schedule collection" ':-> (EndpointValue (), ActiveEndpoint)])
     ContractError)
startCampaign
    Wallet
-> Value
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
makeContribution (Integer -> Wallet
knownWallet Integer
2) (Micro -> Value
Ada.adaValueOf Micro
10)
    Wallet
-> Value
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
makeContribution (Integer -> Wallet
knownWallet Integer
3) (Micro -> Value
Ada.adaValueOf Micro
10)
    Wallet
-> Value
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
makeContribution (Integer -> Wallet
knownWallet Integer
4) (Micro -> Value
Ada.adaValueOf Micro
2.5)
    Eff
  '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
    EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
  Slot
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff
   '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
     EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
   Slot
 -> Eff
      '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
        EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
      ())
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     Slot
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     ()
forall a b. (a -> b) -> a -> b
$ Slot
-> Eff
     '[StartContract, RunContract, Assert, Waiting, EmulatorControl,
       EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]
     Slot
forall (effs :: [* -> *]).
Member Waiting effs =>
Slot -> Eff effs Slot
Trace.waitUntilSlot Slot
21