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

-- | @octez-client@ config.
module Morley.Client.TezosClient.Config
  ( TezosClientConfig (..)

  -- * @octez-client@ api
  , getTezosClientConfig
  ) where

import Data.Aeson (FromJSON(..), eitherDecodeStrict, withObject, (.:))
import Servant.Client (BaseUrl(..))
import System.Exit (ExitCode(..))

import Morley.Client.TezosClient.Helpers
import Morley.Client.TezosClient.Types.Errors

-- | Configuration maintained by @octez-client@, see its @config@ subcommands
-- (e. g. @octez-client config show@).
-- Only the field we are interested in is present here.
newtype TezosClientConfig = TezosClientConfig { TezosClientConfig -> BaseUrl
tcEndpointUrl :: BaseUrl }
  deriving stock Int -> TezosClientConfig -> ShowS
[TezosClientConfig] -> ShowS
TezosClientConfig -> String
(Int -> TezosClientConfig -> ShowS)
-> (TezosClientConfig -> String)
-> ([TezosClientConfig] -> ShowS)
-> Show TezosClientConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TezosClientConfig -> ShowS
showsPrec :: Int -> TezosClientConfig -> ShowS
$cshow :: TezosClientConfig -> String
show :: TezosClientConfig -> String
$cshowList :: [TezosClientConfig] -> ShowS
showList :: [TezosClientConfig] -> ShowS
Show

-- | For reading @octez-client@ config.
instance FromJSON TezosClientConfig where
  parseJSON :: Value -> Parser TezosClientConfig
parseJSON = String
-> (Object -> Parser TezosClientConfig)
-> Value
-> Parser TezosClientConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"node info" ((Object -> Parser TezosClientConfig)
 -> Value -> Parser TezosClientConfig)
-> (Object -> Parser TezosClientConfig)
-> Value
-> Parser TezosClientConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> BaseUrl -> TezosClientConfig
TezosClientConfig (BaseUrl -> TezosClientConfig)
-> Parser BaseUrl -> Parser TezosClientConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser BaseUrl
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"endpoint"

-- | Read @octez-client@ configuration.
getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig
getTezosClientConfig :: String -> Maybe String -> IO TezosClientConfig
getTezosClientConfig String
client Maybe String
mbDataDir = do
  (ExitCode, String, String)
t <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode' String
client
    ([String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
dir -> [String
"-d", String
dir]) Maybe String
mbDataDir [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++  [String
"config", String
"show"]) String
""
  case (ExitCode, String, String)
t of
    (ExitCode
ExitSuccess, String -> Text
forall a. ToText a => a -> Text
toText -> Text
output, String
_) -> case ByteString -> Either String TezosClientConfig
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String TezosClientConfig)
-> (Text -> ByteString) -> Text -> Either String TezosClientConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToText a => a -> Text
toText (Text -> Either String TezosClientConfig)
-> Text -> Either String TezosClientConfig
forall a b. (a -> b) -> a -> b
$ Text
output of
        Right TezosClientConfig
config -> TezosClientConfig -> IO TezosClientConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TezosClientConfig
config
        Left String
err -> TezosClientError -> IO TezosClientConfig
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO TezosClientConfig)
-> TezosClientError -> IO TezosClientConfig
forall a b. (a -> b) -> a -> b
$ String -> TezosClientError
ConfigParseError String
err
    (ExitFailure Int
errCode, String -> Text
forall a. ToText a => a -> Text
toText -> Text
output, String -> Text
forall a. ToText a => a -> Text
toText -> Text
errOutput) ->
      TezosClientError -> IO TezosClientConfig
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> IO TezosClientConfig)
-> TezosClientError -> IO TezosClientConfig
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text -> TezosClientError
UnexpectedClientFailure Int
errCode Text
output Text
errOutput