ViewsImport.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Tests on importing Lorentz contracts with views.

module Test.Lorentz.ViewsImport
  ( test_ViewsImport
  ) where

import Lorentz
import Prelude hiding (drop, some, swap, take, view)

import Morley.Util.MismatchError
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))
import Test.Util.Contracts

import Morley.Michelson.Typed qualified as T
import Test.Cleveland.Lorentz.Import

data AllViews
type instance RevealViews AllViews =
 '[ "add" ?:: Natural >-> Natural
  , "id" ?:: Natural >-> (Natural, ())
  , "fail" ?:: MText >-> Never
  ]

data IdView
type instance RevealViews IdView =
 '[ "id" ?:: Natural >-> (Natural, ())
  ]

data WrongIdView1
type instance RevealViews WrongIdView1 =
 '[ "id" ?:: Integer >-> (Natural, ())
  ]

data WrongIdView2
type instance RevealViews WrongIdView2 =
 '[ "id" ?:: Natural >-> (Integer, ())
  ]

data NonExistentView
type instance RevealViews NonExistentView =
 '[ "idd" ?:: Natural >-> (Natural, ())
  ]

data FewViews
type instance RevealViews FewViews =
 '[ "fail" ?:: MText >-> Never
  , "add" ?:: Natural >-> Natural
  ]

data WrongViewsSet
type instance RevealViews WrongViewsSet =
 '[ "fail" ?:: MText >-> ()
  , "add" ?:: Natural >-> Natural
  ]

test_ViewsImport :: TestTree
test_ViewsImport = testGroup "Views imports"
  let contractPath = inContractsDir "view_example.tz"
      importContract'
        :: forall vd. (NiceViewsDescriptor vd, DemoteViewsDescriptor vd)
        => IO ()
      importContract' = evaluateNF_ =<< importContract @() @() @vd contractPath
  in
  [ testCase "All views" do
      importContract' @AllViews

  , testCase "One present view" do
      importContract' @IdView

  , testCase "One view with wrong arg type" do
      importContract' @WrongIdView1
        `catch` \e ->
          e @?= VIMViewArgMismatch MkMismatchError{meActual=T.TNat, meExpected=T.TInt}

  , testCase "One view with wrong ret type" do
      importContract' @WrongIdView2
        `catch` \e ->
          e @?= VIMViewRetMismatch MkMismatchError
            {meActual=T.TPair T.TNat T.TUnit, meExpected=T.TPair T.TInt T.TUnit}

  , testCase "Non-existent view" do
      importContract' @NonExistentView
        `catch` \e ->
          e @?= VIMViewNotFound (UnsafeViewName "idd")

  , testCase "Few present views" do
      importContract' @FewViews

  , testCase "All views and one wrong view" do
      importContract' @WrongViewsSet
        `catch` \e ->
          e @?= VIMViewRetMismatch MkMismatchError{meActual=T.TNever, meExpected=T.TUnit}
  ]