-- 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 -> FilePath
(Int -> TezosClientConfig -> ShowS)
-> (TezosClientConfig -> FilePath)
-> ([TezosClientConfig] -> ShowS)
-> Show TezosClientConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TezosClientConfig] -> ShowS
$cshowList :: [TezosClientConfig] -> ShowS
show :: TezosClientConfig -> FilePath
$cshow :: TezosClientConfig -> FilePath
showsPrec :: Int -> TezosClientConfig -> ShowS
$cshowsPrec :: Int -> TezosClientConfig -> ShowS
Show

-- | For reading @octez-client@ config.
instance FromJSON TezosClientConfig where
  parseJSON :: Value -> Parser TezosClientConfig
parseJSON = FilePath
-> (Object -> Parser TezosClientConfig)
-> Value
-> Parser TezosClientConfig
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"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 :: FilePath -> Maybe FilePath -> IO TezosClientConfig
getTezosClientConfig FilePath
client Maybe FilePath
mbDataDir = do
  (ExitCode, FilePath, FilePath)
t <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode' FilePath
client
    ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
dir -> [FilePath
"-d", FilePath
dir]) Maybe FilePath
mbDataDir [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++  [FilePath
"config", FilePath
"show"]) FilePath
""
  case (ExitCode, FilePath, FilePath)
t of
    (ExitCode
ExitSuccess, FilePath -> Text
forall a. ToText a => a -> Text
toText -> Text
output, FilePath
_) -> case ByteString -> Either FilePath TezosClientConfig
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecodeStrict (ByteString -> Either FilePath TezosClientConfig)
-> (Text -> ByteString)
-> Text
-> Either FilePath 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 FilePath TezosClientConfig)
-> Text -> Either FilePath TezosClientConfig
forall a b. (a -> b) -> a -> b
$ Text
output of
        Right TezosClientConfig
config -> TezosClientConfig -> IO TezosClientConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure TezosClientConfig
config
        Left FilePath
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
$ FilePath -> TezosClientError
ConfigParseError FilePath
err
    (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) ->
      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