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)
data CallMode
= MockupMode
| ClientMode
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
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
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
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 ?"