-- TODO(SOLOMON): Should this be moved into `Data.Environment`?
module Hasura.Server.Init.Env
  ( -- * WithEnv
    WithEnvT (..),
    WithEnv,
    runWithEnvT,
    runWithEnv,
    withOption,
    withOptionDefault,
    withOptions,
    withOptionSwitch,
    withOptionSwitch',
    considerEnv,
    considerEnvs,

    -- * FromEnv
    FromEnv (..),
  )
where

--------------------------------------------------------------------------------

import Control.Monad.Morph qualified as Morph
import Data.Aeson qualified as J
import Data.ByteString.Lazy.UTF8 qualified as BLU
import Data.Char qualified as Char
import Data.HashSet qualified as HashSet
import Data.String qualified as String
import Data.Text qualified as Text
import Data.Time qualified as Time
import Data.URL.Template qualified as Template
import Database.PG.Query qualified as Query
import Hasura.Backends.Postgres.Connection.MonadTx (ExtensionsSchema)
import Hasura.Backends.Postgres.Connection.MonadTx qualified as MonadTx
import Hasura.Cache.Bounded qualified as Cache
import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.RQL.Types.Metadata (Metadata, MetadataDefaults (..))
import Hasura.RQL.Types.NamingCase (NamingCase)
import Hasura.RQL.Types.NamingCase qualified as NamingCase
import Hasura.RQL.Types.Roles (RoleName, mkRoleName)
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Cors qualified as Cors
import Hasura.Server.Init.Config qualified as Config
import Hasura.Server.Logging qualified as Server.Logging
import Hasura.Server.Types (GranularPrometheusMetricsState (..))
import Hasura.Server.Types qualified as Server.Types
import Hasura.Server.Utils qualified as Utils
import Network.Wai.Handler.Warp qualified as Warp
import Refined (NonNegative, Positive, Refined, refineFail, unrefine)

--------------------------------------------------------------------------------

-- | Lookup a key in the application environment then parse the value
-- with a 'FromEnv' instance'
considerEnv :: (Monad m, FromEnv a) => String -> WithEnvT m (Maybe a)
considerEnv :: forall (m :: * -> *) a.
(Monad m, FromEnv a) =>
String -> WithEnvT m (Maybe a)
considerEnv String
envVar = do
  [(String, String)]
env <- WithEnvT m [(String, String)]
forall r (m :: * -> *). MonadReader r m => m r
ask
  case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
envVar [(String, String)]
env of
    Maybe String
Nothing -> Maybe a -> WithEnvT m (Maybe a)
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just String
val -> (String -> WithEnvT m (Maybe a))
-> (a -> WithEnvT m (Maybe a))
-> Either String a
-> WithEnvT m (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> WithEnvT m (Maybe a)
throwErr (Maybe a -> WithEnvT m (Maybe a)
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> WithEnvT m (Maybe a))
-> (a -> Maybe a) -> a -> WithEnvT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Either String a -> WithEnvT m (Maybe a))
-> Either String a -> WithEnvT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a. FromEnv a => String -> Either String a
fromEnv String
val
  where
    throwErr :: String -> WithEnvT m (Maybe a)
throwErr String
s =
      String -> WithEnvT m (Maybe a)
forall a. String -> WithEnvT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (String -> WithEnvT m (Maybe a)) -> String -> WithEnvT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ String
"Fatal Error:- Environment variable "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
envVar
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | Lookup a list of keys with 'considerEnv' and return the first
-- value to parse successfully.
considerEnvs :: (Monad m, FromEnv a) => [String] -> WithEnvT m (Maybe a)
considerEnvs :: forall (m :: * -> *) a.
(Monad m, FromEnv a) =>
[String] -> WithEnvT m (Maybe a)
considerEnvs [String]
envVars = (Maybe a -> Maybe a -> Maybe a) -> [Maybe a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ([Maybe a] -> Maybe a)
-> WithEnvT m [Maybe a] -> WithEnvT m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> WithEnvT m (Maybe a))
-> [String] -> WithEnvT m [Maybe a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> WithEnvT m (Maybe a)
forall (m :: * -> *) a.
(Monad m, FromEnv a) =>
String -> WithEnvT m (Maybe a)
considerEnv [String]
envVars

-- | Lookup a list of keys with 'withOption' and return the first
-- value to parse successfully.
withOptions :: (Monad m, FromEnv option) => Maybe option -> [Config.Option ()] -> WithEnvT m (Maybe option)
withOptions :: forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> [Option ()] -> WithEnvT m (Maybe option)
withOptions Maybe option
parsed [Option ()]
options = (Maybe option -> Maybe option -> Maybe option)
-> [Maybe option] -> Maybe option
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Maybe option -> Maybe option -> Maybe option
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ([Maybe option] -> Maybe option)
-> WithEnvT m [Maybe option] -> WithEnvT m (Maybe option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Option () -> WithEnvT m (Maybe option))
-> [Option ()] -> WithEnvT m [Maybe option]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Maybe option -> Option () -> WithEnvT m (Maybe option)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe option
parsed) [Option ()]
options

-- | Given the parse result for an option and the 'Option' record
-- for that option, query the environment, and then merge the results
-- from the parser and environment.
withOption :: (Monad m, FromEnv option) => Maybe option -> Config.Option () -> WithEnvT m (Maybe option)
withOption :: forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option () -> WithEnvT m (Maybe option)
withOption Maybe option
parsed Option ()
option =
  let option' :: Option (Maybe option)
option' = Option ()
option {_default :: Maybe option
Config._default = Maybe option
forall a. Maybe a
Nothing}
   in Maybe (Maybe option)
-> Option (Maybe option) -> WithEnvT m (Maybe option)
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault ((option -> Maybe option) -> Maybe option -> Maybe (Maybe option)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap option -> Maybe option
forall a. a -> Maybe a
Just Maybe option
parsed) Option (Maybe option)
option'

