-- SPDX-FileCopyrightText: 2020 Tocqueville Group -- -- SPDX-License-Identifier: LicenseRef-MIT-TQ module Test.Lorentz.UStore.Migration.Simple ( test_Migration_works ) where import Fmt (pretty) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase) import Test.HUnit ((@?=), assertFailure) import qualified Lorentz as L import Lorentz.UStore import Lorentz.UStore.Migration import Lorentz.UStore.Migration.Diff import Michelson.Text import Michelson.Test.Dummy import Lorentz.Run import qualified Test.Lorentz.UStore.Migration.Simple.V1 as V1 import qualified Test.Lorentz.UStore.Migration.Simple.V2 as V2 _checkDiff :: Proxy (BuildDiff V1.MyTemplate V2.MyTemplate) _checkDiff = Proxy @ [ '( 'ToAdd, '("theName", UStoreField MText)) , '( 'ToAdd, '("transformed", UStoreField Integer)) , '( 'ToDel, '("useless", UStoreField MText)) , '( 'ToDel, '("transformed", UStoreField Natural)) ] migrationBatched :: UStoreMigration V1.MyTemplate V2.MyTemplate migrationBatched = mkUStoreBatchedMigration $ muBlock $: migrateExtractField #useless L.# L.push [mt|Token-|] L.# L.concat L.# migrateAddField #theName <--> muBlock $: L.push 3 L.# migrateOverwriteField #transformed <--> migrationFinish migrationSimple :: UStoreMigration V1.MyTemplate V2.MyTemplate migrationSimple = mkUStoreMigration $ migrateExtractField #useless L.# L.push [mt|Token-|] L.# L.concat L.# migrateAddField #theName L.# L.push 3 L.# migrateOverwriteField #transformed L.# migrationFinish test_Migration_works :: [TestTree] test_Migration_works = [ ("simple migration", migrationSimple) , ("batched migration", migrationBatched) ] <&> \(desc, migration) -> testCase desc $ migratesWith migration V1.MyTemplate { V1.bytes = UStoreSubMap mempty , V1.count = UStoreField 5 , V1.useless = UStoreField [mt|pog|] , V1.transformed = UStoreField 10 } V2.MyTemplate { V2.theName = UStoreField [mt|Token-pog|] , V2.bytes = UStoreSubMap mempty , V2.count = UStoreField 5 , V2.transformed = UStoreField 3 } where migratesWith migration storeV1 expectedStoreV2 = either (assertFailure . toString) (@?= expectedStoreV2) $ do storeV2 <- first pretty $ interpretLorentzLambda dummyContractEnv (migrationToLambda migration) (mkUStore storeV1) ustoreDecomposeFull storeV2