StorageWithBigMaps.hs

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

{-# LANGUAGE OverloadedLists #-}

module TestSuite.Cleveland.StorageWithBigMaps
  ( test_UniqueIDs
  , test_getAllBigMapValues
  , test_getAllBigMapValues_ConsistentWith_getBigMapValue
  , test_getBigMapSize
  , test_GetBigMapValue
  , test_GetBigMapValueMaybe_InvalidBigMapId
  , test_GetBigMapValueMaybe_InvalidKey
  , test_ID_BecomesInvalid
  ) where

import Lorentz as L hiding (assert)

import Control.Lens (to)
import Data.Data (Data)
import Data.Data.Lens (biplate)
import Fmt (Builder, blockListF, unlinesF)
import Test.Tasty (TestTree)
import qualified Unsafe (fromIntegral)

import Test.Cleveland
import TestSuite.Util (idContract, saveInStorageContract)

data BigMaps = BigMaps
  { _bmBigMap :: BigMap Natural Natural
  , _bmOpt :: Maybe (BigMap Natural Natural)
  , _bmList :: [BigMap Natural Natural]
  , _bmPair :: (BigMap Natural Natural, BigMap Natural Natural)
  , _bmLeft :: Either (BigMap Natural Natural) (BigMap Natural Natural)
  , _bmRight :: Either (BigMap Natural Natural) (BigMap Natural Natural)
  , _bmMap :: Map Natural (BigMap Natural Natural)
  }
  deriving stock (Generic)
  deriving anyclass (IsoValue, HasAnnotation)

deriveRPC "BigMaps"
deriving stock instance Data BigMapsRPC

-- | There are 5 ways of creating big_maps on the chain:
--
-- * Originate a contract with big_maps in its initial storage.
-- * Call a contract with a parameter with big_maps in it, and then save those big_maps in the contract's storage.
-- * While executing a contract's code:
--     * execute the `EMPTY_BIG_MAP` instruction.
--     * execute the `DUP` instruction to duplicate a big_map or a value containing big_map(s).
--     * execute the `DUP n` instruction to duplicate a big_map or a value containing big_map(s).
--
-- This contract does all of those things.
createBigMaps :: Contract BigMaps BigMaps ()
createBigMaps = defaultContract $
  unpair
  # L.dip (getField #_bmList)

  -- Extract all the big_maps that were passed in through the transfer's parameter
  -- and save them in the contract's storage.
  # extractBigMaps

  -- Create new big_maps via: EMPTY_BIG_MAP, DUP, DUP n.
  -- Note: instead of duplicating a `big_map k v`, we duplicate a `list (big_map k v)` to ensure
  -- the algorithm works even on deeply nested big_maps.
  # nil # emptyBigMap # cons
  # dup
  # dupN @2

  -- Merge all the big_maps into the storage's `_bmList` field
  # joinList # joinList # joinList # joinList
  # setField #_bmList

  # nil @Operation
  # pair

  where
    joinList :: List a : List a : s :-> List a : s
    joinList = L.iter cons

    extractBigMaps :: BigMaps : s :-> List (BigMap Natural Natural) : s
    extractBigMaps =
      L.listE
        [ L.getField #_bmBigMap
        , L.getField #_bmOpt # L.assertSome @MText "Expected Some, got None"
        , getField #_bmLeft # assertLeft @MText "Expected Left, got Right"
        , getField #_bmRight # assertRight @MText "Expected Right, got Left"
        ]
      # L.swap

      # getField #_bmList
      # L.swap # dip joinList

      # getField #_bmPair
      # L.swap # dip (unpair # dip cons # cons)

      # getField #_bmMap
      # L.swap # dip (iter (cdr # cons))

      # L.drop

test_UniqueIDs :: TestTree
test_UniqueIDs =
  testScenario "all big_maps have unique IDs" $ scenario do
    let bm = [(1, 1)]
    let bigMaps =
          BigMaps
            bm
            (Just bm)
            [bm]
            (bm, bm)
            (Left bm)
            (Right bm)
            [(1, bm)]

    -- Originate the contract.
    -- Call the contract twice, to make sure the BigMapCounter is incremented
    -- inbetween operations.
    addr <- originateSimple "create-big-maps" bigMaps createBigMaps
    call addr CallDefault bigMaps
    call addr CallDefault bigMaps

    finalStorage <- getStorage addr
    let bigMapIds = finalStorage ^.. biplate @_ @(BigMapId Natural Natural) . to unBigMapId

    -- The contract's storage should have 30 big_maps in total.
    --   * 8 created via the contract's initial storage,
    --   * For each contract call:
    --       * 8 that were passed in through the call's parameter
    --       * 1 via `EMPTY_BIG_MAP`, 1 via `DUP`, 1 via `DUP n`
    length bigMapIds @== 30

    assert (bigMapIds == ordNub bigMapIds) $
      unlinesF @[] @Builder
        [ "Expected all big_maps to have unique IDs, but some duplicates were found:"
        , blockListF (sort bigMapIds)
        ]

test_GetBigMapValue :: TestTree
test_GetBigMapValue =
  testScenario "getBigMapValue retrieves the correct value" $ scenario do
    contract1 <- originateSimple @() @(BigMap Integer MText, BigMap Integer MText)
      "contract1"
      ([(1, "a"), (2, "b")], [(1, "c"), (2, "d")])
      idContract
    contract2 <- originateSimple @() @(BigMap Integer MText, BigMap Integer MText)
      "contract1"
      ([(1, "e"), (2, "f")], [(1, "g"), (2, "h")])
      idContract

    (bigMap1, bigMap2) <- getStorage contract1
    (bigMap3, bigMap4) <- getStorage contract2

    getBigMapValue bigMap1 1 @@== "a"
    getBigMapValue bigMap1 2 @@== "b"
    getBigMapValue bigMap2 1 @@== "c"
    getBigMapValue bigMap2 2 @@== "d"
    getBigMapValue bigMap3 1 @@== "e"
    getBigMapValue bigMap3 2 @@== "f"
    getBigMapValue bigMap4 1 @@== "g"
    getBigMapValue bigMap4 2 @@== "h"

test_getBigMapSize :: TestTree
test_getBigMapSize =
  testScenario "getBigMapSize retrieves the correct size" $ scenario do
    let
      bmList = sampleList ++ [(5, "d")]
      expectedSize = Unsafe.fromIntegral @Int @Natural $ length bmList
    c <- originateSimple @() @(BigMap Integer MText) "contract" (mkBigMap bmList) idContract

    bigMapId <- getStorage c
    bmSize <- getBigMapSize bigMapId

    bmSize @== expectedSize

test_getAllBigMapValues :: TestTree
test_getAllBigMapValues =
  testScenario "getAllBigMapValues retrieves the correct values" $ scenario do
    let bmValues = snd <$> sampleList
    c <- originateSimple @() @(BigMap Integer MText) "contract" (mkBigMap sampleList) idContract

    bigMapId <- getStorage c
    vs <- getAllBigMapValues bigMapId

    sort vs @== sort bmValues

test_getAllBigMapValues_ConsistentWith_getBigMapValue :: TestTree
test_getAllBigMapValues_ConsistentWith_getBigMapValue =
  testScenario "results of 'getAllBigMapValues' and 'getBigMapValue' are consistent" $ scenario do
    c <- originateSimple @() @(BigMap Integer MText)
      "contract"
      (mkBigMap sampleList)
      idContract

    bigMapId <- getStorage c

    vs <- forM sampleList $ \(k, _) -> getBigMapValue bigMapId k
    vs' <- getAllBigMapValues bigMapId

    sort vs @== sort vs'
    length vs @== length vs'

test_GetBigMapValueMaybe_InvalidBigMapId :: TestTree
test_GetBigMapValueMaybe_InvalidBigMapId =
  testScenario "getBigMapValueMaybe returns 'Nothing' when big_map ID is invalid" $ scenario do
    let invalidBigMapId = 2 ^ (99 :: Natural)
    getBigMapValueMaybe @Integer @Integer invalidBigMapId 0 @@== Nothing

test_GetBigMapValueMaybe_InvalidKey :: TestTree
test_GetBigMapValueMaybe_InvalidKey =
  testScenario "getBigMapValueMaybe returns 'Nothing' when key is invalid" $ scenario do
    addr <- originateSimple @() @(BigMap Integer MText, BigMap Integer MText)
      "contract1"
      ([(1, "a"), (2, "b")], [(2, "c"), (3, "d")])
      idContract

    (bigMap1, bigMap2) <- getStorage addr

    getBigMapValueMaybe bigMap1 3 @@== Nothing
    getBigMapValueMaybe bigMap2 1 @@== Nothing

test_ID_BecomesInvalid :: TestTree
test_ID_BecomesInvalid =
  testScenario "big_map IDs become invalid once the big_map is removed from the storage" $ scenario do
    addr <- originateSimple @(BigMap Integer MText)
      "contract1"
      [(1, "a")]
      saveInStorageContract

    bigMapId <- getStorage addr
    getBigMapValueMaybe bigMapId 1 @@== Just "a"

    -- Replace the big_map in the contract's storage with a new big_map (with same contents).
    call addr CallDefault [(1, "a")]

    -- The old big_map ID should now be invalid.
    getBigMapValueMaybe bigMapId 1 @@== Nothing

    -- The new big_map in the contract's storage should have a different ID than the first big_map.
    fmap unBigMapId (getStorage addr) @@/= unBigMapId bigMapId

sampleList :: [(Integer, MText)]
sampleList = [(1, "a"), (2, "b"), (3, "c"), (4, "d")]