-- | Given the parse result for an option and the 'Option' record for
-- that option, query the environment, and then merge the results from
-- the parser, environment, and the default.
withOptionDefault :: (Monad m, FromEnv option) => Maybe option -> Config.Option option -> WithEnvT m option
withOptionDefault :: forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe option
parsed Config.Option {option
String
_default :: forall def. Option def -> def
_default :: option
_envVar :: String
_helpMessage :: String
_envVar :: forall def. Option def -> String
_helpMessage :: forall def. Option def -> String
..} =
  Maybe option -> WithEnvT m option -> WithEnvT m option
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe option
parsed (option -> Maybe option -> option
forall a. a -> Maybe a -> a
fromMaybe option
_default (Maybe option -> option)
-> WithEnvT m (Maybe option) -> WithEnvT m option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> WithEnvT m (Maybe option)
forall (m :: * -> *) a.
(Monad m, FromEnv a) =>
String -> WithEnvT m (Maybe a)
considerEnv String
_envVar)

-- | Switches in 'optparse-applicative' have different semantics then
-- ordinary flags. They are always optional and produce a 'False' when
-- absent rather then a 'Nothing'.
--
-- In HGE we give Env Vars a higher precedence then an absent Switch
-- but the ordinary 'withEnv' operation expects a 'Nothing' for an
-- absent arg parser result.
--
-- This function executes with 'withOption Nothing' when the Switch is
-- absent, otherwise it returns 'True'.
--
-- NOTE: An alternative solution might be to make Switches return
-- 'Maybe _', where '_' is an option specific sum type. This would
-- allow us to use 'withOptionDefault' directly. Additionally, all
-- fields of 'ServeOptionsRaw' would become 'Maybe' or 'First' values
-- which would allow us to write a 'Monoid ServeOptionsRaw' instance
-- for combing different option sources.
--
-- A 'Monoid' instance would be super valuable to cleanup arg/env
-- parsing but this solution feels somewhat unsatisfying.
withOptionSwitch :: (Monad m) => Bool -> Config.Option Bool -> WithEnvT m Bool
withOptionSwitch :: forall (m :: * -> *).
Monad m =>
Bool -> Option Bool -> WithEnvT m Bool
withOptionSwitch Bool
parsed Option Bool
option = Bool
-> (Bool -> Bool, Bool -> Bool) -> Option Bool -> WithEnvT m Bool
forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool, Bool -> a) -> Option a -> WithEnvT m a
withOptionSwitch' Bool
parsed (Bool -> Bool
forall a. a -> a
id, Bool -> Bool
forall a. a -> a
id) Option Bool
option

