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

module Morley.Michelson.Runtime.Import
  (
    -- * Read, parse, typecheck contract
    readContract
  , readSomeContract
  , readUntypedContract
  , importContract
  , importSomeContract
  , importUntypedContract
  , ContractReadError(..)

    -- * Read, parse, typecheck value
  , readValue
  , importValue
  , importSomeValue
  , importUntypedValue
  , ValueReadError (..)

    -- * Generic helpers
  , MichelsonSource(..)
  , importUsing
  ) where

import Data.Default (def)
import qualified Data.Text.IO.Utf8 as Utf8 (readFile)
import Fmt (Buildable(build), pretty, unlessF, (+|), (|+))

import Morley.Michelson.Parser (parseExpandValue)
import Morley.Michelson.Parser.Error (ParserException(..))
import Morley.Michelson.Parser.Types (MichelsonSource(..))
import Morley.Michelson.Runtime (parseExpandContract)
import Morley.Michelson.TypeCheck
  (TCError, typeCheckContract, typeCheckTopLevelType, typeCheckingWith, typeVerifyContract,
  typeVerifyTopLevelType)
import Morley.Michelson.Typed (Contract, SingI, SomeContract(..), SomeValue, Value)
import qualified Morley.Michelson.Untyped as U

----------------------------------------------------------------------------
-- Reading, parsing, typechecking contract
----------------------------------------------------------------------------

-- | Purely read an untyped contract from Michelson textual representation.
--
-- 'FilePath' is accepted solely as a hint for error messages.
readUntypedContract
  :: MichelsonSource
  -> Text
  -> Either ContractReadError U.Contract
readUntypedContract :: MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract MichelsonSource
source Text
txt = do
  (ParserException -> ContractReadError)
-> Either ParserException Contract
-> Either ContractReadError Contract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> ParserException -> ContractReadError
CREParse MichelsonSource
source) (Either ParserException Contract
 -> Either ContractReadError Contract)
-> Either ParserException Contract
-> Either ContractReadError Contract
forall a b. (a -> b) -> a -> b
$ MichelsonSource -> Text -> Either ParserException Contract
parseExpandContract MichelsonSource
source Text
txt

-- | Purely read a typed contract from Michelson textual representation.
readSomeContract
  :: MichelsonSource
  -> Text
  -> Either ContractReadError SomeContract
readSomeContract :: MichelsonSource -> Text -> Either ContractReadError SomeContract
readSomeContract MichelsonSource
source Text
txt = do
  Contract
contract <- MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract MichelsonSource
source Text
txt
  (TCError -> ContractReadError)
-> Either TCError SomeContract
-> Either ContractReadError SomeContract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ContractReadError
CRETypeCheck MichelsonSource
source) (Either TCError SomeContract
 -> Either ContractReadError SomeContract)
-> Either TCError SomeContract
-> Either ContractReadError SomeContract
forall a b. (a -> b) -> a -> b
$
    TypeCheckOptions
-> TypeCheckResult SomeContract -> Either TCError SomeContract
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeContract -> Either TCError SomeContract)
-> TypeCheckResult SomeContract -> Either TCError SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult SomeContract
typeCheckContract Contract
contract

-- | Purely read a typed contract from Michelson textual representation,
-- failing if parameter or storage types mismatch with the expected ones.
readContract
  :: forall cp st .
     Each '[SingI] [cp, st]
  => MichelsonSource
  -> Text
  -> Either ContractReadError (Contract cp st)
readContract :: MichelsonSource
-> Text -> Either ContractReadError (Contract cp st)
readContract MichelsonSource
source Text
txt = do
  Contract
contract <- MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract MichelsonSource
source Text
txt
  (TCError -> ContractReadError)
-> Either TCError (Contract cp st)
-> Either ContractReadError (Contract cp st)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ContractReadError
CRETypeCheck MichelsonSource
source) (Either TCError (Contract cp st)
 -> Either ContractReadError (Contract cp st))
-> Either TCError (Contract cp st)
-> Either ContractReadError (Contract cp st)
forall a b. (a -> b) -> a -> b
$
    TypeCheckOptions
-> TypeCheckResult (Contract cp st)
-> Either TCError (Contract cp st)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult (Contract cp st)
 -> Either TCError (Contract cp st))
-> TypeCheckResult (Contract cp st)
-> Either TCError (Contract cp st)
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult (Contract cp st)
forall (cp :: T) (st :: T).
(SingI cp, SingI st) =>
Contract -> TypeCheckResult (Contract cp st)
typeVerifyContract Contract
contract

-- | Read a thing from a file, using the provided parsing function.
importUsing
  :: (Exception e)
  => (MichelsonSource -> Text -> Either e a)
  -> FilePath -> IO a
importUsing :: (MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either e a
readFn FilePath
file =
  (e -> IO a) -> (a -> IO a) -> Either e a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> IO a) -> (Text -> Either e a) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MichelsonSource -> Text -> Either e a
