cleveland-0.1.1: test/TestSuite/Cleveland/StorageWithBigMaps.hs
-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA
{-# LANGUAGE OverloadedLists #-}
module TestSuite.Cleveland.StorageWithBigMaps
( test_EMPTY_BIG_MAP
, test_UPDATE
, test_DUP
, 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, testGroup)
import Unsafe qualified (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_EMPTY_BIG_MAP :: TestTree
test_EMPTY_BIG_MAP =
testScenario "EMPTY_BIG_MAP always creates a new ID" $ scenario do
forM_ contracts \c -> do
addr <- originateSimple "contract" [("a", 1)] c
id0 <- getStorage addr
call addr CallDefault ()
unBigMapId <$> getStorage addr @@/= unBigMapId id0
where
contracts :: [Contract () (BigMap MText Integer) ()]
contracts = [createEmptyBigMap, copyToEmptyBigMap]
createEmptyBigMap :: Contract () (BigMap MText Integer) ()
createEmptyBigMap = L.mkContractWith L.intactCompilationOptions $
L.drop
# L.emptyBigMap
# L.nil # L.pair
copyToEmptyBigMap :: Contract () (BigMap MText Integer) ()
copyToEmptyBigMap = L.mkContractWith L.intactCompilationOptions $
L.drop
# L.emptyBigMap @MText @Integer
# L.push @Integer 1
# L.some
# L.push @MText "a"
# L.update
# L.nil # L.pair
test_UPDATE :: TestTree
test_UPDATE =
testScenario "UPDATE never creates a new ID" $ scenario do
addr <- originateSimple "contract" [("12", 12)] updateBigMap
id0 <- getStorage addr
call addr CallDefault ()
unBigMapId <$> getStorage addr @@== unBigMapId id0
where
updateBigMap :: Contract () (BigMap MText Integer) ()
updateBigMap = L.mkContractWith L.intactCompilationOptions $
L.cdr
# L.push 12 # L.some
# L.push "12"
# L.update
# L.nil # L.pair
test_DUP :: TestTree
test_DUP =
-- This is a case where the emulator and the network's implementation diverge *slightly*.
--
-- * In the emulator, the @DUP@ instruction _always_ creates a new bigmap ID.
-- * In a network, the @DUP@ instruction _usually_ creates a new bigmap ID,
-- except in a very specific situation: when you duplicate a bigmap, save
-- the duplicate in the storage and discard the old bigmap.
-- When this happens, the old bigmap's ID is reused and assigned to the new bigmap.
--
-- I don't think the fact that the two implementations diverge is a problem per se,
-- because, IMO, users shouldn't rely on bigmap's IDs remaining the same
-- across contract calls anyways.
--
-- This test is here as a means of documentation.
testGroup "DUP"
[ testScenario "BigMap ID may be reused when old BigMap is discarded" $ scenario do
addr <- originateSimple "contract" [("a", 1)] dupAndDiscardOld
originalId <- getStorage addr
call addr CallDefault ()
dupId <- getStorage addr
ifEmulation @()
-- In the emulator, the dupped bigmap is always assigned a brand new ID.
(do unBigMapId dupId @/= unBigMapId originalId)
-- In a network, the old ID might be reused.
(do unBigMapId dupId @== unBigMapId originalId)
, testScenario "A new BigMap ID is generated when the old BigMap is not discarded" $ scenario do
addr <- originateSimple "contract" ([("a", 1)], [("a", 1)]) dupAndKeepBoth
(id0, _) <- getStorage addr
call addr CallDefault ()
(id1, dupId) <- getStorage addr
-- The original bigmap's ID did not change
unBigMapId id0 @== unBigMapId id1
-- The dupped bigmap has been assigned a new ID
unBigMapId dupId @/= unBigMapId id1
]
where
-- Duplicate an existing bigmap, save it in the storage, and discard the old bigmap.
dupAndDiscardOld :: Contract () (BigMap MText Integer) ()
dupAndDiscardOld = L.mkContractWith L.intactCompilationOptions $
L.cdr
# L.dup
# L.dip L.drop
# L.nil # L.pair
-- Duplicate an existing bigmap, save both (the old and the new) bigmaps in the storage.
dupAndKeepBoth :: Contract () (BigMap MText Integer, BigMap MText Integer) ()
dupAndKeepBoth = L.mkContractWith L.intactCompilationOptions $
L.cdr
# L.car
# L.stackType @'[ BigMap MText Integer ]
# L.dup
# L.swap
# L.pair
# L.nil # L.pair
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")]