module Test.Cleveland.Lorentz.Ticketer
( ticketerContract'
, ticketerContract
, callViaTicketer
) where
import Lorentz
import Prelude (HasCallStack)
import Test.Cleveland
import Test.Cleveland.Internal.Actions.Transfer
ticketerContract'
:: ( NiceComparable td
, NiceParameterFull (View_ (payload, (Natural, td)) callbackArg)
, NiceParameter callbackArg
)
=> [payload, Ticket td] :-> '[callbackArg]
-> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract' :: forall td payload callbackArg.
(NiceComparable td,
NiceParameterFull (View_ (payload, (Natural, td)) callbackArg),
NiceParameter callbackArg) =>
('[payload, Ticket td] :-> '[callbackArg])
-> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract' '[payload, Ticket td] :-> '[callbackArg]
mkCallbackArg = (IsNotInView =>
'[(View_ (payload, (Natural, td)) callbackArg, ())]
:-> ContractOut ())
-> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
forall cp st.
(NiceParameterFull cp, NiceStorageFull st) =>
(IsNotInView => '[(cp, st)] :-> ContractOut st)
-> Contract cp st ()
defaultContract ((IsNotInView =>
'[(View_ (payload, (Natural, td)) callbackArg, ())]
:-> ContractOut ())
-> Contract (View_ (payload, (Natural, td)) callbackArg) () ())
-> (IsNotInView =>
'[(View_ (payload, (Natural, td)) callbackArg, ())]
:-> ContractOut ())
-> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
forall a b. (a -> b) -> a -> b
$
'[(View_ (payload, (Natural, td)) callbackArg, ())]
:-> '[View_ (payload, (Natural, td)) callbackArg, ()]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair ('[(View_ (payload, (Natural, td)) callbackArg, ())]
:-> '[View_ (payload, (Natural, td)) callbackArg, ()])
-> ('[View_ (payload, (Natural, td)) callbackArg, ()]
:-> ContractOut ())
-> '[(View_ (payload, (Natural, td)) callbackArg, ())]
:-> ContractOut ()
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (forall (s0 :: [*]).
((payload, (Natural, td)) : () : s0) :-> (callbackArg : s0))
-> '[View_ (payload, (Natural, td)) callbackArg, ()]
:-> ContractOut ()
forall r storage a (s :: [*]).
(NiceParameter r, Dupable storage, IsNotInView) =>
(forall (s0 :: [*]). (a : storage : s0) :-> (r : s0))
-> (View_ a r : storage : s) :-> ((List Operation, storage) : s)
view_
( ((() : s0) :-> s0)
-> ((payload, (Natural, td)) : () : s0)
:-> ((payload, (Natural, td)) : s0)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (forall a (s :: [*]). (a : s) :-> s
drop @()) (((payload, (Natural, td)) : () : s0)
:-> ((payload, (Natural, td)) : s0))
-> (((payload, (Natural, td)) : s0)
:-> (payload : (Natural, td) : s0))
-> ((payload, (Natural, td)) : () : s0)
:-> (payload : (Natural, td) : s0)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((payload, (Natural, td)) : s0) :-> (payload : (Natural, td) : s0)
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair (((payload, (Natural, td)) : () : s0)
:-> (payload : (Natural, td) : s0))
-> ((payload : (Natural, td) : s0) :-> (payload : Ticket td : s0))
-> ((payload, (Natural, td)) : () : s0)
:-> (payload : Ticket td : s0)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(((Natural, td) : s0) :-> (Ticket td : s0))
-> (payload : (Natural, td) : s0) :-> (payload : Ticket td : s0)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (((Natural, td) : s0) :-> (Natural : td : s0)
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair (((Natural, td) : s0) :-> (Natural : td : s0))
-> ((Natural : td : s0) :-> (td : Natural : s0))
-> ((Natural, td) : s0) :-> (td : Natural : s0)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (Natural : td : s0) :-> (td : Natural : s0)
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap (((Natural, td) : s0) :-> (td : Natural : s0))
-> ((td : Natural : s0) :-> (Maybe (Ticket td) : s0))
-> ((Natural, td) : s0) :-> (Maybe (Ticket td) : s0)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (td : Natural : s0) :-> (Maybe (Ticket td) : s0)
forall a (s :: [*]).
NiceComparable a =>
(a : Natural : s) :-> (Maybe (Ticket a) : s)
ticket (((Natural, td) : s0) :-> (Maybe (Ticket td) : s0))
-> ((Maybe (Ticket td) : s0) :-> (Ticket td : s0))
-> ((Natural, td) : s0) :-> (Ticket td : s0)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# forall err a (s :: [*]).
IsError err =>
err -> (Maybe a : s) :-> (a : s)
assertSome @MText MText
"Zero amount tickets are not allowed") (((payload, (Natural, td)) : () : s0)
:-> (payload : Ticket td : s0))
-> ((payload : Ticket td : s0) :-> (callbackArg : s0))
-> ((payload, (Natural, td)) : () : s0) :-> (callbackArg : s0)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
('[payload, Ticket td] :-> '[callbackArg])
-> ('[payload, Ticket td] ++ s0) :-> ('[callbackArg] ++ s0)
forall (s :: [*]) (i :: [*]) (o :: [*]).
(KnownList i, KnownList o) =>
(i :-> o) -> (i ++ s) :-> (o ++ s)
framed '[payload, Ticket td] :-> '[callbackArg]
mkCallbackArg
)
ticketerContract
:: ( NiceComparable td
, callbackArg ~ (payload, Ticket td)
, NiceParameterFull (View_ (payload, (Natural, td)) callbackArg)
, NiceParameter callbackArg
)
=> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract :: forall td callbackArg payload.
(NiceComparable td, callbackArg ~ (payload, Ticket td),
NiceParameterFull (View_ (payload, (Natural, td)) callbackArg),
NiceParameter callbackArg) =>
Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract = ('[payload, Ticket td] :-> '[(payload, Ticket td)])
-> Contract
(View_ (payload, (Natural, td)) (payload, Ticket td)) () ()
forall td payload callbackArg.
(NiceComparable td,
NiceParameterFull (View_ (payload, (Natural, td)) callbackArg),
NiceParameter callbackArg) =>
('[payload, Ticket td] :-> '[callbackArg])
-> Contract (View_ (payload, (Natural, td)) callbackArg) () ()
ticketerContract' '[payload, Ticket td] :-> '[(payload, Ticket td)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair
callViaTicketer
:: forall targetArg payload td targetAddr ticketerParam ticketerAddr m.
( HasCallStack
, MonadTransfer m
, ticketerParam ~ View_ (payload, (Natural, td)) targetArg
, ToL1TAddress ticketerParam () ticketerAddr
, ToContractRef targetArg targetAddr
, NiceParameterFull ticketerParam
)
=> ticketerAddr
-> Natural
-> td
-> targetAddr
-> payload
-> m ()
callViaTicketer :: forall targetArg payload td targetAddr ticketerParam ticketerAddr
(m :: * -> *).
(HasCallStack, MonadTransfer m,
ticketerParam ~ View_ (payload, (Natural, td)) targetArg,
ToL1TAddress ticketerParam () ticketerAddr,
ToContractRef targetArg targetAddr,
NiceParameterFull ticketerParam) =>
ticketerAddr -> Natural -> td -> targetAddr -> payload -> m ()
callViaTicketer ticketerAddr
ticketer Natural
ticketAmount td
ticketData targetAddr
target payload
payload =
L1TAddress ticketerParam ()
-> GenericCall
('Checked (View_ (payload, (Natural, td)) targetArg))
-> m ()
forall addr r.
(HasCallStack,
TransferFunc
('Incomplete (InitialTransferMode addr))
'TransferIgnoreResult
'HasNoAmount
r,
ToL1Address addr) =>
addr -> r
transfer (forall cp vd addr.
ToL1TAddress cp vd addr =>
addr -> L1TAddress cp vd
toL1TAddress @ticketerParam @() ticketerAddr
ticketer) (GenericCall ('Checked (View_ (payload, (Natural, td)) targetArg))
-> m ())
-> GenericCall
('Checked (View_ (payload, (Natural, td)) targetArg))
-> m ()
forall a b. (a -> b) -> a -> b
$ EntrypointRef 'Nothing
-> forall epArg param.
(NiceParameter epArg,
HasEntrypointArg param (EntrypointRef 'Nothing) epArg) =>
epArg -> GenericCall ('Checked param)
forall (mname :: Maybe Symbol).
EntrypointRef mname
-> forall epArg param.
(NiceParameter epArg,
HasEntrypointArg param (EntrypointRef mname) epArg) =>
epArg -> GenericCall ('Checked param)
calling EntrypointRef 'Nothing
forall a. Default a => a
def (View_ (payload, (Natural, td)) targetArg
-> GenericCall
('Checked (View_ (payload, (Natural, td)) targetArg)))
-> View_ (payload, (Natural, td)) targetArg
-> GenericCall
('Checked (View_ (payload, (Natural, td)) targetArg))
forall a b. (a -> b) -> a -> b
$
(payload, (Natural, td))
-> targetAddr -> View_ (payload, (Natural, td)) targetArg
forall r contract a.
ToContractRef r contract =>
a -> contract -> View_ a r
mkView_ (payload
payload, (Natural
ticketAmount, td
ticketData)) targetAddr
target