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

-- | Helpers used to call @octez-client@.
module Morley.Client.TezosClient.Helpers
  ( CallMode(..)
  , callTezosClient
  , callTezosClientStrict
  , readProcessWithExitCode'
  ) where

import Unsafe qualified ((!!))

import Colourista (formatWith, red)
import Control.Exception (IOException, throwIO)
import Data.ByteArray (ScrubbedBytes)
import Data.Text qualified as T
import System.Exit (ExitCode(..))
import System.Process (readProcessWithExitCode)

import Morley.Client.Logging
import Morley.Client.TezosClient.Types
import Morley.Client.TezosClient.Types.Errors
import Morley.Client.Util (scrubbedBytesToString)

-- | Datatype that represents modes for calling node from @octez-client@.
data CallMode
  = MockupMode
  -- ^ Mode in which @octez-client@ doesn't perform any actual RPC calls to the node
  -- and use mock instead.
  | ClientMode
  -- ^ Normal mode in which @octez-client@ performs all necessary RPC calls to the node.

-- | Call @octez-client@ with given arguments. Arguments defined by
-- config are added automatically. The second argument specifies what
-- should be done in failure case. It takes stdout and stderr
-- output. Possible handling:
--
-- 1. Parse a specific error and throw it.
-- 2. Parse an expected error that shouldn't cause a failure.
-- Return @True@ in this case.
-- 3. Detect an unexpected error, return @False@.
-- In this case 'UnexpectedClientFailure' will be throw.
callTezosClient
  :: forall env m. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => (Text -> Text -> IO Bool) -> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
errHandler [FilePath]
args CallMode
mode Maybe ScrubbedBytes
mbInput = CallMode -> m Text -> m Text
forall a. CallMode -> m a -> m a
retryEConnreset CallMode
mode (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  TezosClientEnv {FilePath
Maybe FilePath
MVar (Maybe AliasesAndAddresses)
BaseUrl
tceEndpointUrl :: BaseUrl
tceTezosClientPath :: FilePath
tceMbTezosClientDataDir :: Maybe FilePath
tceAliasMap :: MVar (Maybe AliasesAndAddresses)
tceEndpointUrl :: TezosClientEnv -> BaseUrl
tceTezosClientPath :: TezosClientEnv -> FilePath
tceMbTezosClientDataDir :: TezosClientEnv -> Maybe FilePath
tceAliasMap :: TezosClientEnv -> MVar (Maybe AliasesAndAddresses)
..} <- Getting TezosClientEnv env TezosClientEnv -> m TezosClientEnv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TezosClientEnv env TezosClientEnv
forall env. HasTezosClientEnv env => Lens' env TezosClientEnv
Lens' env TezosClientEnv
tezosClientEnvL
  let
    extraArgs :: [String]
    extraArgs :: [FilePath]
extraArgs = [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat
      [ [FilePath
"-E", BaseUrl -> FilePath
forall a. CmdArg a => a -> FilePath
toCmdArg BaseUrl
tceEndpointUrl]
      , [FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
dir -> [FilePath
"-d", FilePath
dir]) Maybe FilePath
tceMbTezosClientDataDir
      , [FilePath
"--mode", case CallMode
mode of
            CallMode
MockupMode -> FilePath
"mockup"
            CallMode
ClientMode -> FilePath
"client"
        ]
      ]

    allArgs :: [FilePath]
allArgs = [FilePath]
extraArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args
  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Running: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unwords (FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
tceTezosClientPathFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
allArgs)
  let
    ifNotEmpty :: a -> a -> a
ifNotEmpty a
prefix a
output
      | a -> Bool
forall t. Container t => t -> Bool
null a
output = a
""
      | Bool
otherwise = a
prefix a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
":\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
output
    logOutput :: Text -> Text -> m ()
    logOutput :: Text -> Text -> m ()
logOutput Text
output Text
errOutput = Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text
forall {a}. (Container a, IsString a, Semigroup a) => a -> a -> a
ifNotEmpty Text
"stdout" Text
output Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text -> Text -> Text
forall {a}. (Container a, IsString a, Semigroup a) => a -> a -> a
ifNotEmpty Text
"stderr" Text
errOutput

  IO (ExitCode, FilePath, FilePath)
-> m (ExitCode, FilePath, FilePath)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode' FilePath
tceTezosClientPath [FilePath]
allArgs
          (FilePath
-> (ScrubbedBytes -> FilePath) -> Maybe ScrubbedBytes -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ScrubbedBytes -> FilePath
scrubbedBytesToString Maybe ScrubbedBytes
mbInput)) m (ExitCode, FilePath, FilePath)
-> ((ExitCode, FilePath, FilePath) -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (ExitCode
ExitSuccess, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
errOutput) ->
      Text
output Text -> m () -> m Text
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Text -> m ()
logOutput Text
output Text
errOutput
    (ExitFailure Int
errCode, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
errOutput) -> do
      Text -> m ()
checkCounterError Text
errOutput
      Text -> m ()
checkEConnreset Text
errOutput
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Text -> Text -> IO Bool
errHandler Text
output Text
errOutput) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO ()) -> TezosClientError -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text -> TezosClientError
UnexpectedClientFailure Int
errCode Text
output Text
errOutput

      Text
