{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | This module defines constants derived from the environment.
module Cardano.CLI.Environment
  ( EnvCli (..)
  , envCliEra
  , getEnvCli
  , getEnvNetworkId
  , getEnvSocketPath
  )
where

import Cardano.Api
  ( AnyCardanoEra (..)
  , NetworkId (..)
  , NetworkMagic (..)
  , forEraMaybeEon
  , pretty
  )
import Cardano.Api.Experimental qualified as Exp

import Control.Monad.IO.Class (MonadIO (..))
import Data.Char (toLower)
import Data.Foldable (find)
import Data.List (intercalate)
import Data.Traversable (forM)
import Data.Type.Equality
import Data.Word (Word32)
import GHC.Stack (HasCallStack)
import System.Environment qualified as IO
import System.IO qualified as IO
import Text.Read (readMaybe)

data EnvCli = EnvCli
  { EnvCli -> Maybe NetworkId
envCliNetworkId :: Maybe NetworkId
  , EnvCli -> Maybe [Char]
envCliSocketPath :: Maybe FilePath
  , EnvCli -> Maybe AnyCardanoEra
envCliAnyCardanoEra :: Maybe AnyCardanoEra
  }

getEnvCli :: IO EnvCli
getEnvCli :: IO EnvCli
getEnvCli = do
  mNetworkId <- IO (Maybe NetworkId)
getEnvNetworkId
  mSocketPath <- getEnvSocketPath
  mCardanoEra <- getCardanoEra

  pure
    EnvCli
      { envCliNetworkId = mNetworkId
      , envCliSocketPath = mSocketPath
      , envCliAnyCardanoEra = mCardanoEra
      }

envCliEra
  :: forall era
   . Exp.IsEra era
  => EnvCli
  -> Maybe (Exp.Era era)
envCliEra :: forall era. IsEra era => EnvCli -> Maybe (Era era)
envCliEra EnvCli
envCli = do
  AnyCardanoEra cardanoEra <- EnvCli -> Maybe AnyCardanoEra
envCliAnyCardanoEra EnvCli
envCli
  era1 <- forEraMaybeEon cardanoEra
  Refl <- testEquality era1 (Exp.useEra @era)
  pure era1

-- | If the environment variable @CARDANO_NODE_NETWORK_ID@ is set, then return the network id therein.
-- Otherwise, return 'Nothing'.
getEnvNetworkId :: IO (Maybe NetworkId)
getEnvNetworkId :: IO (Maybe NetworkId)
getEnvNetworkId = do
  mNetworkIdString <- [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"CARDANO_NODE_NETWORK_ID"

  case mNetworkIdString of
    Maybe [Char]
Nothing -> Maybe NetworkId -> IO (Maybe NetworkId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NetworkId
forall a. Maybe a
Nothing
    Just [Char]
networkIdString -> do
      case [Char]
networkIdString of
        [Char]
"mainnet" -> Maybe NetworkId -> IO (Maybe NetworkId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NetworkId -> IO (Maybe NetworkId))
-> Maybe NetworkId -> IO (Maybe NetworkId)
forall a b. (a -> b) -> a -> b
$ NetworkId -> Maybe NetworkId
forall a. a -> Maybe a
Just NetworkId
Mainnet
        [Char]
_ ->
          case forall a. Read a => [Char] -> Maybe a
readMaybe @Word32 [Char]
networkIdString of
            Just Word32
networkId -> Maybe NetworkId -> IO (Maybe NetworkId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NetworkId -> IO (Maybe NetworkId))
-> Maybe NetworkId -> IO (Maybe NetworkId)
forall a b. (a -> b) -> a -> b
$ NetworkId -> Maybe NetworkId
forall a. a -> Maybe a
Just (NetworkId -> Maybe NetworkId) -> NetworkId -> Maybe NetworkId
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
networkId
            Maybe Word32
Nothing -> do
              Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
                  [ [Char]
"The network id specified in CARDANO_NODE_NETWORK_ID invalid: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
networkIdString
                  , [Char]
" It should be either 'mainnet' or a number."
                  ]
              Maybe NetworkId -> IO (Maybe NetworkId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NetworkId
forall a. Maybe a
Nothing

-- | If the environment variable @CARDANO_NODE_SOCKET_PATH@ is set, then return the set value.
-- Otherwise, return 'Nothing'.
getEnvSocketPath :: IO (Maybe FilePath)
getEnvSocketPath :: IO (Maybe [Char])
getEnvSocketPath = [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"CARDANO_NODE_SOCKET_PATH"

-- | If the environment variable @CARDANO_ERA@ is set to a known era, then return that era.
-- If it is set to an unknown era, fail with an error listing the valid eras.
-- Otherwise, return 'Nothing'.
getCardanoEra :: (HasCallStack, MonadIO m) => m (Maybe AnyCardanoEra)
getCardanoEra :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe AnyCardanoEra)
getCardanoEra = do
  mEraString <- IO (Maybe [Char]) -> m (Maybe [Char])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"CARDANO_ERA"
  forM mEraString $ \[Char]
eraString ->
    m AnyCardanoEra
-> (AnyCardanoEra -> m AnyCardanoEra)
-> Maybe AnyCardanoEra
-> m AnyCardanoEra
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m AnyCardanoEra
forall a. HasCallStack => [Char] -> a
error ([Char] -> m AnyCardanoEra) -> [Char] -> m AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
invalidEraMessage [Char]
eraString) AnyCardanoEra -> m AnyCardanoEra
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> m AnyCardanoEra)
-> Maybe AnyCardanoEra -> m AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe AnyCardanoEra
parseCardanoEra [Char]
eraString
 where
  invalidEraMessage :: String -> String
  invalidEraMessage :: [Char] -> [Char]
invalidEraMessage [Char]
eraString =
    [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
      [ [Char]
"The era specified in CARDANO_ERA is invalid: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
eraString [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
      , [Char]
" It should be one of: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (AnyCardanoEra -> [Char]
cardanoEraName (AnyCardanoEra -> [Char]) -> [AnyCardanoEra] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnyCardanoEra]
allCardanoEras) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
      ]

  -- Parse an era name, ignoring case, using the names that cardano-api renders for its eras.
  parseCardanoEra :: String -> Maybe AnyCardanoEra
  parseCardanoEra :: [Char] -> Maybe AnyCardanoEra
parseCardanoEra [Char]
eraString =
    (AnyCardanoEra -> Bool) -> [AnyCardanoEra] -> Maybe AnyCardanoEra
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
eraString) ([Char] -> Bool)
-> (AnyCardanoEra -> [Char]) -> AnyCardanoEra -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> [Char]
cardanoEraName) [AnyCardanoEra]
allCardanoEras

  allCardanoEras :: [AnyCardanoEra]
  allCardanoEras :: [AnyCardanoEra]
allCardanoEras = AnyCardanoEra -> [AnyCardanoEra]
forall a. Enum a => a -> [a]
enumFrom AnyCardanoEra
forall a. Bounded a => a
minBound

  cardanoEraName :: AnyCardanoEra -> String
  cardanoEraName :: AnyCardanoEra -> [Char]
cardanoEraName = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char])
-> (AnyCardanoEra -> [Char]) -> AnyCardanoEra -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc (ZonkAny 0) -> [Char]
forall a. Show a => a -> [Char]
show (Doc (ZonkAny 0) -> [Char])
-> (AnyCardanoEra -> Doc (ZonkAny 0)) -> AnyCardanoEra -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> Doc (ZonkAny 0)
forall a ann. Pretty a => a -> Doc ann
forall ann. AnyCardanoEra -> Doc ann
pretty