{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Api.Environment
  ( EnvSocketError(..)
  , SocketPath(..)
  , readEnvSocketPath
  , renderEnvSocketError
  ) where

import           Prelude

import           Data.Aeson
import           Data.Text (Text)
import qualified Data.Text as Text
import           System.Environment (lookupEnv)

import           Cardano.Api.Utils (textShow)

newtype SocketPath
  = SocketPath { SocketPath -> FilePath
unSocketPath :: FilePath }
  deriving (Value -> Parser [SocketPath]
Value -> Parser SocketPath
(Value -> Parser SocketPath)
-> (Value -> Parser [SocketPath]) -> FromJSON SocketPath
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SocketPath]
$cparseJSONList :: Value -> Parser [SocketPath]
parseJSON :: Value -> Parser SocketPath
$cparseJSON :: Value -> Parser SocketPath
FromJSON, Int -> SocketPath -> ShowS
[SocketPath] -> ShowS
SocketPath -> FilePath
(Int -> SocketPath -> ShowS)
-> (SocketPath -> FilePath)
-> ([SocketPath] -> ShowS)
-> Show SocketPath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SocketPath] -> ShowS
$cshowList :: [SocketPath] -> ShowS
show :: SocketPath -> FilePath
$cshow :: SocketPath -> FilePath
showsPrec :: Int -> SocketPath -> ShowS
$cshowsPrec :: Int -> SocketPath -> ShowS
Show, SocketPath -> SocketPath -> Bool
(SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool) -> Eq SocketPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocketPath -> SocketPath -> Bool
$c/= :: SocketPath -> SocketPath -> Bool
== :: SocketPath -> SocketPath -> Bool
$c== :: SocketPath -> SocketPath -> Bool
Eq, Eq SocketPath
Eq SocketPath
-> (SocketPath -> SocketPath -> Ordering)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> Bool)
-> (SocketPath -> SocketPath -> SocketPath)
-> (SocketPath -> SocketPath -> SocketPath)
-> Ord SocketPath
SocketPath -> SocketPath -> Bool
SocketPath -> SocketPath -> Ordering
SocketPath -> SocketPath -> SocketPath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SocketPath -> SocketPath -> SocketPath
$cmin :: SocketPath -> SocketPath -> SocketPath
max :: SocketPath -> SocketPath -> SocketPath
$cmax :: SocketPath -> SocketPath -> SocketPath
>= :: SocketPath -> SocketPath -> Bool
$c>= :: SocketPath -> SocketPath -> Bool
> :: SocketPath -> SocketPath -> Bool
$c> :: SocketPath -> SocketPath -> Bool
<= :: SocketPath -> SocketPath -> Bool
$c<= :: SocketPath -> SocketPath -> Bool
< :: SocketPath -> SocketPath -> Bool
$c< :: SocketPath -> SocketPath -> Bool
compare :: SocketPath -> SocketPath -> Ordering
$ccompare :: SocketPath -> SocketPath -> Ordering
$cp1Ord :: Eq SocketPath
Ord)

newtype EnvSocketError = CliEnvVarLookup Text deriving Int -> EnvSocketError -> ShowS
[EnvSocketError] -> ShowS
EnvSocketError -> FilePath
(Int -> EnvSocketError -> ShowS)
-> (EnvSocketError -> FilePath)
-> ([EnvSocketError] -> ShowS)
-> Show EnvSocketError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EnvSocketError] -> ShowS
$cshowList :: [EnvSocketError] -> ShowS
show :: EnvSocketError -> FilePath
$cshow :: EnvSocketError -> FilePath
showsPrec :: Int -> EnvSocketError -> ShowS
$cshowsPrec :: Int -> EnvSocketError -> ShowS
Show

renderEnvSocketError :: EnvSocketError -> Text
renderEnvSocketError :: EnvSocketError -> Text
renderEnvSocketError EnvSocketError
err =
  case EnvSocketError
err of
    CliEnvVarLookup Text
txt ->
      Text
"Error while looking up environment variable: CARDANO_NODE_SOCKET_PATH " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
textShow Text
txt

-- | Read the node socket path from the environment.
-- Fails if the environment variable is not set.
readEnvSocketPath :: IO (Either EnvSocketError SocketPath)
readEnvSocketPath :: IO (Either EnvSocketError SocketPath)
readEnvSocketPath = do
    Maybe FilePath
mEnvName <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
envName
    case Maybe FilePath
mEnvName of
      Just FilePath
sPath ->
        Either EnvSocketError SocketPath
-> IO (Either EnvSocketError SocketPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either EnvSocketError SocketPath
 -> IO (Either EnvSocketError SocketPath))
-> (SocketPath -> Either EnvSocketError SocketPath)
-> SocketPath
-> IO (Either EnvSocketError SocketPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketPath -> Either EnvSocketError SocketPath
forall a b. b -> Either a b
Right (SocketPath -> IO (Either EnvSocketError SocketPath))
-> SocketPath -> IO (Either EnvSocketError SocketPath)
forall a b. (a -> b) -> a -> b
$ FilePath -> SocketPath
SocketPath FilePath
sPath
      Maybe FilePath
Nothing ->
        Either EnvSocketError SocketPath
-> IO (Either EnvSocketError SocketPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either EnvSocketError SocketPath
 -> IO (Either EnvSocketError SocketPath))
-> (EnvSocketError -> Either EnvSocketError SocketPath)
-> EnvSocketError
-> IO (Either EnvSocketError SocketPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvSocketError -> Either EnvSocketError SocketPath
forall a b. a -> Either a b
Left (EnvSocketError -> IO (Either EnvSocketError SocketPath))
-> EnvSocketError -> IO (Either EnvSocketError SocketPath)
forall a b. (a -> b) -> a -> b
$ Text -> EnvSocketError
CliEnvVarLookup (FilePath -> Text
Text.pack FilePath
envName)
  where
    envName :: String
    envName :: FilePath
envName = FilePath
"CARDANO_NODE_SOCKET_PATH"