output Text -> m () -> m Text
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Text -> m ()
logOutput Text
output Text
errOutput
  where
    checkCounterError
      :: Text -> m ()
    checkCounterError :: Text -> m ()
checkCounterError Text
errOutput |
      Text
"Counter" Text -> Text -> Bool
`T.isPrefixOf` Text
errOutput Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Text
"already used for contract" Text -> Text -> Bool
`T.isInfixOf` Text
errOutput = do
        let splittedErrOutput :: [Text]
splittedErrOutput = Text -> [Text]
words Text
errOutput
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TezosClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO ()) -> TezosClientError -> IO ()
forall a b. (a -> b) -> a -> b
$
          Text -> Text -> TezosClientError
CounterIsAlreadyUsed ([Text]
splittedErrOutput [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
Unsafe.!! Int
1) ([Text]
splittedErrOutput [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
Unsafe.!! Int
5)
    checkCounterError Text
_ = m ()
forall (f :: * -> *). Applicative f => f ()
pass
    checkEConnreset :: Text -> m ()
    checkEConnreset :: Text -> m ()
checkEConnreset Text
errOutput
      | Text
"Unix.ECONNRESET" Text -> Text -> Bool
`T.isInfixOf` Text
errOutput = TezosClientError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TezosClientError
EConnreset
    checkEConnreset Text
_ = m ()
forall (f :: * -> *). Applicative f => f ()
pass

    -- Helper function that retries @octez-client@ call action in case of @ECONNRESET@.
    -- Note that this error cannot appear in case of 'MockupMode' call.
    retryEConnreset :: CallMode -> m a -> m a
    retryEConnreset :: forall a. CallMode -> m a -> m a
retryEConnreset CallMode
MockupMode m a
action = m a
action
    retryEConnreset CallMode
ClientMode m a
action = Integer -> m a -> m a
forall a. Integer -> m a -> m a
retryEConnresetImpl Integer
0 m a
action

    retryEConnresetImpl :: Integer -> m a -> m a
    retryEConnresetImpl :: forall a. Integer -> m a -> m a
retryEConnresetImpl Integer
attempt m a
action = m a
action m a -> (TezosClientError -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \TezosClientError
err -> do
      case TezosClientError
err of
        TezosClientError
EConnreset ->
          if Integer
attempt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
maxRetryAmount then TezosClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TezosClientError
err
          else Integer -> m a -> m a
forall a. Integer -> m a -> m a
retryEConnresetImpl (Integer
attempt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) m a
action
        TezosClientError
anotherErr -> TezosClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TezosClientError
anotherErr

    maxRetryAmount :: Integer
maxRetryAmount = Integer
5

-- | Call @octez-client@ and expect success.
callTezosClientStrict
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
[FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict = (Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
(Text -> Text -> IO Bool)
-> [FilePath] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient Text -> Text -> IO Bool
forall {f :: * -> *} {p} {p}. Applicative f => p -> p -> f Bool
errHandler
  where
    errHandler :: p -> p -> f Bool
errHandler p
_ p
_ = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Variant of @readProcessWithExitCode@ that prints a better error in case of
-- an exception in the inner @readProcessWithExitCode@ call.
readProcessWithExitCode'
  :: FilePath
  -> [String]
  -> String
  -> IO (ExitCode, String, String)
readProcessWithExitCode' :: FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode' FilePath
fp [FilePath]
args FilePath
inp =
  IO (ExitCode, FilePath, FilePath)
-> (IOException -> IO (ExitCode, FilePath, FilePath))
-> IO (ExitCode, FilePath, FilePath)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
    (FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
fp [FilePath]
args FilePath
inp) IOException -> IO (ExitCode, FilePath, FilePath)
handler
  where
    handler :: IOException -> IO (ExitCode, String, String)
    handler :: IOException -> IO (ExitCode, FilePath, FilePath)
handler IOException
e = do
      forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStrLn @Text Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
red] Text
errorMsg
      IOException -> IO (ExitCode, FilePath, FilePath)
forall e a. Exception e => e -> IO a
throwIO IOException
e

    errorMsg :: Text
errorMsg =
      Text
"ERROR!! There was an error in executing `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` program. Is the \
      \ executable available in PATH ?"