ContractRegistry.hs

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

-- {-# LANGUAGE NoApplicativeDo, RebindableSyntax #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Tests on contract registry.
module Test.Lorentz.ContractRegistry
  ( unit_contractRegistryCommands
  ) where

import Lorentz
import Prelude hiding (drop)

import Data.Map qualified as Map
import System.Directory (removeFile)
import System.Directory.Internal.Prelude (isDoesNotExistError)
import Test.HUnit (Assertion, assertFailure)

import Lorentz.ContractRegistry

instance Exception Text

sampleContract :: Contract () () ()
sampleContract = defaultContract $
  drop # unit # nil # pair

sampleContractInfo :: ContractInfo
sampleContractInfo = ContractInfo
  { ciContract = sampleContract
  , ciIsDocumented = False
  , ciStorageParser = Just (pure ())
  , ciStorageNotes = Nothing
  }

singleContractReg :: ContractRegistry
singleContractReg = ContractRegistry $ Map.fromList
  [ "Sample" ?:: sampleContractInfo
  ]

multiContractReg :: ContractRegistry
multiContractReg = ContractRegistry $ Map.fromList
  [ "Sample" ?:: sampleContractInfo
  , "Sample2" ?:: sampleContractInfo
  ]

-- | Remove a file, checking that it is present. If not, an exception is raised.
checkAndRemoveFile :: HasCallStack => FilePath -> Assertion
checkAndRemoveFile file =
  removeFile file `catch` \e ->
    if isDoesNotExistError e
    then assertFailure $ "File \"" <> file <> "\" was not created"
    else throwM e

unit_contractRegistryCommands :: Assertion
unit_contractRegistryCommands = do

  runContractRegistry singleContractReg (Print Nothing Nothing False False)
  checkAndRemoveFile "Sample.tz"

  runContractRegistry multiContractReg (Print (Just "Sample2") Nothing False False)
  checkAndRemoveFile "Sample2.tz"

  -- Fail due to not specifying the name with a contract registry that contains multiple contracts.
  e <- try $ runContractRegistry multiContractReg (Print Nothing Nothing False False)
  case e of
    Right _ -> throwM ("Expect the test to fail." :: Text)
    Left (_ :: SomeException) -> pure ()