BigMapGet.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Test.BigMapGet
  ( test_BigMapGetUnit
  ) where

import Data.Map (fromList, lookup)
import Test.HUnit (Assertion, assertFailure)
import Test.Hspec.Expectations (shouldThrow)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import qualified Lorentz as L
import Lorentz.Pack (expressionToScriptExpr)
import Morley.Micheline (decodeExpression)
import Morley.Tezos.Crypto (encodeBase58Check)

import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Client.TezosClient.Types (AddressOrAlias(..))
import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3)
import Morley.Michelson.Typed
import Test.Util
import TestM

bigMapGetHandlers :: Handlers TestM
bigMapGetHandlers = defaultHandlers
  { hGetContractBigMap = \blkId addr GetBigMap{..} -> do
      assertHeadBlockId blkId
      st <- get
      case lookup addr (msContracts st) of
        Nothing -> throwM $ UnknownContract $ AddressResolved addr
        Just ContractState{..} -> case csContractData of
          ImplicitContractData _ -> throwM $ UnexpectedImplicitContract addr
          ContractData _ mbBigMap -> case mbBigMap of
            Nothing -> throwM $ ContractDoesntHaveBigMap addr
            Just ContractStateBigMap{..} -> case lookup (encodeBase58Check $ expressionToScriptExpr bmKey) csbmMap of
              Nothing -> pure GetBigMapNotFound
              Just serializedValue -> pure $ GetBigMapResult $ decodeExpression serializedValue
  }

mockStateWithBigMapContract
  :: MockState
mockStateWithBigMapContract = defaultMockState
  { msContracts = fromList $
    [ (genesisAddress1, dumbContractState
        { csContractData = (csContractData dumbContractState) & \case
            ContractData os _ -> ContractData os $ Just $
              mapToContractStateBigMap @Integer @Integer bigMapId $ fromList [(2, 3), (3, 5)]
            implicitData -> implicitData
        })
    , (genesisAddress2, dumbContractState)
    ]
  }
  where
    bigMapId :: BigMapId Integer Integer
    bigMapId = BigMapId 123

test_BigMapGetUnit :: TestTree
test_BigMapGetUnit = testGroup "Mock test big map getter"
  [ testCase "Successful big map get" $ handleSuccessfulGet $
    runMockTest bigMapGetHandlers mockStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt genesisAddress1 $
        L.toVal (3 :: Integer)
  , testCase "Value not found in big map" $ handleValueNotFound $
    runMockTest bigMapGetHandlers mockStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt genesisAddress1 $
        L.toVal (4 :: Integer)
  , testCase "Contract without big map" $ handleContractWithoutBigMap $
    runMockTest bigMapGetHandlers mockStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt genesisAddress2 $
        L.toVal (2 :: Integer)
  , testCase "Big map get for unknown contract" $ handleUnknownContract $
    runMockTest bigMapGetHandlers mockStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt genesisAddress3 $
        L.toVal (2 :: Integer)
  ]
  where
    handleSuccessfulGet :: Either SomeException a -> Assertion
    handleSuccessfulGet (Right _) = pass
    handleSuccessfulGet (Left e) = assertFailure $ displayException e

    handleUnknownContract :: Either SomeException a -> Assertion
    handleUnknownContract (Right _) =
      assertFailure "Big map get unexpectedly didn't fail."
    handleUnknownContract (Left e) =
      shouldThrow (throwM e) $ \case
                                 UnknownContract _ -> True
                                 _ -> False

    handleValueNotFound :: Either SomeException a -> Assertion
    handleValueNotFound (Right _) =
      assertFailure "Big map get unexpectedly didn't fail."
    handleValueNotFound (Left e) =
      shouldThrow (throwM e) $ \case ValueNotFound -> True

    handleContractWithoutBigMap :: Either SomeException a -> Assertion
    handleContractWithoutBigMap (Right _) =
      assertFailure "Big map get unexpectedly didn't fail."
    handleContractWithoutBigMap (Left e) =
      shouldThrow (throwM e) $ \case
                                 ContractDoesntHaveBigMap _ -> True
                                 _ -> False