-- SPDX-FileCopyrightText: 2020 Tocqueville Group -- -- SPDX-License-Identifier: LicenseRef-MIT-TQ module Test.Lorentz.UStore.Migration.FillInParts ( test_Migration_works ) where import Test.HUnit (assertFailure, (@?=)) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase) import qualified Lorentz as L import Lorentz.Run.Simple import Lorentz.UStore import Lorentz.UStore.Haskell import Lorentz.UStore.Migration import Michelson.Text data MyTemplateWrapper substore = MyTemplateWrapper { commonField :: UStoreField MText , custom :: substore } deriving stock (Eq, Show, Generic) data MySubTemplatePart1 = MySubTemplatePart1 { int :: UStoreField Integer , nat :: UStoreField Natural } deriving stock (Eq, Show, Generic) part1Val :: MySubTemplatePart1 part1Val = MySubTemplatePart1{ int = UStoreField -1, nat = UStoreField 1 } data MySubTemplatePart2 = MySubTemplatePart2 { string :: UStoreField MText } deriving stock (Eq, Show, Generic) part2Val :: MySubTemplatePart2 part2Val = MySubTemplatePart2{ string = UStoreField [mt|bb|] } type MyTemplateV0 = MyTemplateWrapper () type MyTemplateV1 = MyTemplateWrapper (MySubTemplatePart1, MySubTemplatePart2) migrationBatched :: UStoreMigration MyTemplateV0 MyTemplateV1 migrationBatched = mkUStoreBatchedMigration $ muBlock $: L.push [mt|bb|] L.# migrateModifyField #commonField <--> fillUStoreMigrationBlock part1Val <--> fillUStoreMigrationBlock part2Val <--> migrationFinish migrationSimple :: UStoreMigration MyTemplateV0 MyTemplateV1 migrationSimple = mkUStoreMigration $ L.push [mt|bb|] L.# migrateModifyField #commonField L.# migrateFillUStore part1Val L.# migrateFillUStore part2Val L.# migrationFinish test_Migration_works :: [TestTree] test_Migration_works = [ ("simple migration", migrationSimple) , ("batched migration", migrationBatched) ] <&> \(desc, migration) -> testCase desc $ migratesToWith migration MyTemplateWrapper { commonField = UStoreField [mt|aa|] , custom = () } MyTemplateWrapper { commonField = UStoreField [mt|bb|] , custom = (part1Val, part2Val) } where migratesToWith migration storeV1 expectedStoreV2 = either (assertFailure . toString) (@?= expectedStoreV2) $ do let storeV2 = migrationToLambda migration -$ mkUStore storeV1 ustoreDecomposeFull storeV2