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

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

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

import Control.Monad.Morph qualified as Morph
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.GraphQL.Schema.NamingCase (NamingCase)
import Hasura.GraphQL.Schema.NamingCase qualified as NamingCase
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.RQL.Types.Numeric qualified as Numeric
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 qualified as Server.Types
import Hasura.Server.Utils qualified as Utils
import Hasura.Session qualified as Session
import Network.Wai.Handler.Warp qualified as Warp

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

-- | 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 :: 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 (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 (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 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 :: [String] -> WithEnvT m (Maybe a)
considerEnvs [String]
envVars = (Maybe a -> Maybe a -> Maybe a) -> [Maybe a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 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)
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 :: Maybe option -> [Option ()] -> WithEnvT m (Maybe option)
withOptions Maybe option
parsed [Option ()]
options = (Maybe option -> Maybe option -> Maybe option)
-> [Maybe option] -> Maybe option
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Maybe option -> Maybe option -> Maybe option
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)
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 def' 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 :: 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 (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 def' 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 :: Maybe option -> Option option -> WithEnvT m option
withOptionDefault Maybe option
parsed Config.Option {option
String
_helpMessage :: forall def. Option def -> String
_envVar :: forall def. Option def -> String
_helpMessage :: String
_envVar :: String
_default :: option
_default :: forall def. Option def -> def
..} =
  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'.
--
-- An alternative solution would 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.
withOptionSwitch :: Monad m => Bool -> Config.Option Bool -> WithEnvT m Bool
withOptionSwitch :: Bool -> Option Bool -> WithEnvT m Bool
withOptionSwitch Bool
parsed Option Bool
option = WithEnvT m Bool -> WithEnvT m Bool -> Bool -> WithEnvT m Bool
forall a. a -> a -> Bool -> a
bool (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 Option Bool
option) (Bool -> WithEnvT m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Bool
parsed

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

-- | 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 {WithEnvT m a -> ReaderT [(String, String)] (ExceptT String m) a
unWithEnvT :: ReaderT [(String, String)] (ExceptT String m) a}
  deriving newtype (a -> WithEnvT m b -> WithEnvT m a
(a -> b) -> WithEnvT m a -> WithEnvT m b
(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
<$ :: a -> WithEnvT m b -> WithEnvT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithEnvT m b -> WithEnvT m a
fmap :: (a -> b) -> WithEnvT m a -> WithEnvT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithEnvT m a -> WithEnvT m b
Functor, Functor (WithEnvT m)
a -> WithEnvT m a
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)
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
WithEnvT m a -> WithEnvT m b -> WithEnvT m a
WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
(a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
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
<* :: WithEnvT m a -> WithEnvT m b -> WithEnvT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m a
*> :: WithEnvT m a -> WithEnvT m b -> WithEnvT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
liftA2 :: (a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> WithEnvT m a -> WithEnvT m b -> WithEnvT m c
<*> :: WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m (a -> b) -> WithEnvT m a -> WithEnvT m b
pure :: a -> WithEnvT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> WithEnvT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (WithEnvT m)
Applicative, Applicative (WithEnvT m)
a -> WithEnvT m a
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)
WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
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
return :: a -> WithEnvT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithEnvT m a
>> :: WithEnvT m a -> WithEnvT m b -> WithEnvT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> WithEnvT m b -> WithEnvT m b
>>= :: WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithEnvT m a -> (a -> WithEnvT m b) -> WithEnvT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (WithEnvT m)
Monad, MonadReader [(String, String)], MonadError String, Monad (WithEnvT m)
Monad (WithEnvT m)
-> (forall a. IO a -> WithEnvT m a) -> MonadIO (WithEnvT m)
IO a -> WithEnvT m a
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
liftIO :: IO a -> WithEnvT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> WithEnvT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (WithEnvT m)
MonadIO)

instance MonadTrans WithEnvT where
  lift :: 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 (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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance Morph.MFunctor WithEnvT where
  hoist :: (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
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
Morph.hoist 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 :: [(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 :: [(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 (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 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 Session.RoleName where
  fromEnv :: String -> Either String RoleName
fromEnv String
string =
    case Text -> Maybe RoleName
Session.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 (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 (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 Options.StringifyNumbers where
  fromEnv :: String -> Either String StringifyNumbers
fromEnv = (Bool -> StringifyNumbers)
-> Either String Bool -> Either String StringifyNumbers
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
. FromEnv Bool => String -> Either String Bool
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 (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
. FromEnv Bool => String -> Either String Bool
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 (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
. FromEnv Bool => String -> Either String Bool
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 (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
. FromEnv Bool => String -> Either String Bool
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 (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
. FromEnv Bool => String -> Either String Bool
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 (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
. FromEnv Bool => String -> Either String Bool
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 (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)
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
. 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 (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)
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
. 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
"inherited_roles" -> ExperimentalFeature -> Either String ExperimentalFeature
forall a b. b -> Either a b
Right ExperimentalFeature
Server.Types.EFInheritedRoles
        Text
"streaming_subscriptions" -> ExperimentalFeature -> Either String ExperimentalFeature
forall a b. b -> Either a b
Right ExperimentalFeature
Server.Types.EFStreamingSubscriptions
        Text
"optimize_permission_filters" -> ExperimentalFeature -> Either String ExperimentalFeature
forall a b. b -> Either a b
Right ExperimentalFeature
Server.Types.EFOptimizePermissionFilters
        Text
"naming_convention" -> ExperimentalFeature -> Either String ExperimentalFeature
forall a b. b -> Either a b
Right ExperimentalFeature
Server.Types.EFNamingConventions
        Text
"apollo_federation" -> ExperimentalFeature -> Either String ExperimentalFeature
forall a b. b -> Either a b
Right ExperimentalFeature
Server.Types.EFApolloFederation
        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
"inherited_roles, streaming_subscriptions, optimize_permission_filters, naming_convention, apollo_federation"

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 (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
    NonNegative Milliseconds
i <- String -> Either String (NonNegative Milliseconds)
forall a. FromEnv a => String -> Either String a
fromEnv @(Numeric.NonNegative Milliseconds) String
x
    if NonNegative Milliseconds -> Milliseconds
forall a. NonNegative a -> a
Numeric.getNonNegative NonNegative Milliseconds
i Milliseconds -> Milliseconds -> Bool
forall a. Eq a => a -> a -> Bool
== Milliseconds
0
      then OptionalInterval -> Either String OptionalInterval
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 (f :: * -> *) a. Applicative f => a -> f a
pure (OptionalInterval -> Either String OptionalInterval)
-> OptionalInterval -> Either String OptionalInterval
forall a b. (a -> b) -> a -> b
$ NonNegative Milliseconds -> OptionalInterval
Config.Interval NonNegative Milliseconds
i

instance FromEnv Seconds where
  fromEnv :: String -> Either String Seconds
fromEnv = (Integer -> Seconds)
-> Either String Integer -> Either String Seconds
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 <- (Integral Int, Num Seconds) => Int -> 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
<$> String -> Either String Int
forall a. FromEnv a => String -> Either String a
fromEnv @Int String
s
    NonNegative Seconds
nonNegative <- String
-> Maybe (NonNegative Seconds)
-> Either String (NonNegative Seconds)
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"WebSocket Connection Timeout must not be negative" (Maybe (NonNegative Seconds)
 -> Either String (NonNegative Seconds))
-> Maybe (NonNegative Seconds)
-> Either String (NonNegative Seconds)
forall a b. (a -> b) -> a -> b
$ Seconds -> Maybe (NonNegative Seconds)
forall a. (Ord a, Num a) => a -> Maybe (NonNegative a)
Numeric.mkNonNegative Seconds
seconds
    WSConnectionInitTimeout -> Either String WSConnectionInitTimeout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WSConnectionInitTimeout -> Either String WSConnectionInitTimeout)
-> WSConnectionInitTimeout -> Either String WSConnectionInitTimeout
forall a b. (a -> b) -> a -> b
$ NonNegative Seconds -> WSConnectionInitTimeout
Config.WSConnectionInitTimeout NonNegative Seconds
nonNegative

instance FromEnv Config.KeepAliveDelay where
  fromEnv :: String -> Either String KeepAliveDelay
fromEnv =
    (NonNegative Seconds -> KeepAliveDelay)
-> Either String (NonNegative Seconds)
-> Either String KeepAliveDelay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonNegative Seconds -> KeepAliveDelay
Config.KeepAliveDelay (Either String (NonNegative Seconds)
 -> Either String KeepAliveDelay)
-> (String -> Either String (NonNegative Seconds))
-> String
-> Either String KeepAliveDelay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromEnv (NonNegative Seconds) =>
String -> Either String (NonNegative Seconds)
forall a. FromEnv a => String -> Either String a
fromEnv @(Numeric.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 (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.URLTemplate where
  fromEnv :: String -> Either String URLTemplate
fromEnv = Text -> Either String URLTemplate
Template.parseURLTemplate (Text -> Either String URLTemplate)
-> (String -> Text) -> String -> Either String URLTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance (Num a, Ord a, FromEnv a) => FromEnv (Numeric.NonNegative a) where
  fromEnv :: String -> Either String (NonNegative a)
fromEnv String
s =
    (Maybe (NonNegative a) -> Either String (NonNegative a))
-> (a -> Maybe (NonNegative a))
-> a
-> Either String (NonNegative a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe (NonNegative a) -> Either String (NonNegative a)
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a non negative numeric") a -> Maybe (NonNegative a)
forall a. (Ord a, Num a) => a -> Maybe (NonNegative a)
Numeric.mkNonNegative (a -> Either String (NonNegative a))
-> Either String a -> Either String (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 Numeric.NonNegativeInt where
  fromEnv :: String -> Either String NonNegativeInt
fromEnv String
s =
    String -> Maybe NonNegativeInt -> Either String NonNegativeInt
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a non negative integer" (Int -> Maybe NonNegativeInt
Numeric.mkNonNegativeInt (Int -> Maybe NonNegativeInt) -> Maybe Int -> Maybe NonNegativeInt
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 Numeric.NonNegativeDiffTime where
  fromEnv :: String -> Either String NonNegativeDiffTime
fromEnv String
s =
    (Maybe NonNegativeDiffTime -> Either String NonNegativeDiffTime)
-> (DiffTime -> Maybe NonNegativeDiffTime)
-> DiffTime
-> Either String NonNegativeDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
-> Maybe NonNegativeDiffTime -> Either String NonNegativeDiffTime
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a non negative difftime") DiffTime -> Maybe NonNegativeDiffTime
Numeric.mkNonNegativeDiffTime (DiffTime -> Either String NonNegativeDiffTime)
-> Either String DiffTime -> Either String NonNegativeDiffTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> Either String DiffTime
forall a. FromEnv a => String -> Either String a
fromEnv @DiffTime String
s)

instance FromEnv Numeric.PositiveInt where
  fromEnv :: String -> Either String PositiveInt
fromEnv String
s =
    String -> Maybe PositiveInt -> Either String PositiveInt
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Only expecting a positive integer" (Int -> Maybe PositiveInt
Numeric.mkPositiveInt (Int -> Maybe PositiveInt) -> Maybe Int -> Maybe PositiveInt
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