readFn (FilePath -> MichelsonSource
MSFile FilePath
file) (Text -> IO a) -> IO Text -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
Utf8.readFile FilePath
file

-- | Import untyped contract from a given file path.
--
-- This function reads file, and parses a contract.
--
-- This function may throw t'Control.Exception.IOException' and 'ContractReadError'.
importUntypedContract :: FilePath -> IO U.Contract
importUntypedContract :: FilePath -> IO Contract
importUntypedContract = (MichelsonSource -> Text -> Either ContractReadError Contract)
-> FilePath -> IO Contract
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract

-- | Import contract from a given file path.
--
-- This function reads file, parses and type checks a contract.
-- Within the typechecking we assume that no contracts are originated,
-- otherwise a type checking error will be caused.
--
-- This function may throw t'Control.Exception.IOException' and 'ContractReadError'.
importContract
  :: forall cp st .
     Each '[SingI] [cp, st]
  => FilePath -> IO (Contract cp st)
importContract :: FilePath -> IO (Contract cp st)
importContract = (MichelsonSource
 -> Text -> Either ContractReadError (Contract cp st))
-> FilePath -> IO (Contract cp st)
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource
-> Text -> Either ContractReadError (Contract cp st)
forall (cp :: T) (st :: T).
Each '[SingI] '[cp, st] =>
MichelsonSource
-> Text -> Either ContractReadError (Contract cp st)
readContract

-- | Version of 'importContract' that doesn't require you to know
-- contract's parameter and storage types.
importSomeContract :: FilePath -> IO SomeContract
importSomeContract :: FilePath -> IO SomeContract
importSomeContract = (MichelsonSource -> Text -> Either ContractReadError SomeContract)
-> FilePath -> IO SomeContract
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ContractReadError SomeContract
readSomeContract

-- | Error type for 'importContract' function.
data ContractReadError
  = CREParse MichelsonSource ParserException
  | CRETypeCheck MichelsonSource TCError
  deriving stock (Int -> ContractReadError -> ShowS
[ContractReadError] -> ShowS
ContractReadError -> FilePath
(Int -> ContractReadError -> ShowS)
-> (ContractReadError -> FilePath)
-> ([ContractReadError] -> ShowS)
-> Show ContractReadError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ContractReadError] -> ShowS
$cshowList :: [ContractReadError] -> ShowS
show :: ContractReadError -> FilePath
$cshow :: ContractReadError -> FilePath
showsPrec :: Int -> ContractReadError -> ShowS
$cshowsPrec :: Int -> ContractReadError -> ShowS
Show, ContractReadError -> ContractReadError -> Bool
(ContractReadError -> ContractReadError -> Bool)
-> (ContractReadError -> ContractReadError -> Bool)
-> Eq ContractReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractReadError -> ContractReadError -> Bool
$c/= :: ContractReadError -> ContractReadError -> Bool
== :: ContractReadError -> ContractReadError -> Bool
$c== :: ContractReadError -> ContractReadError -> Bool
Eq)

instance Buildable ContractReadError where
  build :: ContractReadError -> Builder
build =
    \case
      CREParse MichelsonSource
source ParserException
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
            Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        , Builder
"Failed to parse the contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ParserException
e ParserException -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        ]
      CRETypeCheck MichelsonSource
source TCError
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
            Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        , Builder
"The contract is ill-typed: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
e TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        ]

instance Exception ContractReadError where
  displayException :: ContractReadError -> FilePath
displayException = ContractReadError -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

----------------------------------------------------------------------------
-- Reading, parsing, typechecking value
----------------------------------------------------------------------------

-- | Purely read an untyped Michelson value from textual representation.
--
-- 'FilePath' is accepted solely as a hint for error messages.
readUntypedValue
  :: MichelsonSource
  -> Text
  -> Either ValueReadError U.Value
readUntypedValue :: MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue MichelsonSource
source Text
txt = do
  (ParserException -> ValueReadError)
-> Either ParserException Value -> Either ValueReadError Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> ParserException -> ValueReadError
VREParse MichelsonSource
source) (Either ParserException Value -> Either ValueReadError Value)
-> Either ParserException Value -> Either ValueReadError Value
forall a b. (a -> b) -> a -> b
$ MichelsonSource -> Text -> Either ParserException Value
parseExpandValue MichelsonSource
source Text
txt

-- | Purely read a typed Michelson value from textual representation.
--
-- Expected type is provided explicitly.
readSomeValue
  :: U.Ty
  -> MichelsonSource
  -> Text
  -> Either ValueReadError SomeValue
readSomeValue :: Ty -> MichelsonSource -> Text -> Either ValueReadError SomeValue
readSomeValue Ty
ty MichelsonSource
source Text
txt = do
  Value
valueU <- MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue MichelsonSource
source Text
txt
  (TCError -> ValueReadError)
