An old Plutus smart contract mostly as a historic relic due natural changes on Plutus.

MyCrowdFunding.hs

module MyCrowdFunding where

import qualified Language.PlutusTx            as PlutusTx
import qualified Ledger.Interval              as Interval
import           Ledger.Slot                  (SlotRange)
import qualified Ledger.Slot                  as Slot
import qualified Language.PlutusTx.Prelude    as P
import           Ledger
import qualified Ledger.Ada.TH                as Ada
import           Ledger.Ada                   (Ada)
import           Ledger.Validation
import           Playground.Contract
import           Wallet                       as Wallet



data Campaign = Campaign
    { campaignDeadline           :: Slot
    , campaignTarget             :: Ada
    , campaignCollectionDeadline :: Slot
    , campaignOwner              :: PubKey
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''Campaign


data CampaignAction = Collect | Refund
    deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''CampaignAction


myValidatorScript :: Campaign -> ValidatorScript
myValidatorScript campaign = ValidatorScript $ Ledger.applyScript validator (Ledger.lifted campaign)
    where
        validator = $$(Ledger.compileScript [||
                \Campaign{..} (contributor :: PubKey) (action :: CampaignAction) (ptx :: PendingTx) ->
                    let success = ()
                        failWith msg = $$(PlutusTx.error) ($$(P.traceH) msg ())

                        and :: Bool -> Bool -> Bool
                        and = $$(PlutusTx.and)

                        signedBy :: PendingTx -> PubKey -> Bool
                        signedBy = $$(txSignedBy)

                        PendingTx txIns txOuts _ _ _ range _ _ = ptx

                    in case action of
                        Collect ->
                            let
                                raisedAmount :: Ada
                                raisedAmount =
                                    let contributions = txIns
                                        amountOf (PendingTxIn _ _ amount) = $$(Ada.fromValue) amount
                                        add contribution total = $$(Ada.plus) total (amountOf contribution)
                                    in $$(P.foldr) add $$(Ada.zero) contributions
                        
                                isCollectionTime :: Bool
                                isCollectionTime =
                                    let collectionRange = $$(Interval.interval) campaignDeadline campaignCollectionDeadline
                                    in $$(Slot.contains) collectionRange range
                        
                                wasTargetReached :: Bool
                                wasTargetReached = $$(Ada.geq) raisedAmount campaignTarget
                        
                                isCampaignOwner :: Bool
                                isCampaignOwner = signedBy ptx campaignOwner
                        
                            in
                                if isCollectionTime `and` wasTargetReached `and` isCampaignOwner
                                then success
                                else failWith "Can't collect funds, check the terms in the contract."

                        Refund ->
                            let
                                isRefundTime :: Bool
                                isRefundTime =
                                    let refundRange = $$(Interval.from) campaignCollectionDeadline
                                    in $$(Slot.contains) refundRange range
                        
                                verifyContribution :: PendingTxOut -> Bool
                                verifyContribution contribution = case $$(pubKeyOutput) contribution of
                                    Nothing -> False
                                    Just supporter -> $$(eqPubKey) supporter contributor
                        
                                haveContributed :: Bool
                                haveContributed = $$(P.all) verifyContribution txOuts
                        
                                isContributor :: Bool
                                isContributor = signedBy ptx contributor
                        
                            in
                                if isRefundTime `and` haveContributed `and` isContributor
                                then success
                                else failWith "Can't refund contribution"
            ||])


contractAddress :: Campaign -> Address
contractAddress campaign = Ledger.scriptAddress $ myValidatorScript campaign


contribute :: MonadWallet m => Campaign -> Ada -> m ()
contribute campaign value = do
    _ <- if value <= 0
      then throwOtherError "Must contribute a positive value"
      else pure ()

    ownPK <- ownPubKey

    let dataScript = DataScript $ Ledger.lifted ownPK
        range      = Wallet.defaultSlotRange
        amount     = $$(Ada.toValue) value
        address    = contractAddress campaign

    tx <- payToScript range address amount dataScript
    logMsg "Submitted contribution"

    register (refundTrigger address) $ refundHandler campaign (Ledger.hashTx tx)
    logMsg "Registered refund trigger"


refundTrigger :: Address -> EventTrigger
refundTrigger address = hasFunds `andT` isRefundTime
  where
    hasFunds = fundsAtAddressT address $ Wallet.intervalFrom ($$(Ada.toValue) 1)
    isRefundTime = slotRangeT $ Wallet.intervalFrom 15


refundHandler :: MonadWallet m => Campaign -> TxId -> EventHandler m
refundHandler campaign txid = EventHandler $ \_ -> do
    logMsg "Claiming refund"

    let redeemerScript  = RedeemerScript $ Ledger.lifted Refund
        range           = Wallet.intervalFrom 15
        validatorScript = myValidatorScript campaign

    collectFromScriptTxn range validatorScript redeemerScript txid


collectFundsTrigger :: Campaign -> EventTrigger
collectFundsTrigger campaign = hasFunds `andT` collectionTime
  where
    hasFunds = fundsAtAddressT (contractAddress campaign) $ Wallet.intervalFrom ($$(Ada.toValue) 1)
    collectionTime = slotRangeT $ Wallet.interval 10 15


collectFundsHandler :: MonadWallet m => Campaign -> EventHandler m
collectFundsHandler campaign = EventHandler $ \_ -> do
    logMsg "Collecting funds"

    let redeemerScript = RedeemerScript $ Ledger.lifted Collect
        range = Wallet.interval 10 15
        validatorScript = myValidatorScript campaign

    collectFromScript range validatorScript redeemerScript


scheduleCollection :: MonadWallet m => Campaign -> m ()
scheduleCollection campaign = do
    register (collectFundsTrigger campaign) (collectFundsHandler campaign)


$(mkFunctions ['contribute, 'scheduleCollection])