Ticketer.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Contract that facilitates tickets emission.
module Test.Cleveland.Lorentz.Ticketer
  ( ticketerContract'
  , ticketerContract
  , callViaTicketer
  ) where

import Lorentz
import Prelude (HasCallStack)

import Test.Cleveland

-- | A contract that emits the desired tickets.
--
-- It has one entrypoint - a 'View_' where you supply ticket
-- data and tokens amount, and a callback contract that
-- should receive an argument with the ticket.
--
-- You also have to supply a lambda that attaches a payload
-- to the ticket, since tickets are usually attached to some
-- other data.
ticketerContract'
  :: ( NiceComparable td
     , NiceParameterFull (View_ (payload, (Natural, td)) callbackArg)
     , NiceParameter callbackArg
     )
  => [payload, Ticket td] :-> '[callbackArg]
  -> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract' mkCallbackArg = defaultContract $
  unpair # view_
    ( dip (drop @()) # unpair # dip (unpair # swap # ticket) # framed mkCallbackArg
    )

-- | A simpler version of 'ticketerContract\'' where the target
-- contract will always receive a pair of payload and ticket.
ticketerContract
  :: ( NiceComparable td
     , callbackArg ~ (payload, Ticket td)
     , NiceParameterFull (View_ (payload, (Natural, td)) callbackArg)
     , NiceParameter callbackArg
     )
  => Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract = ticketerContract' pair

-- | Run a contract indirectly via calling the given ticketer contract.
--
-- The target contract will recieve a ticket and some payload. The exact
-- structure of the passed argument is determined by the ticketer contract.
callViaTicketer
  :: forall targetArg payload td targetAddr ticketerParam ticketerAddr m.
     ( HasCallStack
     , MonadOps m
     , ticketerParam ~ View_ (payload, (Natural, td)) targetArg
     , ToTAddress ticketerParam () ticketerAddr
     , ToContractRef targetArg targetAddr
     , NiceParameterFull ticketerParam
     )
  => ticketerAddr  -- ^ Address of ticketer contract
  -> Natural       -- ^ Desired ticket amount
  -> td            -- ^ Desired ticket data
  -> targetAddr    -- ^ Contract to call indirectly
  -> payload       -- ^ Main argument passed to the ticketer
  -> m ()
callViaTicketer ticketer ticketAmount ticketData target payload =
  call @ticketerParam @() ticketer CallDefault
    (mkView_ (payload, (ticketAmount, ticketData)) target)