module Lorentz.Test.Integrational
(
TxData (..)
, genesisAddresses
, genesisAddress
, genesisAddress1
, genesisAddress2
, genesisAddress3
, genesisAddress4
, genesisAddress5
, genesisAddress6
, I.IntegrationalValidator
, SuccessValidator
, IntegrationalScenarioM
, I.IntegrationalScenario
, I.ValidationError (..)
, I.integrationalTestExpectation
, I.integrationalTestProperty
, lOriginate
, lOriginateEmpty
, lTransfer
, lCall
, I.validate
, I.setMaxSteps
, I.setNow
, I.withSender
, I.composeValidators
, I.composeValidatorsList
, I.expectAnySuccess
, lExpectStorageUpdate
, lExpectBalance
, lExpectStorageConst
, lExpectMichelsonFailed
, lExpectFailWith
, lExpectUserError
, lExpectConsumerStorage
, lExpectViewConsumerStorage
) where
import Data.Default (Default(..))
import Data.Singletons (SingI(..))
import Data.Typeable (gcast)
import Fmt (Buildable, listF, (+|), (|+))
import Named ((:!), arg)
import qualified Lorentz as L
import Michelson.Interpret (InterpretUntypedError(..), MichelsonFailed(..))
import Michelson.Runtime
import Michelson.Runtime.GState
import Michelson.Test.Integrational (IntegrationalScenarioM, SuccessValidator)
import qualified Michelson.Test.Integrational as I
import Michelson.TypeCheck (typeVerifyValue)
import qualified Michelson.Typed as T
import Tezos.Address
import Tezos.Core
import Util.Named ((.!))
tOriginate
:: (SingI cp, SingI st, T.HasNoOp st)
=> T.Contract cp st -> Text -> T.Value st -> Mutez -> IntegrationalScenarioM Address
tOriginate contract name value balance =
I.originate (T.convertContract contract) name (T.untypeValue value) balance
lOriginate
:: ( SingI (T.ToT cp), SingI (T.ToT st), T.HasNoOp (T.ToT st)
, T.IsoValue st
)
=> L.Contract cp st
-> Text
-> st
-> Mutez
-> IntegrationalScenarioM (T.ContractAddr cp)
lOriginate contract name value balance =
T.ContractAddr <$>
tOriginate (L.compileLorentz contract) name (T.toVal value) balance
lOriginateEmpty
:: ( SingI (T.ToT cp), SingI (T.ToT st), T.HasNoOp (T.ToT st)
, T.IsoValue st, Default st
)
=> L.Contract cp st
-> Text
-> IntegrationalScenarioM (T.ContractAddr cp)
lOriginateEmpty contract name = lOriginate contract name def (unsafeMkMutez 0)
tTransfer
:: (SingI cp, T.HasNoOp cp)
=> "from" :! Address
-> "to" :! Address
-> Mutez
-> T.Value cp
-> IntegrationalScenarioM ()
tTransfer (arg #from -> from) (arg #to -> to) money param =
let txData = TxData
{ tdSenderAddress = from
, tdParameter = T.untypeValue param
, tdAmount = money
}
in I.transfer txData to
lTransfer
:: (SingI (T.ToT cp), T.HasNoOp (T.ToT cp), T.IsoValue cp)
=> "from" :! Address
-> "to" :! T.ContractAddr cp
-> Mutez
-> cp
-> IntegrationalScenarioM ()
lTransfer from (arg #to -> T.ContractAddr to) money param =
tTransfer from (#to .! to) money (T.toVal param)
lCall
:: (SingI (T.ToT cp), T.HasNoOp (T.ToT cp), T.IsoValue cp)
=> T.ContractAddr cp -> cp -> IntegrationalScenarioM ()
lCall contract param =
lTransfer (#from .! genesisAddress) (#to .! contract)
(unsafeMkMutez 1000) param
lExpectStorageUpdate
:: ( T.IsoValue st, Each [Typeable, SingI, T.HasNoOp] '[T.ToT st]
, HasCallStack
)
=> T.ContractAddr cp -> (st -> Either I.ValidationError ()) -> SuccessValidator
lExpectStorageUpdate (T.ContractAddr addr) predicate =
I.expectStorageUpdate addr $ \got -> do
val <- first I.UnexpectedTypeCheckError $ typeCheck got
predicate $ T.fromVal val
where
typeCheck uval =
evaluatingState initSt . runExceptT $
usingReaderT def $
typeVerifyValue uval
initSt = error "Typechecker state unavailable"
lExpectBalance :: T.ContractAddr cp -> Mutez -> SuccessValidator
lExpectBalance (T.ContractAddr addr) money = I.expectBalance addr money
lExpectStorageConst
:: (T.IsoValue st, Each '[SingI, T.HasNoOp] '[T.ToT st])
=> T.ContractAddr cp -> st -> SuccessValidator
lExpectStorageConst (T.ContractAddr addr) expected =
I.expectStorageConst addr (T.untypeValue $ T.toVal expected)
lExpectMichelsonFailed
:: (MichelsonFailed -> Bool) -> T.ContractAddr cp -> InterpreterError -> Bool
lExpectMichelsonFailed predicate (T.ContractAddr addr) =
I.expectMichelsonFailed predicate addr
lExpectFailWith
:: forall e.
(Typeable (T.ToT e), T.IsoValue e)
=> (e -> Bool) -> InterpreterError -> Bool
lExpectFailWith predicate =
\case
IEInterpreterFailed _ (RuntimeFailure (MichelsonFailedWith err, _)) ->
case gcast err of
Just errT -> predicate $ T.fromVal @e errT
Nothing -> False
_ -> False
lExpectUserError
:: forall e.
(Typeable (T.ToT e), T.IsoValue e)
=> (e -> Bool) -> InterpreterError -> Bool
lExpectUserError predicate = lExpectFailWith (predicate . L.unLorentzUserError)
lExpectConsumerStorage
:: (st ~ [cp], T.IsoValue st, Each [Typeable, SingI, T.HasNoOp] '[T.ToT st])
=> T.ContractAddr cp -> (st -> Either I.ValidationError ()) -> SuccessValidator
lExpectConsumerStorage = lExpectStorageUpdate
lExpectViewConsumerStorage
:: ( st ~ [cp], cp ~ (arg, Maybe res)
, Eq res, Buildable res
, T.IsoValue st, Each [Typeable, SingI, T.HasNoOp] '[T.ToT st]
)
=> T.ContractAddr cp -> [res] -> SuccessValidator
lExpectViewConsumerStorage addr expected =
lExpectConsumerStorage addr (extractJusts >=> matchExpected . reverse)
where
extractJusts = mapM $ \case
(_, Just got) -> pure got
(_, Nothing) -> mkError "Consumer got empty value unexpectedly"
mkError = Left . I.CustomError
matchExpected got
| got == expected = pass
| otherwise = mkError $ "Expected " +| listF expected |+
", but got " +| listF got |+ ""