{-# 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 (..)
  , CardanoEra (..)
  , NetworkId (..)
  , NetworkMagic (..)
  , forEraMaybeEon
  )
import Cardano.Api.Experimental qualified as Exp

import Data.Type.Equality
import Data.Word (Word32)
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, then return the set value.
-- Otherwise, return 'Nothing'.
getCardanoEra :: IO (Maybe AnyCardanoEra)
getCardanoEra :: IO (Maybe AnyCardanoEra)
getCardanoEra = do
  mEraString <- [Char] -> IO (Maybe [Char])
IO.lookupEnv [Char]
"CARDANO_ERA"

  case mEraString of
    Just [Char]
eraString ->
      case [Char]
eraString of
        [Char]
"byron" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
        [Char]
"shelley" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
        [Char]
"allegra" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AllegraEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
        [Char]
"mary" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra MaryEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
        [Char]
"alonzo" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra AlonzoEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
        [Char]
"babbage" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra BabbageEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra BabbageEra
BabbageEra
        [Char]
"conway" -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra))
-> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (AnyCardanoEra -> Maybe AnyCardanoEra)
-> AnyCardanoEra -> Maybe AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ConwayEra -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ConwayEra
ConwayEra
        [Char]
unknown -> [Char] -> IO (Maybe AnyCardanoEra)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Maybe AnyCardanoEra))
-> [Char] -> IO (Maybe AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown era: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
unknown -- TODO improve error handling
    Maybe [Char]
Nothing -> Maybe AnyCardanoEra -> IO (Maybe AnyCardanoEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AnyCardanoEra
forall a. Maybe a
Nothing