Simple.hs

-- 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