{-# OPTIONS_HADDOCK not-home #-}
module Test.Cleveland.Internal.Actions.View
( module Test.Cleveland.Internal.Actions.View
) where
import Data.Constraint (pattern Dict)
import Fmt ((+|), (|+))
import Lorentz (Contract(..), HasView, Label, NiceViewable, toVal)
import Lorentz qualified as L
import Morley.AsRPC
import Morley.Client.Types (awaAddress)
import Morley.Michelson.Typed (pattern (:#))
import Morley.Michelson.Typed qualified as T
import Morley.Tezos.Address
import Morley.Util.TypeLits (KnownSymbol, symbolValT')
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Actions.Assertions (failure)
import Test.Cleveland.Internal.Actions.Misc
import Test.Cleveland.Lorentz.Types
callView
:: forall name arg ret cp st vd m caps.
( MonadCleveland caps m, HasView vd name arg ret
, NiceParameter arg, NiceViewable ret, NiceStorage ret
, NiceParameter cp, KnownSymbol name, HasRPCRepr ret
, T.IsoValue (AsRPC ret))
=> ContractHandle cp st vd
-> Label name
-> arg
-> m (AsRPC ret)
callView :: forall (name :: Symbol) arg ret cp st vd (m :: * -> *) caps.
(MonadCleveland caps m, HasView vd name arg ret, NiceParameter arg,
NiceViewable ret, NiceStorage ret, NiceParameter cp,
KnownSymbol name, HasRPCRepr ret, IsoValue (AsRPC ret)) =>
ContractHandle cp st vd -> Label name -> arg -> m (AsRPC ret)
callView = forall ret arg (name :: Symbol) addr (m :: * -> *) caps.
(MonadCleveland caps m, NiceParameter arg, NiceViewable ret,
NiceStorage ret, KnownSymbol name, HasRPCRepr ret,
IsoValue (AsRPC ret), ToContractAddress addr) =>
addr -> Label name -> arg -> m (AsRPC ret)
unsafeCallView @ret
where Dict (HasView vd name arg ret)
_ = forall (a :: Constraint). a => Dict a
Dict @(HasView vd name arg ret)
unsafeCallView
:: forall ret arg name addr m caps.
( MonadCleveland caps m, NiceParameter arg, NiceViewable ret
, NiceStorage ret, KnownSymbol name
, HasRPCRepr ret, T.IsoValue (AsRPC ret)
, ToContractAddress addr)
=> addr
-> Label name
-> arg
-> m (AsRPC ret)
unsafeCallView :: forall ret arg (name :: Symbol) addr (m :: * -> *) caps.
(MonadCleveland caps m, NiceParameter arg, NiceViewable ret,
NiceStorage ret, KnownSymbol name, HasRPCRepr ret,
IsoValue (AsRPC ret), ToContractAddress addr) =>
addr -> Label name -> arg -> m (AsRPC ret)
unsafeCallView (addr -> ContractAddress
forall addr. ToContractAddress addr => addr -> ContractAddress
toContractAddress -> ContractAddress
ch) Label name
_ arg
arg = do
Sender ImplicitAddressWithAlias
sender' <- Getting Sender caps Sender -> m Sender
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Prelude.view Getting Sender caps Sender
forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL
Mutez
contractBalance <- ContractAddress -> m Mutez
forall caps (m :: * -> *) addr.
(HasCallStack, MonadCleveland caps m, ToL1Address addr) =>
addr -> m Mutez
getBalance ContractAddress
ch
let ct :: Contract arg (Maybe ret) ()
ct = forall (name :: Symbol) arg ret.
(NiceParameter arg, NiceViewable ret, NiceStorage ret,
KnownSymbol name) =>
ContractAddress -> Contract arg (Maybe ret) ()
runnerContract @name @arg @ret ContractAddress
ch
callFail :: m (AsRPC ret)
callFail = Builder -> m (AsRPC ret)
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m (AsRPC ret)) -> Builder -> m (AsRPC ret)
forall a b. (a -> b) -> a -> b
$ Builder
"Failed to call view " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @name Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
Builder
": either it doesn't exist or types don't match."
Maybe (AsRPC ret)
res <- RunCode arg (Maybe ret) () -> m (AsRPC (Maybe ret))
forall caps (m :: * -> *) st cp vd.
(HasCallStack, MonadCleveland caps m, HasRPCRepr st,
IsoValue (AsRPC st)) =>
RunCode cp st vd -> m (AsRPC st)
runCode RunCode :: forall cp st vd.
Contract cp st vd
-> Value
-> Value
-> Mutez
-> Maybe Natural
-> Maybe Timestamp
-> Mutez
-> Maybe ImplicitAddress
-> RunCode cp st vd
RunCode
{ rcAmount :: Mutez
rcAmount = Mutez
0
, rcBalance :: Mutez
rcBalance = Mutez
contractBalance
, rcSource :: Maybe ImplicitAddress
rcSource = ImplicitAddress -> Maybe ImplicitAddress
forall a. a -> Maybe a
Just (ImplicitAddress -> Maybe ImplicitAddress)
-> ImplicitAddress -> Maybe ImplicitAddress
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress ImplicitAddressWithAlias
sender'
, rcContract :: Contract arg (Maybe ret) ()
rcContract = Contract arg (Maybe ret) ()
ct
, rcParameter :: Value
rcParameter = Value' Instr (ToT arg) -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
T.untypeValue (Value' Instr (ToT arg) -> Value)
-> Value' Instr (ToT arg) -> Value
forall a b. (a -> b) -> a -> b
$ arg -> Value' Instr (ToT arg)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal arg
arg
, rcStorage :: Value
rcStorage = Value' Instr ('TOption (ToT ret)) -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
T.untypeValue (Value' Instr ('TOption (ToT ret)) -> Value)
-> Value' Instr ('TOption (ToT ret)) -> Value
forall a b. (a -> b) -> a -> b
$ Maybe ret -> Value (ToT (Maybe ret))
forall a. IsoValue a => a -> Value (ToT a)
T.toVal (Maybe ret
forall a. Maybe a
Nothing :: Maybe ret)
, rcLevel :: Maybe Natural
rcLevel = Maybe Natural
forall a. Maybe a
Nothing
, rcNow :: Maybe Timestamp
rcNow = Maybe Timestamp
forall a. Maybe a
Nothing
}
m (AsRPC ret)
-> (AsRPC ret -> m (AsRPC ret))
-> Maybe (AsRPC ret)
-> m (AsRPC ret)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (AsRPC ret)
callFail AsRPC ret -> m (AsRPC ret)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (AsRPC ret)
res
runnerContract
:: forall name arg ret. (NiceParameter arg, NiceViewable ret, NiceStorage ret, KnownSymbol name)
=> ContractAddress -> Contract arg (Maybe ret) ()
runnerContract :: forall (name :: Symbol) arg ret.
(NiceParameter arg, NiceViewable ret, NiceStorage ret,
KnownSymbol name) =>
ContractAddress -> Contract arg (Maybe ret) ()
runnerContract ContractAddress
ch = (Contract' Instr (ToT arg) ('TOption (ToT ret))
-> ContractCode arg (Maybe ret) -> Contract arg (Maybe ret) ())
-> ContractCode arg (Maybe ret)
-> Contract' Instr (ToT arg) ('TOption (ToT ret))
-> Contract arg (Maybe ret) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Contract' Instr (ToT arg) ('TOption (ToT ret))
-> ContractCode arg (Maybe ret) -> Contract arg (Maybe ret) ()
forall cp st vd.
(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
Contract (ToT cp) (ToT st)
-> ContractCode cp st -> Contract cp st vd
Contract ContractCode arg (Maybe ret)
forall {cp} {st}. ContractCode cp st
fakeDoc (Contract' Instr (ToT arg) ('TOption (ToT ret))
-> Contract arg (Maybe ret) ())
-> Contract' Instr (ToT arg) ('TOption (ToT ret))
-> Contract arg (Maybe ret) ()
forall a b. (a -> b) -> a -> b
$ (IsNotInView =>
Instr
(ContractInp (ToT arg) ('TOption (ToT ret)))
(ContractOut ('TOption (ToT ret))))
-> Contract' Instr (ToT arg) ('TOption (ToT ret))
forall (cp :: T) (st :: T) (instr :: [T] -> [T] -> *).
(ParameterScope cp, StorageScope st) =>
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st
T.defaultContract ((IsNotInView =>
Instr
(ContractInp (ToT arg) ('TOption (ToT ret)))
(ContractOut ('TOption (ToT ret))))
-> Contract' Instr (ToT arg) ('TOption (ToT ret)))
-> (IsNotInView =>
Instr
(ContractInp (ToT arg) ('TOption (ToT ret)))
(ContractOut ('TOption (ToT ret))))
-> Contract' Instr (ToT arg) ('TOption (ToT ret))
forall a b. (a -> b) -> a -> b
$
Instr (ContractInp (ToT arg) ('TOption (ToT ret))) '[ToT arg]
forall {inp :: [T]} {out :: [T]} (a :: T) (b :: T) (s :: [T]).
(inp ~ ('TPair a b : s), out ~ (a : s)) =>
Instr inp out
T.CAR Instr (ContractInp (ToT arg) ('TOption (ToT ret))) '[ToT arg]
-> Instr '[ToT arg] (ContractOut ('TOption (ToT ret)))
-> Instr
(ContractInp (ToT arg) ('TOption (ToT ret)))
(ContractOut ('TOption (ToT ret)))
forall (a :: [T]) (c :: [T]) (b :: [T]).
Instr a b -> Instr b c -> Instr a c
:# Instr '[] '[ 'TAddress] -> Instr '[ToT arg] '[ToT arg, 'TAddress]
forall (a :: [T]) (c :: [T]) (b :: T).
Instr a c -> Instr (b : a) (b : c)
T.DIP (Value' Instr 'TAddress -> Instr '[] '[ 'TAddress]
forall {inp :: [T]} {out :: [T]} (t :: T) (s :: [T]).
(inp ~ s, out ~ (t : s), ConstantScope t) =>
Value' Instr t -> Instr inp out
T.PUSH (Value' Instr 'TAddress -> Instr '[] '[ 'TAddress])
-> Value' Instr 'TAddress -> Instr '[] '[ 'TAddress]
forall a b. (a -> b) -> a -> b
$ Address -> Value (ToT Address)
forall a. IsoValue a => a -> Value (ToT a)
toVal (Address -> Value (ToT Address)) -> Address -> Value (ToT Address)
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Address
forall a. ToAddress a => a -> Address
toAddress ContractAddress
ch)
Instr '[ToT arg] '[ToT arg, 'TAddress]
-> Instr '[ToT arg, 'TAddress] (ContractOut ('TOption (ToT ret)))
-> Instr '[ToT arg] (ContractOut ('TOption (ToT ret)))
forall (a :: [T]) (c :: [T]) (b :: [T]).
Instr a b -> Instr b c -> Instr a c
:# ViewName -> Instr '[ToT arg, 'TAddress] '[ 'TOption (ToT ret)]
forall {inp :: [T]} {out :: [T]} (arg :: T) (ret :: T) (s :: [T]).
(inp ~ (arg : 'TAddress : s), out ~ ('TOption ret : s), SingI arg,
ViewableScope ret) =>
ViewName -> Instr inp out
T.VIEW (Text -> ViewName
T.UnsafeViewName (Text -> ViewName) -> Text -> ViewName
forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @name)
Instr '[ToT arg, 'TAddress] '[ 'TOption (ToT ret)]
-> Instr '[ 'TOption (ToT ret)] (ContractOut ('TOption (ToT ret)))
-> Instr '[ToT arg, 'TAddress] (ContractOut ('TOption (ToT ret)))
forall (a :: [T]) (c :: [T]) (b :: [T]).
Instr a b -> Instr b c -> Instr a c
:# Instr
'[ 'TOption (ToT ret)] '[ 'TList 'TOperation, 'TOption (ToT ret)]
forall {inp :: [T]} {out :: [T]} (p :: T) (s :: [T]).
(inp ~ s, out ~ ('TList p : s), SingI p) =>
Instr inp out
T.NIL Instr
'[ 'TOption (ToT ret)] '[ 'TList 'TOperation, 'TOption (ToT ret)]
-> Instr
'[ 'TList 'TOperation, 'TOption (ToT ret)]
(ContractOut ('TOption (ToT ret)))
-> Instr '[ 'TOption (ToT ret)] (ContractOut ('TOption (ToT ret)))
forall (a :: [T]) (c :: [T]) (b :: [T]).
Instr a b -> Instr b c -> Instr a c
:# Instr
'[ 'TList 'TOperation, 'TOption (ToT ret)]
(ContractOut ('TOption (ToT ret)))
forall {inp :: [T]} {out :: [T]} (a :: T) (b :: T) (s :: [T]).
(inp ~ (a : b : s), out ~ ('TPair a b : s)) =>
Instr inp out
T.PAIR
where
fakeDoc :: ContractCode cp st
fakeDoc = ('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
forall cp st.
('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
L.ContractCode (('[(cp, st)] :-> ContractOut st) -> ContractCode cp st)
-> ('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
forall a b. (a -> b) -> a -> b
$ (Any :-> Any) -> '[(cp, st)] :-> ContractOut st
forall (s1 :: [*]) (s2 :: [*]) (s1' :: [*]) (s2' :: [*]).
(s1 :-> s2) -> s1' :-> s2'
L.fakeCoercing Any :-> Any
forall (s :: [*]). s :-> s
L.nop