Contracts.hs

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

-- | Utility functions to read sample contracts (for testing).

module Test.Util.Contracts
  ( contractsDir
  , inContractsDir
  , (</>)

  , getIllTypedContracts
  , getWellTypedContracts
  , getUnparsableContracts
  , getWellTypedMichelsonContracts
  , getWellTypedMorleyContracts
  , getContractsWithReferences
  ) where

import Data.List (isSuffixOf)
import System.Directory (listDirectory)
import System.FilePath (addExtension, (</>))

-- | Directory with sample contracts.
contractsDir :: FilePath
contractsDir = "../../contracts/"

inContractsDir :: FilePath -> FilePath
inContractsDir = (contractsDir </>)

getIllTypedContracts :: IO [FilePath]
getIllTypedContracts = do
  illTyped <- concatMapM (\ext ->
                            concatMapM (getContractsWithExtension ext)
                            illTypedContractDirs
                         ) [".tz", ".mtz"]
  unparsable <- getUnparsableContracts
  return $ filter (not . (flip elem unparsable)) illTyped

getWellTypedContracts :: IO [FilePath]
getWellTypedContracts = getWellTypedMichelsonContracts <> getWellTypedMorleyContracts

getUnparsableContracts :: IO [FilePath]
getUnparsableContracts = do
  unparsable <- concatMapM (flip getContractsWithExtension (contractsDir </> "unparsable"))
    [".tz", ".mtz"]
  return $ unparsable ++ unparsableExample


getWellTypedMichelsonContracts :: IO [FilePath]
getWellTypedMichelsonContracts =
  concatMapM (getContractsWithExtension ".tz") wellTypedContractDirs

getWellTypedMorleyContracts :: IO [FilePath]
getWellTypedMorleyContracts = concatMapM (getContractsWithExtension ".mtz") wellTypedContractDirs

getContractsWithExtension :: String -> FilePath -> IO [FilePath]
getContractsWithExtension ext dir = mapMaybe convertPath <$> listDirectory dir
  where
    convertPath :: FilePath -> Maybe FilePath
    convertPath fileName
      | (ext `isSuffixOf` fileName) =
        Just (dir </> fileName)
      | otherwise = Nothing

wellTypedContractDirs :: [FilePath]
wellTypedContractDirs =
  contractsDir :
  map ((contractsDir </> "tezos_examples") </>)
    [ "attic"
    , "entrypoints"
    , "macros"
    , "mini_scenarios"
    , "non_regression"
    , "opcodes"
    ]

illTypedContractDirs :: [FilePath]
illTypedContractDirs =
  [ contractsDir </> "ill-typed"
  , contractsDir </> "tezos_examples" </> "ill_typed"
  , contractsDir </> "tezos_examples" </> "legacy"
  ]

unparsableExample :: [FilePath]
unparsableExample =
  [ contractsDir </> "tezos_examples" </> "ill_typed" </> name
  | name <-
      [ "big_map_arity.tz"
      , "view_op_invalid_arity.tz"
      , "view_toplevel_invalid_arity.tz"
      ]
      ++
      [ "view_" <> kind <> "_bad_name_" <> name <> ".tz"
      | kind <- [ "op", "toplevel" ]
      , name <- [ "invalid_type", "invalid_char_set", "non_printable_char"
                , "too_long"
                ]
      ]
  ]

getContractsWithReferences :: String -> FilePath -> String -> IO [(FilePath, FilePath)]
getContractsWithReferences ext fp refExt =
  fmap attachPrettyPath <$> getContractsWithExtension ext fp
  where
    attachPrettyPath :: FilePath -> (FilePath, FilePath)
    attachPrettyPath src = (src, addExtension src  refExt)