-- | Given an 'Iso a Bool' we can apply the same boolean env merging
-- semantics as we do for 'Bool' in `withOptionsSwitch' to @a@.
withOptionSwitch' :: (Monad m) => a -> (a -> Bool, Bool -> a) -> Config.Option a -> WithEnvT m a
withOptionSwitch' :: forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool, Bool -> a) -> Option a -> WithEnvT m a
withOptionSwitch' a
parsed (a -> Bool
fwd, Bool -> a
bwd) Option a
option =
  if a -> Bool
fwd a
parsed
    then a -> WithEnvT m a
forall a. a -> WithEnvT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> a
bwd Bool
True)
    else (Bool -> a) -> WithEnvT m Bool -> WithEnvT m a
forall a b. (a -> b) -> WithEnvT m a -> WithEnvT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> a
bwd (WithEnvT m Bool -> WithEnvT m a)
-> WithEnvT m Bool -> WithEnvT m a
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Option Bool -> WithEnvT m Bool
forall (m :: * -> *) option.
(Monad m, FromEnv option) =>
Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe Bool
forall a. Maybe a
Nothing ((a -> Bool) -> Option a -> Option Bool
forall a b. (a -> b) -> Option a -> Option b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Bool
fwd Option a
option)

--------------------------------------------------------------------------------

-- | A 'Read' style parser used for consuming Env Vars and building
-- 'ReadM' parsers for 'optparse-applicative'.
class FromEnv a where
  fromEnv :: String -> Either String a

type WithEnv = WithEnvT Identity

-- NOTE: Should we use `Data.Environment.Environment` for context?

-- | The monadic context for querying Env Vars.
newtype WithEnvT m a = WithEnvT {forall (m :: * -> *) a.
WithEnvT m a -> ReaderT [(String, String)] (ExceptT String m) a
unWithEnvT :: ReaderT [(String, String)] (ExceptT String m) a}
  deriving newtype ((forall a b. (a -> b) -> WithEnvT m a -> WithEnvT m b)
-> (forall a b. a -> WithEnvT m b -> WithEnvT m a)
-> Functor (WithEnvT m)
forall a b. a -> WithEnvT m b -> WithEnvT m a
forall a b. (a -> b) -> WithEnvT m a -> WithEnvT m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithEnvT m b -> WithEnvT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithEnvT m a -> WithEnvT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithEnvT m a -> WithEnvT m b
fmap :: forall a b. (a -> b) -> WithEnvT m a -> WithEnvT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithEnvT m b -> WithEnvT m a
<$ :: forall a b. a -> WithEnvT m b -> WithEnvT m a
Functor, Functor (WithEnvT m)
Functor (WithEnvT m)
-> (forall a. a -> WithEnvT m a)
-> (forall a b.
    WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b)
-> (forall a b c.
    (a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c)
-> (forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m b)
-> (forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m a)
-> Applicative (WithEnvT m)
forall a. a -> WithEnvT m a
forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m a
forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m b
forall a b. WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
forall a b c.
(a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
forall {m :: * -> *}. Monad m => Functor (WithEnvT m)
forall (m :: * -> *) a. Monad m => a -> WithEnvT m a
forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m a
forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
forall (m :: * -> *) a b.
Monad m =>
WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> WithEnvT m a
pure :: forall a. a -> WithEnvT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
<*> :: forall a b. WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
liftA2 :: forall a b c.
(a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
*> :: forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m a
<* :: forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m a
Applicative, Applicative (WithEnvT m)
Applicative (WithEnvT m)
-> (forall a b.
    WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b)
-> (forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m b)
-> (forall a. a -> WithEnvT m a)
-> Monad (WithEnvT m)
forall a. a -> WithEnvT m a
forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m b
forall a b. WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
forall (m :: * -> *). Monad m => Applicative (WithEnvT m)
forall (m :: * -> *) a. Monad m => a -> WithEnvT m a
forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
>>= :: forall a b. WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
>> :: forall a b. WithEnvT m a -> WithEnvT m b -> WithEnvT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithEnvT m a
return :: forall a. a -> WithEnvT m a
Monad, MonadReader [(String, String)], MonadError String, Monad (WithEnvT m)
Monad (WithEnvT m)
-> (forall a. IO a -> WithEnvT m a) -> MonadIO (WithEnvT m)
forall a. IO a -> WithEnvT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (WithEnvT m)
forall (m :: * -> *) a. MonadIO m => IO a -> WithEnvT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> WithEnvT m a
liftIO :: forall a. IO a -> WithEnvT m a
MonadIO)

instance MonadTrans WithEnvT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> WithEnvT m a
lift = ReaderT [(String, String)] (ExceptT String m) a -> WithEnvT m a
forall (m :: * -> *) a.
ReaderT [(String, String)] (ExceptT String m) a -> WithEnvT m a
WithEnvT (ReaderT [(String, String)] (ExceptT String m) a -> WithEnvT m a)
-> (m a -> ReaderT [(String, String)] (ExceptT String m) a)
-> m a
-> WithEnvT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String m a
-> ReaderT [(String, String)] (ExceptT String m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT [(String, String)] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String m a
 -> ReaderT [(String, String)] (ExceptT String m) a)
-> (m a -> ExceptT String m a)
-> m a
-> ReaderT [(String, String)] (ExceptT String m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT String m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance Morph.MFunctor WithEnvT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> WithEnvT m b -> WithEnvT n b
hoist forall a. m a -> n a
f (WithEnvT ReaderT [(String, String)] (ExceptT String m) b
m) = ReaderT [(String, String)] (ExceptT String n) b -> WithEnvT n b
forall (m :: * -> *) a.
ReaderT [(String, String)] (ExceptT String m) a -> WithEnvT m a
WithEnvT (ReaderT [(String, String)] (ExceptT String n) b -> WithEnvT n b)
-> ReaderT [(String, String)] (ExceptT String n) b -> WithEnvT n b
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptT String m a -> ExceptT String n a)
-> ReaderT [(String, String)] (ExceptT String m) b
-> ReaderT [(String, String)] (ExceptT String n) b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ReaderT [(String, String)] m b -> ReaderT [(String, String)] n b
Morph.hoist ((forall a. m a -> n a) -> ExceptT String m a -> ExceptT String n a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ExceptT String m b -> ExceptT String n b
Morph.hoist m a -> n a
forall a. m a -> n a
f) ReaderT [(String, String)] (ExceptT String m) b
m

-- | Given an environment run a 'WithEnv' action producing either a
-- parse error or an @a@.
runWithEnv :: [(String, String)] -> WithEnv a -> Either String a
runWithEnv :: forall a. [(String, String)] -> WithEnv a -> Either String a
runWithEnv [(String, String)]
env (WithEnvT ReaderT [(String, String)] (ExceptT String Identity) a
m) = Identity (Either String a) -> Either String a
forall a. Identity a -> a
runIdentity (Identity (Either String a) -> Either String a)
-> Identity (Either String a) -> Either String a
forall a b. (a -> b) -> a -> b
$ ExceptT String Identity a -> Identity (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String Identity a -> Identity (Either String a))
-> ExceptT String Identity a -> Identity (Either String a)
forall a b. (a -> b) -> a -> b
$ ReaderT [(String, String)] (ExceptT String Identity) a
-> [(String, String)] -> ExceptT String Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT [(String, String)] (ExceptT String Identity) a
m [(String, String)]
env

-- | Given an environment run a 'WithEnvT' action producing either a
-- parse error or an @a@.
runWithEnvT :: [(String, String)] -> WithEnvT m a -> m (Either String a)
runWithEnvT :: forall (m :: * -> *) a.
[(String, String)] -> WithEnvT m a -> m (Either String a)
runWithEnvT [(String, String)]
env (WithEnvT ReaderT [(String, String)] (ExceptT String m) a
m) = ExceptT String m a -> m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String m a -> m (Either String a))
-> ExceptT String m a -> m (Either String a)
forall a b. (a -> b) -> a -> b
$ ReaderT [(String, String)] (ExceptT String m) a
-> [(String, String)] -> ExceptT String m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT [(String, String)] (ExceptT String m) a
m [(String, String)]
env

--------------------------------------------------------------------------------

-- Deserialize from seconds, in the usual way
instance FromEnv Time.NominalDiffTime where
  fromEnv :: String -> Either String NominalDiffTime
fromEnv String
s =
    case (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe Double) of
      Maybe Double
Nothing -> String -> Either String NominalDiffTime
forall a b. a -> Either a b
Left String
"could not parse as a Double"
      Just Double
i -> NominalDiffTime -> Either String NominalDiffTime
forall a b. b -> Either a b
Right (NominalDiffTime -> Either String NominalDiffTime)
-> NominalDiffTime -> Either String NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
i

instance FromEnv Time.DiffTime where
  fromEnv :: String -> Either String DiffTime
fromEnv String
s =
    case (String -> Maybe Seconds
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe Seconds) of
      Maybe Seconds
Nothing -> String -> Either String DiffTime
forall a b. a -> Either a b
Left String
"could not parse as a Double"
      Just Seconds
i -> DiffTime -> Either String DiffTime
forall a b. b -> Either a b
Right (DiffTime -> Either String DiffTime)
-> DiffTime -> Either String DiffTime
forall a b. (a -> b) -> a -> b
$ Seconds -> DiffTime
seconds Seconds
i

instance FromEnv String where
  fromEnv :: String -> Either String String
fromEnv = String -> Either String String
forall a b. b -> Either a b
Right

instance FromEnv Warp.HostPreference where
  fromEnv :: String -> Either String HostPreference
fromEnv = HostPreference -> Either String HostPreference
forall a b. b -> Either a b
Right (HostPreference -> Either String HostPreference)
-> (String -> HostPreference)
-> String
-> Either String HostPreference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HostPreference
forall a. IsString a => String -> a
String.fromString

instance FromEnv Text where
  fromEnv :: String -> Either String Text
fromEnv = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> (String -> Text) -> String -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance (FromEnv a) => FromEnv (Maybe a) where
  fromEnv :: String -> Either String (Maybe a)
fromEnv = (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Either String (Maybe a))
-> (String -> Either String a) -> String -> Either String (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. FromEnv a => String -> Either String a
fromEnv

instance FromEnv Auth.AuthHookType where
  fromEnv :: String -> Either String AuthHookType
fromEnv = \case
    String
"GET" -> AuthHookType -> Either String AuthHookType
forall a b. b -> Either a b
Right AuthHookType
Auth.AHTGet
    String
"POST" -> AuthHookType -> Either String AuthHookType
forall a b. b -> Either a b
Right AuthHookType
Auth.AHTPost
    String
_ -> String -> Either String AuthHookType
forall a b. a -> Either a b
Left String
"Only expecting GET / POST"

instance FromEnv Int where
  fromEnv :: String -> Either String Int
fromEnv String
s =
    case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s of
      Maybe Int
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Expecting Int value"
      Just Int
m -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
m

instance FromEnv Integer where
  fromEnv :: String -> Either String Integer
fromEnv String
s =
    case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe String
s of
      Maybe Integer
Nothing -> String -> Either String Integer
forall a b. a -> Either a b
Left String
"Expecting Integer value"
      Just Integer
m -> Integer -> Either String Integer
forall a b. b -> Either a b
Right Integer
m

instance FromEnv Auth.AdminSecretHash where
  fromEnv :: String -> Either String AdminSecretHash
fromEnv = AdminSecretHash -> Either String AdminSecretHash
forall a b. b -> Either a b
Right (AdminSecretHash -> Either String AdminSecretHash)
-> (String -> AdminSecretHash)
-> String
-> Either String AdminSecretHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AdminSecretHash
Auth.hashAdminSecret (Text -> AdminSecretHash)
-> (String -> Text) -> String -> AdminSecretHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance FromEnv RoleName where
  fromEnv :: String -> Either String RoleName
fromEnv String
string =
    case Text -> Maybe RoleName
mkRoleName (String -> Text
Text.pack String
string) of
      Maybe RoleName
Nothing -> String -> Either String RoleName
forall a b. a -> Either a b
Left String
"empty string not allowed"
      Just RoleName
roleName -> RoleName -> Either String RoleName
forall a b. b -> Either a b
Right RoleName
roleName

instance FromEnv Bool where
  fromEnv :: String -> Either String Bool
fromEnv String
t
    | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
truthVals = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
    | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
falseVals = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
    | Bool
otherwise = String -> Either String Bool
forall a b. a -> Either a b
Left String
errMsg
    where
      truthVals :: [String]
truthVals = [String
"true", String
"t", String
"yes", String
"y"]
      falseVals :: [String]
falseVals = [String
"false", String
"f", String
"no", String
"n"]

      errMsg :: String
errMsg =
        String
" Not a valid boolean text. True values are "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
truthVals
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and  False values are "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
falseVals
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". All values are case insensitive"

instance FromEnv Config.TelemetryStatus where
  fromEnv :: String -> Either String TelemetryStatus
fromEnv = (Bool -> TelemetryStatus)
-> Either String Bool -> Either String TelemetryStatus
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TelemetryStatus -> TelemetryStatus -> Bool -> TelemetryStatus
forall a. a -> a -> Bool -> a
bool TelemetryStatus
Config.TelemetryDisabled TelemetryStatus
Config.TelemetryEnabled) (Either String Bool -> Either String TelemetryStatus)
-> (String -> Either String Bool)
-> String
-> Either String TelemetryStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Bool
forall a. FromEnv a => String -> Either String a
fromEnv

instance FromEnv Config.AdminInternalErrorsStatus where
  fromEnv :: String -> Either String AdminInternalErrorsStatus
fromEnv = (Bool -> AdminInternalErrorsStatus)
-> Either String Bool -> Either String AdminInternalErrorsStatus
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AdminInternalErrorsStatus
-> AdminInternalErrorsStatus -> Bool -> AdminInternalErrorsStatus
forall a. a -> a -> Bool -> a
bool AdminInternalErrorsStatus
Config.AdminInternalErrorsDisabled AdminInternalErrorsStatus
Config.AdminInternalErrorsEnabled) (Either String Bool -> Either String AdminInternalErrorsStatus)
-> (String -> Either String Bool)
-> String
-> Either String AdminInternalErrorsStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Bool
forall a. FromEnv a => String -> Either String a
fromEnv

instance FromEnv Config.WsReadCookieStatus where
  fromEnv :: String -> Either String WsReadCookieStatus
fromEnv = (Bool -> WsReadCookieStatus)
-> Either String Bool -> Either String WsReadCookieStatus
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WsReadCookieStatus
-> WsReadCookieStatus -> Bool -> WsReadCookieStatus
forall a. a -> a -> Bool -> a
bool WsReadCookieStatus
Config.WsReadCookieDisabled WsReadCookieStatus
Config.WsReadCookieEnabled) (Either String Bool -> Either String WsReadCookieStatus)
-> (String -> Either String Bool)
-> String
-> Either String WsReadCookieStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Bool
forall a. FromEnv a => String -> Either String a
fromEnv

instance FromEnv J.Value where
  fromEnv :: String -> Either String Value
fromEnv = ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (ByteString -> Either String Value)
-> (String -> ByteString) -> String -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BLU.fromString

instance FromEnv MetadataDefaults where
  fromEnv :: String -> Either String MetadataDefaults
fromEnv = ByteString -> Either String MetadataDefaults
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (ByteString -> Either String MetadataDefaults)
-> (String -> ByteString)
-> String
-> Either String MetadataDefaults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BLU.fromString

instance FromEnv Metadata where
  fromEnv :: String -> Either String Metadata
fromEnv = ByteString -> Either String Metadata
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (ByteString -> Either String Metadata)
-> (String -> ByteString) -> String -> Either String Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BLU.fromString

instance FromEnv Options.StringifyNumbers where
  fromEnv :: String -> Either String StringifyNumbers
fromEnv = (Bool -> StringifyNumbers)
-> Either String Bool -> Either String StringifyNumbers
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StringifyNumbers -> StringifyNumbers -> Bool -> StringifyNumbers
forall a. a -> a -> Bool -> a
bool StringifyNumbers
Options.Don'tStringifyNumbers StringifyNumbers
Options.StringifyNumbers) (Either String Bool -> Either String StringifyNumbers)
-> (String -> Either String Bool)
-> String
-> Either String StringifyNumbers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv Options.RemoteSchemaPermissions where
  fromEnv :: String -> Either String RemoteSchemaPermissions
fromEnv = (Bool -> RemoteSchemaPermissions)
-> Either String Bool -> Either String RemoteSchemaPermissions
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RemoteSchemaPermissions
-> RemoteSchemaPermissions -> Bool -> RemoteSchemaPermissions
forall a. a -> a -> Bool -> a
bool RemoteSchemaPermissions
Options.DisableRemoteSchemaPermissions RemoteSchemaPermissions
Options.EnableRemoteSchemaPermissions) (Either String Bool -> Either String RemoteSchemaPermissions)
-> (String -> Either String Bool)
-> String
-> Either String RemoteSchemaPermissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv Options.DangerouslyCollapseBooleans where
  fromEnv :: String -> Either String DangerouslyCollapseBooleans
fromEnv = (Bool -> DangerouslyCollapseBooleans)
-> Either String Bool -> Either String DangerouslyCollapseBooleans
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DangerouslyCollapseBooleans
-> DangerouslyCollapseBooleans
-> Bool
-> DangerouslyCollapseBooleans
forall a. a -> a -> Bool -> a
bool DangerouslyCollapseBooleans
Options.Don'tDangerouslyCollapseBooleans DangerouslyCollapseBooleans
Options.DangerouslyCollapseBooleans) (Either String Bool -> Either String DangerouslyCollapseBooleans)
-> (String -> Either String Bool)
-> String
-> Either String DangerouslyCollapseBooleans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv Options.InferFunctionPermissions where
  fromEnv :: String -> Either String InferFunctionPermissions
fromEnv = (Bool -> InferFunctionPermissions)
-> Either String Bool -> Either String InferFunctionPermissions
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InferFunctionPermissions
-> InferFunctionPermissions -> Bool -> InferFunctionPermissions
forall a. a -> a -> Bool -> a
bool InferFunctionPermissions
Options.Don'tInferFunctionPermissions InferFunctionPermissions
Options.InferFunctionPermissions) (Either String Bool -> Either String InferFunctionPermissions)
-> (String -> Either String Bool)
-> String
-> Either String InferFunctionPermissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv (Server.Types.MaintenanceMode ()) where
  fromEnv :: String -> Either String (MaintenanceMode ())
fromEnv = (Bool -> MaintenanceMode ())
-> Either String Bool -> Either String (MaintenanceMode ())
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MaintenanceMode ()
-> MaintenanceMode () -> Bool -> MaintenanceMode ()
forall a. a -> a -> Bool -> a
bool MaintenanceMode ()
forall a. MaintenanceMode a
Server.Types.MaintenanceModeDisabled (() -> MaintenanceMode ()
forall a. a -> MaintenanceMode a
Server.Types.MaintenanceModeEnabled ())) (Either String Bool -> Either String (MaintenanceMode ()))
-> (String -> Either String Bool)
-> String
-> Either String (MaintenanceMode ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv Server.Logging.MetadataQueryLoggingMode where
  fromEnv :: String -> Either String MetadataQueryLoggingMode
fromEnv = (Bool -> MetadataQueryLoggingMode)
-> Either String Bool -> Either String MetadataQueryLoggingMode
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MetadataQueryLoggingMode
-> MetadataQueryLoggingMode -> Bool -> MetadataQueryLoggingMode
forall a. a -> a -> Bool -> a
bool MetadataQueryLoggingMode
Server.Logging.MetadataQueryLoggingDisabled MetadataQueryLoggingMode
Server.Logging.MetadataQueryLoggingEnabled) (Either String Bool -> Either String MetadataQueryLoggingMode)
-> (String -> Either String Bool)
-> String
-> Either String MetadataQueryLoggingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv Query.TxIsolation where
  fromEnv :: String -> Either String TxIsolation
fromEnv = String -> Either String TxIsolation
Utils.readIsoLevel

instance FromEnv Cors.CorsConfig where
  fromEnv :: String -> Either String CorsConfig
fromEnv = String -> Either String CorsConfig
Cors.readCorsDomains

instance FromEnv (HashSet Config.API) where
  fromEnv :: String -> Either String (HashSet API)
fromEnv = ([API] -> HashSet API)
-> Either String [API] -> Either String (HashSet API)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [API] -> HashSet API
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (Either String [API] -> Either String (HashSet API))
-> (String -> Either String [API])
-> String
-> Either String (HashSet API)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String API) -> [Text] -> Either String [API]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Either String API
forall {a}. IsString a => Text -> Either a API
readAPI ([Text] -> Either String [API])
-> (String -> [Text]) -> String -> Either String [API]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
    where
      readAPI :: Text -> Either a API
readAPI Text
si = case Text -> Text
Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip Text
si of
        Text
"METADATA" -> API -> Either a API
forall a b. b -> Either a b
Right API
Config.METADATA
        Text
"GRAPHQL" -> API -> Either a API
forall a b. b -> Either a b
Right API
Config.GRAPHQL
        Text
"PGDUMP" -> API -> Either a API
forall a b. b -> Either a b
Right API
Config.PGDUMP
        Text
"DEVELOPER" -> API -> Either a API
forall a b. b -> Either a b
Right API
Config.DEVELOPER
        Text
"CONFIG" -> API -> Either a API
forall a b. b -> Either a b
Right API
Config.CONFIG
        Text
"METRICS" -> API -> Either a API
forall a b. b -> Either a b
Right API
Config.METRICS
        Text
_ -> a -> Either a API
forall a b. a -> Either a b
Left a
"Only expecting list of comma separated API types metadata,graphql,pgdump,developer,config,metrics"

instance FromEnv NamingCase where
  fromEnv :: String -> Either String NamingCase
fromEnv = Text -> Either String NamingCase
NamingCase.parseNamingConventionFromText (Text -> Either String NamingCase)
-> (String -> Text) -> String -> Either String NamingCase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance FromEnv (HashSet Server.Types.ExperimentalFeature) where
  fromEnv :: String -> Either String (HashSet ExperimentalFeature)
fromEnv = ([ExperimentalFeature] -> HashSet ExperimentalFeature)
-> Either String [ExperimentalFeature]
-> Either String (HashSet ExperimentalFeature)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ExperimentalFeature] -> HashSet ExperimentalFeature
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (Either String [ExperimentalFeature]
 -> Either String (HashSet ExperimentalFeature))
-> (String -> Either String [ExperimentalFeature])
-> String
-> Either String (HashSet ExperimentalFeature)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String ExperimentalFeature)
-> [Text] -> Either String [ExperimentalFeature]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Either String ExperimentalFeature
readAPI ([Text] -> Either String [ExperimentalFeature])
-> (String -> [Text])
-> String
-> Either String [ExperimentalFeature]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
    where
      readAPI :: Text -> Either String ExperimentalFeature
readAPI Text
si = case Text -> Text
Text.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip Text
si of
        Text
key | Just (Text
_, ExperimentalFeature
ef) <- ((Text, ExperimentalFeature) -> Bool)
-> [(Text, ExperimentalFeature)]
-> Maybe (Text, ExperimentalFeature)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key) (Text -> Bool)
-> ((Text, ExperimentalFeature) -> Text)
-> (Text, ExperimentalFeature)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, ExperimentalFeature) -> Text
forall a b. (a, b) -> a
fst) [(Text, ExperimentalFeature)]
experimentalFeatures -> ExperimentalFeature -> Either String ExperimentalFeature
forall a b. b -> Either a b
Right ExperimentalFeature
ef
        Text
_ ->
          String -> Either String ExperimentalFeature
forall a b. a -> Either a b
Left
            (String -> Either String ExperimentalFeature)
-> String -> Either String ExperimentalFeature
forall a b. (a -> b) -> a -> b
$ String
"Only expecting list of comma separated experimental features, options are:"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((Text, ExperimentalFeature) -> String)
-> [(Text, ExperimentalFeature)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
Text.unpack (Text -> String)
-> ((Text, ExperimentalFeature) -> Text)
-> (Text, ExperimentalFeature)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, ExperimentalFeature) -> Text
forall a b. (a, b) -> a
fst) [(Text, ExperimentalFeature)]
experimentalFeatures)

      experimentalFeatures :: [(Text, Server.Types.ExperimentalFeature)]
      experimentalFeatures :: [(Text, ExperimentalFeature)]
experimentalFeatures = [(ExperimentalFeature -> Text
Server.Types.experimentalFeatureKey ExperimentalFeature
ef, ExperimentalFeature
ef) | ExperimentalFeature
ef <- [ExperimentalFeature
forall a. Bounded a => a
minBound .. ExperimentalFeature
forall a. Bounded a => a
maxBound]]

instance FromEnv Subscription.Options.BatchSize where
  fromEnv :: String -> Either String BatchSize
fromEnv String
s = do
    Int
val <- String -> Either String Int
forall a. Read a => String -> Either String a
readEither String
s
    String -> Maybe BatchSize -> Either String BatchSize
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"batch size should be a non negative integer" (Maybe BatchSize -> Either String BatchSize)
-> Maybe BatchSize -> Either String BatchSize
forall a b. (a -> b) -> a -> b
$ Int -> Maybe BatchSize
Subscription.Options.mkBatchSize Int
val

instance FromEnv Subscription.Options.RefetchInterval where
  fromEnv :: String -> Either String RefetchInterval
fromEnv String
x = do
    DiffTime
val <- (Integer -> DiffTime)
-> Either String Integer -> Either String DiffTime
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Milliseconds -> DiffTime
milliseconds (Milliseconds -> DiffTime)
-> (Integer -> Milliseconds) -> Integer -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Milliseconds
forall a. Num a => Integer -> a
fromInteger) (Either String Integer -> Either String DiffTime)
-> (String -> Either String Integer)
-> String
-> Either String DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Integer
forall a. Read a => String -> Either String a
readEither (String -> Either String DiffTime)
-> String -> Either String DiffTime
forall a b. (a -> b) -> a -> b
$ String
x
    String -> Maybe RefetchInterval -> Either String RefetchInterval
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"refetch interval should be a non negative integer" (Maybe RefetchInterval -> Either String RefetchInterval)
-> Maybe RefetchInterval -> Either String RefetchInterval
forall a b. (a -> b) -> a -> b
$ DiffTime -> Maybe RefetchInterval
Subscription.Options.mkRefetchInterval DiffTime
val

instance FromEnv Milliseconds where
  fromEnv :: String -> Either String Milliseconds
fromEnv = String -> Either String Milliseconds
forall a. Read a => String -> Either String a
readEither

instance FromEnv Config.OptionalInterval where
  fromEnv :: String -> Either String OptionalInterval
fromEnv String
x = do
    Refined NonNegative Milliseconds
i <- forall a. FromEnv a => String -> Either String a
fromEnv @(Refined NonNegative Milliseconds) String
x
    if Refined NonNegative Milliseconds -> Milliseconds
forall {k} (p :: k) x. Refined p x -> x
unrefine Refined NonNegative Milliseconds
i Milliseconds -> Milliseconds -> Bool
forall a. Eq a => a -> a -> Bool
== Milliseconds
0
      then OptionalInterval -> Either String OptionalInterval
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptionalInterval -> Either String OptionalInterval)
-> OptionalInterval -> Either String OptionalInterval
forall a b. (a -> b) -> a -> b
$ OptionalInterval
Config.Skip
      else OptionalInterval -> Either String OptionalInterval
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptionalInterval -> Either String OptionalInterval)
-> OptionalInterval -> Either String OptionalInterval
forall a b. (a -> b) -> a -> b
$ Refined NonNegative Milliseconds -> OptionalInterval
Config.Interval Refined NonNegative Milliseconds
i

instance FromEnv Seconds where
  fromEnv :: String -> Either String Seconds
fromEnv = (Integer -> Seconds)
-> Either String Integer -> Either String Seconds
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Seconds
forall a. Num a => Integer -> a
fromInteger (Either String Integer -> Either String Seconds)
-> (String -> Either String Integer)
-> String
-> Either String Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Integer
forall a. Read a => String -> Either String a
readEither

instance FromEnv Config.WSConnectionInitTimeout where
  fromEnv :: String -> Either String WSConnectionInitTimeout
fromEnv String
s = do
    Seconds
seconds <- forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Seconds (Int -> Seconds) -> Either String Int -> Either String Seconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromEnv a => String -> Either String a
fromEnv @Int String
s
    Refined NonNegative Seconds
nonNegative <- String
-> Maybe (Refined NonNegative Seconds)
-> Either String (Refined NonNegative Seconds)
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"WebSocket Connection Timeout must not be negative" (Maybe (Refined NonNegative Seconds)
 -> Either String (Refined NonNegative Seconds))
-> Maybe (Refined NonNegative Seconds)
-> Either String (Refined NonNegative Seconds)
forall a b. (a -> b) -> a -> b
$ Seconds -> Maybe (Refined NonNegative Seconds)
forall {k} (p :: k) x (m :: * -> *).
(Predicate p x, MonadFail m) =>
x -> m (Refined p x)
refineFail Seconds
seconds
    WSConnectionInitTimeout -> Either String WSConnectionInitTimeout
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WSConnectionInitTimeout -> Either String WSConnectionInitTimeout)
-> WSConnectionInitTimeout -> Either String WSConnectionInitTimeout
forall a b. (a -> b) -> a -> b
$ Refined NonNegative Seconds -> WSConnectionInitTimeout
Config.WSConnectionInitTimeout Refined NonNegative Seconds
nonNegative

instance FromEnv Config.KeepAliveDelay where
  fromEnv :: String -> Either String KeepAliveDelay
fromEnv =
    (Refined NonNegative Seconds -> KeepAliveDelay)
-> Either String (Refined NonNegative Seconds)
-> Either String KeepAliveDelay
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Refined NonNegative Seconds -> KeepAliveDelay
Config.KeepAliveDelay (Either String (Refined NonNegative Seconds)
 -> Either String KeepAliveDelay)
-> (String -> Either String (Refined NonNegative Seconds))
-> String
-> Either String KeepAliveDelay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @(Refined NonNegative Seconds)

instance FromEnv Auth.JWTConfig where
  fromEnv :: String -> Either String JWTConfig
fromEnv = String -> Either String JWTConfig
forall a. FromJSON a => String -> Either String a
readJson

instance FromEnv [Auth.JWTConfig] where
  fromEnv :: String -> Either String [JWTConfig]
fromEnv = String -> Either String [JWTConfig]
forall a. FromJSON a => String -> Either String a
readJson

instance (Logging.EnabledLogTypes impl) => FromEnv (HashSet (Logging.EngineLogType impl)) where
  fromEnv :: String -> Either String (HashSet (EngineLogType impl))
fromEnv = ([EngineLogType impl] -> HashSet (EngineLogType impl))
-> Either String [EngineLogType impl]
-> Either String (HashSet (EngineLogType impl))
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [EngineLogType impl] -> HashSet (EngineLogType impl)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (Either String [EngineLogType impl]
 -> Either String (HashSet (EngineLogType impl)))
-> (String -> Either String [EngineLogType impl])
-> String
-> Either String (HashSet (EngineLogType impl))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String [EngineLogType impl]
forall impl.
EnabledLogTypes impl =>
String -> Either String [EngineLogType impl]
Logging.parseEnabledLogTypes

instance FromEnv Logging.LogLevel where
  fromEnv :: String -> Either String LogLevel
fromEnv String
s = case Text -> Text
Text.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
s of
    Text
"debug" -> LogLevel -> Either String LogLevel
forall a b. b -> Either a b
Right LogLevel
Logging.LevelDebug
    Text
"info" -> LogLevel -> Either String LogLevel
forall a b. b -> Either a b
Right LogLevel
Logging.LevelInfo
    Text
"warn" -> LogLevel -> Either String LogLevel
forall a b. b -> Either a b
Right LogLevel
Logging.LevelWarn
    Text
"error" -> LogLevel -> Either String LogLevel
forall a b. b -> Either a b
Right LogLevel
Logging.LevelError
    Text
_ -> String -> Either String LogLevel
forall a b. a -> Either a b
Left String
"Valid log levels: debug, info, warn or error"

instance FromEnv Template.Template where
  fromEnv :: String -> Either String Template
fromEnv = Text -> Either String Template
Template.parseTemplate (Text -> Either String Template)
-> (String -> Text) -> String -> Either String Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance (Num a, Ord a, FromEnv a) => FromEnv (Refined NonNegative a) where
  fromEnv :: String -> Either String (Refined NonNegative a)
fromEnv String
s =
    (Maybe (Refined NonNegative a)
 -> Either String (Refined NonNegative a))
-> (a -> Maybe (Refined NonNegative a))
-> a
-> Either String (Refined NonNegative a)
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
-> Maybe (Refined NonNegative a)
-> Either String (Refined NonNegative a)
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a non negative numeric") a -> Maybe (Refined NonNegative a)
forall {k} (p :: k) x (m :: * -> *).
(Predicate p x, MonadFail m) =>
x -> m (Refined p x)
refineFail (a -> Either String (Refined NonNegative a))
-> Either String a -> Either String (Refined NonNegative a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Either String a
forall a. FromEnv a => String -> Either String a
fromEnv String
s

instance FromEnv (Refined Positive Int) where
  fromEnv :: String -> Either String (Refined Positive Int)
fromEnv String
s =
    String
-> Maybe (Refined Positive Int)
-> Either String (Refined Positive Int)
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a positive integer" (Int -> Maybe (Refined Positive Int)
forall {k} (p :: k) x (m :: * -> *).
(Predicate p x, MonadFail m) =>
x -> m (Refined p x)
refineFail (Int -> Maybe (Refined Positive Int))
-> Maybe Int -> Maybe (Refined Positive Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s)

instance FromEnv Config.Port where
  fromEnv :: String -> Either String Port
fromEnv String
s =
    String -> Maybe Port -> Either String Port
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a value between 0 and 65535" (Int -> Maybe Port
Config.mkPort (Int -> Maybe Port) -> Maybe Int -> Maybe Port
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s)

instance FromEnv Cache.CacheSize where
  fromEnv :: String -> Either String CacheSize
fromEnv = String -> Either String CacheSize
Cache.parseCacheSize

instance FromEnv ExtensionsSchema where
  fromEnv :: String -> Either String ExtensionsSchema
fromEnv = ExtensionsSchema -> Either String ExtensionsSchema
forall a b. b -> Either a b
Right (ExtensionsSchema -> Either String ExtensionsSchema)
-> (String -> ExtensionsSchema)
-> String
-> Either String ExtensionsSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ExtensionsSchema
MonadTx.ExtensionsSchema (Text -> ExtensionsSchema)
-> (String -> Text) -> String -> ExtensionsSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance FromEnv Server.Types.ApolloFederationStatus where
  fromEnv :: String -> Either String ApolloFederationStatus
fromEnv = (Bool -> ApolloFederationStatus)
-> Either String Bool -> Either String ApolloFederationStatus
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ApolloFederationStatus
-> ApolloFederationStatus -> Bool -> ApolloFederationStatus
forall a. a -> a -> Bool -> a
bool ApolloFederationStatus
Server.Types.ApolloFederationDisabled ApolloFederationStatus
Server.Types.ApolloFederationEnabled) (Either String Bool -> Either String ApolloFederationStatus)
-> (String -> Either String Bool)
-> String
-> Either String ApolloFederationStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv GranularPrometheusMetricsState where
  fromEnv :: String -> Either String GranularPrometheusMetricsState
fromEnv = (Bool -> GranularPrometheusMetricsState)
-> Either String Bool
-> Either String GranularPrometheusMetricsState
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GranularPrometheusMetricsState
-> GranularPrometheusMetricsState
-> Bool
-> GranularPrometheusMetricsState
forall a. a -> a -> Bool -> a
bool GranularPrometheusMetricsState
GranularMetricsOff GranularPrometheusMetricsState
GranularMetricsOn) (Either String Bool
 -> Either String GranularPrometheusMetricsState)
-> (String -> Either String Bool)
-> String
-> Either String GranularPrometheusMetricsState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool

instance FromEnv Server.Types.CloseWebsocketsOnMetadataChangeStatus where
  fromEnv :: String -> Either String CloseWebsocketsOnMetadataChangeStatus
fromEnv = (Bool -> CloseWebsocketsOnMetadataChangeStatus)
-> Either String Bool
-> Either String CloseWebsocketsOnMetadataChangeStatus
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CloseWebsocketsOnMetadataChangeStatus
-> CloseWebsocketsOnMetadataChangeStatus
-> Bool
-> CloseWebsocketsOnMetadataChangeStatus
forall a. a -> a -> Bool -> a
bool CloseWebsocketsOnMetadataChangeStatus
Server.Types.CWMCDisabled CloseWebsocketsOnMetadataChangeStatus
Server.Types.CWMCEnabled) (Either String Bool
 -> Either String CloseWebsocketsOnMetadataChangeStatus)
-> (String -> Either String Bool)
-> String
-> Either String CloseWebsocketsOnMetadataChangeStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromEnv a => String -> Either String a
fromEnv @Bool