-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Test.Lorentz.Interpreter
  ( test_Entry_points_lookup
  , test_Entry_points_calling
  ) where

import qualified Data.Map as Map
import System.FilePath ((</>))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import Util.Named ((.!))

import Lorentz.Test.Integrational
import Michelson.Interpret (ContractEnv(..))
import Michelson.Test (testTreesWithTypedContract)
import Michelson.Test.Dummy (dummyContractEnv)
import Michelson.Test.Unit
import Michelson.Text
import Michelson.Typed (IsoValue(..))
import qualified Michelson.Typed as T
import qualified Michelson.Untyped as U
import Tezos.Address
import Tezos.Core

test_Entry_points_lookup :: IO [TestTree]
test_Entry_points_lookup =
  testTreesWithTypedContract (dir </> "call1.mtz") $ \call1 ->
  testTreesWithTypedContract (dir </> "call2.mtz") $ \call2 ->
  testTreesWithTypedContract (dir </> "call3.mtz") $ \call3 ->
  testTreesWithTypedContract (dir </> "call4.mtz") $ \call4 ->
  testTreesWithTypedContract (dir </> "call5.mtz") $ \call5 ->
  testTreesWithTypedContract (dir </> "call6.mtz") $ \call6 ->
  testTreesWithTypedContract (dir </> "call7.mtz") $ \call7 ->
  pure
  [ testGroup "Calling contract without default entrypoint"
    [ testCase "Calling default entrypoint refers to the root" $
        checkProp call1 validateSuccess (addr "simple")
    , testCase "Calling some entrypoint refers this entrypoint" $
        checkProp call7 validateSuccess (addr "simple")
    ]
  , testGroup "Calling contract with default entrypoint"
    [ testCase "Calling default entrypoint works" $
        checkProp call2 validateSuccess (addr "def")
    ]
  , testGroup "Common failures"
    [ testCase "Fails on type mismatch" $
        checkProp call1 validateFailure (addr "def")
    , testCase "Fails on entrypoint not found" $
        checkProp call3 validateFailure (addr "simple")
    ]
  , testGroup "Referring entrypoints groups"
    [ testCase "Can refer entrypoint group" $
        checkProp call4 validateSuccess (addr "complex")
    , testCase "Works with annotations" $
        checkProp call5 validateSuccess (addr "complex")
    , testCase "Does not work on annotations mismatch in 'contract' type argument" $
        checkProp call6 validateFailure (addr "complex")
    ]
  ]
  where
    checkProp contract validator callee =
      contractProp @Address @()
        contract validator
        dummyContractEnv{ ceContracts = Map.fromList env }
        callee ()
    validateFailure = validateMichelsonFailsWith ()

    dir = entrypointsDir
    contractSimpleTy =
      U.Type (U.TOr (U.ann "a") (U.ann "b") (U.Type U.TInt U.noAnn) (U.Type U.TNat U.noAnn))
             U.noAnn
    contractComplexTy =
      U.Type (U.TOr (U.ann "s") (U.ann "t") (U.Type U.TString U.noAnn) contractSimpleTy)
             U.noAnn
    contractWithDefTy =
      U.Type (U.TOr (U.ann "a") (U.ann "default") (U.Type U.TNat U.noAnn) (U.Type U.TString U.noAnn))
             U.noAnn
    addr = ContractAddress . mkContractHashHack
    env =
      [ (mkContractHashHack "simple", U.ParameterType contractSimpleTy U.noAnn)
      , (mkContractHashHack "complex", U.ParameterType contractComplexTy U.noAnn)
      , (mkContractHashHack "def", U.ParameterType contractWithDefTy U.noAnn)
      ]

test_Entry_points_calling :: IO [TestTree]
test_Entry_points_calling =
  testTreesWithTypedContract (dir </> "call1.mtz") $
    \(call1 :: T.Contract (ToT Address) (ToT ())) ->
  testTreesWithTypedContract (dir </> "contract1.mtz") $
    \(contract1 :: T.Contract (ToT (Either Integer MText)) (ToT Integer)) ->
  testTreesWithTypedContract (dir </> "self1.mtz") $
    \(self1 :: T.Contract (ToT (Either Integer ())) (ToT Integer)) ->
  pure
  [ testCase "Calling some entrypoint in CONTRACT" $
      integrationalTestExpectation $ do
        callerRef <- tOriginate call1 "caller" (toVal ()) (toMutez 100)
        targetRef <- tOriginate contract1 "target" (toVal @Integer 0) (toMutez 100)

        tTransfer (#from .! genesisAddress) (#to .! callerRef) (toMutez 1)
          T.DefEpName (toVal targetRef)

        tExpectStorageConst targetRef (toVal @Integer 5)

  , testCase "Calling some entrypoint in SELF" $
      integrationalTestExpectation $ do
        contractRef <- tOriginate self1 "self" (toVal @Integer 0) (toMutez 100)

        tTransfer (#from .! genesisAddress) (#to .! contractRef) (toMutez 1)
          T.DefEpName (toVal $ Right @Integer ())

        tExpectStorageConst contractRef (toVal @Integer 5)
  ]
  where
    dir = entrypointsDir

entrypointsDir :: FilePath
entrypointsDir = ".." </> ".." </> "contracts" </> "entrypoints"