MonadOps.hs

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

module TestSuite.Cleveland.MonadOps
  ( test_MonadOps
  , test_MonadOpsBatch
  ) where

import Test.Tasty (TestTree)

import Morley.Util.SizedList (IsoNatPeano, SizedList)
import Test.Cleveland
import Test.Cleveland.Internal.Actions (MonadOriginate, MonadTransfer)

import TestSuite.Util

test_MonadOps :: TestTree
test_MonadOps =
  testScenario "MonadOps works" $ scenario go

test_MonadOpsBatch :: TestTree
test_MonadOpsBatch =
  testScenario "Batched MonadOps works" $ scenario do
    addrs <- newAddresses $ enumAliases "test"
    inBatch $ goBatch @3 addrs

-- NB: We're testing 'MonadOps' behavior here, hence it's important for 'go' and
-- 'goBatch' to be separate polymorphic functions, otherwise those would just
-- run in 'MonadCleveland' context.

go :: (Monad m, MonadOps m) => m ()
go = do
  ct <- originateMonadOps
  transferMonadOps ct

goBatch
  :: forall n n' m. (IsoNatPeano n n', Applicative m, MonadOps m)
  => SizedList n ImplicitAddressWithAlias -> m ()
goBatch addrs = for_ addrs \addr -> transfer addr (123 :: Mutez)

-- NB: The same applies to 'MonadOriginate' and 'MonadTransfer' in functions
-- below as to 'MonadOps' above -- we want those to be separate polymorphic
-- functions as it's basically the point of these tests.

originateMonadOps :: MonadOriginate m => m (ContractHandle () () ())
originateMonadOps = originate "idContract" () idContract

transferMonadOps :: MonadTransfer m => ContractHandle () () () -> m ()
transferMonadOps ct = transfer ct (123 :: Mutez) $ calling def ()