-> Either TCError SomeValue -> Either ValueReadError SomeValue
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ValueReadError
VRETypeCheck MichelsonSource
source) (Either TCError SomeValue -> Either ValueReadError SomeValue)
-> Either TCError SomeValue -> Either ValueReadError SomeValue
forall a b. (a -> b) -> a -> b
$
    TypeCheckOptions
-> TypeCheckResult SomeValue -> Either TCError SomeValue
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeValue -> Either TCError SomeValue)
-> TypeCheckResult SomeValue -> Either TCError SomeValue
forall a b. (a -> b) -> a -> b
$ Maybe TcOriginatedContracts
-> Ty -> Value -> TypeCheckResult SomeValue
typeCheckTopLevelType Maybe TcOriginatedContracts
forall a. Maybe a
Nothing Ty
ty Value
valueU

-- | Purely read a typed Michelson value from textual representation.
readValue
  :: forall t. SingI t
  => MichelsonSource
  -> Text
  -> Either ValueReadError (Value t)
readValue :: MichelsonSource -> Text -> Either ValueReadError (Value t)
readValue MichelsonSource
source Text
txt = do
  Value
valueU <- MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue MichelsonSource
source Text
txt
  (TCError -> ValueReadError)
-> Either TCError (Value t) -> Either ValueReadError (Value t)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ValueReadError
VRETypeCheck MichelsonSource
source) (Either TCError (Value t) -> Either ValueReadError (Value t))
-> Either TCError (Value t) -> Either ValueReadError (Value t)
forall a b. (a -> b) -> a -> b
$
    TypeCheckOptions
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult (Value t) -> Either TCError (Value t))
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a b. (a -> b) -> a -> b
$ Maybe TcOriginatedContracts -> Value -> TypeCheckResult (Value t)
forall (t :: T).
SingI t =>
Maybe TcOriginatedContracts -> Value -> TypeCheckResult (Value t)
typeVerifyTopLevelType Maybe TcOriginatedContracts
forall a. Maybe a
Nothing Value
valueU

-- | Import an untyped value from a given file path.
importUntypedValue :: FilePath -> IO U.Value
importUntypedValue :: FilePath -> IO Value
importUntypedValue = (MichelsonSource -> Text -> Either ValueReadError Value)
-> FilePath -> IO Value
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue

-- | Import a typed value from a given file path.
--
-- Expected type is provided explicitly.
importSomeValue :: U.Ty -> FilePath -> IO SomeValue
importSomeValue :: Ty -> FilePath -> IO SomeValue
importSomeValue = (MichelsonSource -> Text -> Either ValueReadError SomeValue)
-> FilePath -> IO SomeValue
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing ((MichelsonSource -> Text -> Either ValueReadError SomeValue)
 -> FilePath -> IO SomeValue)
-> (Ty
    -> MichelsonSource -> Text -> Either ValueReadError SomeValue)
-> Ty
-> FilePath
-> IO SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ty -> MichelsonSource -> Text -> Either ValueReadError SomeValue
readSomeValue

-- | Import a typed value from a given file path.
importValue
  :: forall t . SingI t
  => FilePath -> IO (Value t)
importValue :: FilePath -> IO (Value t)
importValue = (MichelsonSource -> Text -> Either ValueReadError (Value t))
-> FilePath -> IO (Value t)
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ValueReadError (Value t)
forall (t :: T).
SingI t =>
MichelsonSource -> Text -> Either ValueReadError (Value t)
readValue

-- | Error type for 'importValue' function.
data ValueReadError
  = VREParse MichelsonSource ParserException
  | VRETypeCheck MichelsonSource TCError
  deriving stock (Int -> ValueReadError -> ShowS
[ValueReadError] -> ShowS
ValueReadError -> FilePath
(Int -> ValueReadError -> ShowS)
-> (ValueReadError -> FilePath)
-> ([ValueReadError] -> ShowS)
-> Show ValueReadError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ValueReadError] -> ShowS
$cshowList :: [ValueReadError] -> ShowS
show :: ValueReadError -> FilePath
$cshow :: ValueReadError -> FilePath
showsPrec :: Int -> ValueReadError -> ShowS
$cshowsPrec :: Int -> ValueReadError -> ShowS
Show, ValueReadError -> ValueReadError -> Bool
(ValueReadError -> ValueReadError -> Bool)
-> (ValueReadError -> ValueReadError -> Bool) -> Eq ValueReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueReadError -> ValueReadError -> Bool
$c/= :: ValueReadError -> ValueReadError -> Bool
== :: ValueReadError -> ValueReadError -> Bool
$c== :: ValueReadError -> ValueReadError -> Bool
Eq)

instance Buildable ValueReadError where
  build :: ValueReadError -> Builder
build =
    \case
      VREParse MichelsonSource
source ParserException
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
            Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        , Builder
"Failed to parse the value: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ParserException
e ParserException -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        ]
      VRETypeCheck MichelsonSource
source TCError
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
            Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        , Builder
"Invalid value for required type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
e TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
        ]

instance Exception ValueReadError where
  displayException :: ValueReadError -> FilePath
displayException = ValueReadError -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty