BigMapGet.hs

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

module Test.BigMapGet
  ( test_BigMapGetUnit
  ) where

import Control.Lens (at)
import Test.Hspec.Expectations (shouldThrow)
import Test.HUnit (Assertion, assertFailure)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

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

import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Michelson.Typed
import Morley.Tezos.Address
import Test.Addresses
import Test.Util
import TestM

bigMapGetHandlers :: Handlers TestM
bigMapGetHandlers = defaultHandlers
  { hGetContractBigMap = \blkId addr GetBigMap{..} -> do
      assertHeadBlockId blkId
      use (fsContractsL . at addr) >>= \case
        Nothing -> throwM $ UnknownAccount $ Constrained addr
        Just AccountState{..} -> case asAccountData of
          ContractData _ mbBigMap -> case mbBigMap of
            Nothing -> throwM $ ContractDoesntHaveBigMap $ MkAddress addr
            Just ContractStateBigMap{..} ->
              case csbmMap ^. at (encodeBase58Check $ expressionToScriptExpr bmKey)  of
                Nothing -> pure GetBigMapNotFound
                Just serializedValue -> pure $ GetBigMapResult $ decodeExpression serializedValue
  }

fakeStateWithBigMapContract
  :: FakeState
fakeStateWithBigMapContract = defaultFakeState
  { fsContracts = fromList $
    [ (contractAddress1, dumbContractState
        { asAccountData = (asAccountData dumbContractState) & \case
            ContractData os _ -> ContractData os $ Just $
              mapToContractStateBigMap @Integer @Integer bigMapId $ fromList [(2, 3), (3, 5)]
        })
    , (contractAddress2, dumbContractState)
    ]
  }
  where
    bigMapId :: BigMapId Integer Integer
    bigMapId = BigMapId 123

test_BigMapGetUnit :: TestTree
test_BigMapGetUnit = testGroup "Fake test big map getter"
  [ testCase "Successful big map get" $ handleSuccessfulGet $
    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt contractAddress1 $
        L.toVal (3 :: Integer)
  , testCase "Value not found in big map" $ handleValueNotFound $
    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt contractAddress1 $
        L.toVal (4 :: Integer)
  , testCase "Contract without big map" $ handleContractWithoutBigMap $
    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt contractAddress2 $
        L.toVal (2 :: Integer)
  , testCase "Big map get for unknown contract" $ handleUnknownContract $
    runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $
      readContractBigMapValue @'TInt @'TInt contractAddress3 $
        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
        UnknownAccount _ -> 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