module Config (
  Config (..),
  MetricsConfig (..),
  StorageBackend (..),
  periodicSyncingEnabled,
  configInfo,
) where

import Control.Applicative (optional)
import Data.Semigroup ((<>))
import Options.Applicative
import qualified Network.Wai.Handler.Warp as Warp
import qualified Text.Read as Read
import qualified Data.Char as Char
import Data.Maybe (isJust)
import Data.String (fromString)
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Web.JWT as JWT


data StorageBackend = File | Sqlite

-- command-line arguments
data Config = Config
  { Config -> Maybe FilePath
configDataFile :: Maybe FilePath
  , Config -> Int
configPort :: Int
    -- | Enables the use of JWT for authorization in JWT.
  , Config -> Bool
configEnableJwtAuth :: Bool
  -- | The secret used for verifying the JWT signatures. If no secret is
  -- specified even though JWT authorization is enabled, tokens will still be
  -- used, but not be verified.
  , Config -> Maybe Signer
configJwtSecret :: Maybe JWT.Signer
  , Config -> Maybe MetricsConfig
configMetricsEndpoint :: Maybe MetricsConfig
  , Config -> Word
configQueueCapacity :: Word
  , Config -> Maybe Int
configSyncIntervalMicroSeconds :: Maybe Int
  -- | Enable journaling, only in conjunction with periodic syncing
  , Config -> Bool
configEnableJournaling :: Bool
  -- | Indicates that the sentry logging is disabled, can be used to overwrite
  -- ```configSentryDSN``` or the environment variable
  , Config -> Bool
configDisableSentryLogging :: Bool
  -- | The SENTRY_DSN key that Sentry uses to communicate, if not set, use Nothing.
  -- Just indicates that a key is given.
  , Config -> Maybe FilePath
configSentryDSN :: Maybe String
  , Config -> StorageBackend
configStorageBackend :: StorageBackend
  }

data MetricsConfig = MetricsConfig
  { MetricsConfig -> HostPreference
metricsConfigHost :: Warp.HostPreference
  , MetricsConfig -> Int
metricsConfigPort :: Warp.Port
  }

periodicSyncingEnabled :: Config -> Bool
periodicSyncingEnabled :: Config -> Bool
periodicSyncingEnabled = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (Config -> Maybe Int) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe Int
configSyncIntervalMicroSeconds

-- Parsing of command-line arguments

type EnvironmentConfig = [(String, String)]

configParser :: EnvironmentConfig -> Parser Config
configParser :: EnvironmentConfig -> Parser Config
configParser EnvironmentConfig
environment = Maybe FilePath
-> Int
-> Bool
-> Maybe Signer
-> Maybe MetricsConfig
-> Word
-> Maybe Int
-> Bool
-> Bool
-> Maybe FilePath
-> StorageBackend
-> Config
Config
  -- Note: If no --data-file is given we default either to icepeak.json or icepeak.db
  (Maybe FilePath
 -> Int
 -> Bool
 -> Maybe Signer
 -> Maybe MetricsConfig
 -> Word
 -> Maybe Int
 -> Bool
 -> Bool
 -> Maybe FilePath
 -> StorageBackend
 -> Config)
-> Parser (Maybe FilePath)
-> Parser
     (Int
      -> Bool
      -> Maybe Signer
      -> Maybe MetricsConfig
      -> Word
      -> Maybe Int
      -> Bool
      -> Bool
      -> Maybe FilePath
      -> StorageBackend
      -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"data-file" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
                   FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DATA_FILE" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
                   FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"File where data is persisted to. Default: icepeak.json"))
  Parser
  (Int
   -> Bool
   -> Maybe Signer
   -> Maybe MetricsConfig
   -> Word
   -> Maybe Int
   -> Bool
   -> Bool
   -> Maybe FilePath
   -> StorageBackend
   -> Config)
-> Parser Int
-> Parser
     (Bool
      -> Maybe Signer
      -> Maybe MetricsConfig
      -> Word
      -> Maybe Int
      -> Bool
      -> Bool
      -> Maybe FilePath
      -> StorageBackend
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"port" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
                   FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PORT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
                   Mod OptionFields Int
-> (Int -> Mod OptionFields Int)
-> Maybe Int
-> Mod OptionFields Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
3000) Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readFromEnvironment FilePath
"ICEPEAK_PORT") Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
                   FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Port to listen on, defaults to the value of the ICEPEAK_PORT environment variable if present, or 3000 if not")
  Parser
  (Bool
   -> Maybe Signer
   -> Maybe MetricsConfig
   -> Word
   -> Maybe Int
   -> Bool
   -> Bool
   -> Maybe FilePath
   -> StorageBackend
   -> Config)
-> Parser Bool
-> Parser
     (Maybe Signer
      -> Maybe MetricsConfig
      -> Word
      -> Maybe Int
      -> Bool
      -> Bool
      -> Maybe FilePath
      -> StorageBackend
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"enable-jwt-auth" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
                FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable authorization using JSON Web Tokens.")
  Parser
  (Maybe Signer
   -> Maybe MetricsConfig
   -> Word
   -> Maybe Int
   -> Bool
   -> Bool
   -> Maybe FilePath
   -> StorageBackend
   -> Config)
-> Parser (Maybe Signer)
-> Parser
     (Maybe MetricsConfig
      -> Word
      -> Maybe Int
      -> Bool
      -> Bool
      -> Maybe FilePath
      -> StorageBackend
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Signer -> Parser (Maybe Signer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser Signer
secretOption (
                       FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"jwt-secret" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
                       FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"JWT_SECRET" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
                       FilePath -> Mod OptionFields FilePath
forall (f :: * -> *). HasValue f => FilePath -> Mod f FilePath
environ FilePath
"JWT_SECRET" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
                       FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Secret used for JWT verification, defaults to the value of the JWT_SECRET environment variable if present. If no secret is passed, JWT tokens are not checked for validity."))
  Parser
  (Maybe MetricsConfig
   -> Word
   -> Maybe Int
   -> Bool
   -> Bool
   -> Maybe FilePath
   -> StorageBackend
   -> Config)
-> Parser (Maybe MetricsConfig)
-> Parser
     (Word
      -> Maybe Int
      -> Bool
      -> Bool
      -> Maybe FilePath
      -> StorageBackend
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MetricsConfig -> Parser (Maybe MetricsConfig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM MetricsConfig
-> Mod OptionFields MetricsConfig -> Parser MetricsConfig
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM MetricsConfig
metricsConfigReader
                 (FilePath -> Mod OptionFields MetricsConfig
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"metrics" Mod OptionFields MetricsConfig
-> Mod OptionFields MetricsConfig -> Mod OptionFields MetricsConfig
forall a. Semigroup a => a -> a -> a
<>
                  FilePath -> Mod OptionFields MetricsConfig
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HOST:PORT" Mod OptionFields MetricsConfig
-> Mod OptionFields MetricsConfig -> Mod OptionFields MetricsConfig
forall a. Semigroup a => a -> a -> a
<>
                  FilePath -> Mod OptionFields MetricsConfig
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"If provided, Icepeak collects various metrics and provides them to Prometheus on the given endpoint."
                 ))
  Parser
  (Word
   -> Maybe Int
   -> Bool
   -> Bool
   -> Maybe FilePath
   -> StorageBackend
   -> Config)
-> Parser Word
-> Parser
     (Maybe Int
      -> Bool -> Bool -> Maybe FilePath -> StorageBackend -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Word
forall a. Read a => ReadM a
auto
       (FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"queue-capacity" Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<>
        FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INTEGER" Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<>
        Word -> Mod OptionFields Word
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word
256 Mod OptionFields Word
-> Mod OptionFields Word -> Mod OptionFields Word
forall a. Semigroup a => a -> a -> a
<>
        FilePath -> Mod OptionFields Word
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"Smaller values decrease the risk of data loss during a crash, while " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
              FilePath
"higher values result in more requests being accepted in rapid succession."))
  Parser
  (Maybe Int
   -> Bool -> Bool -> Maybe FilePath -> StorageBackend -> Config)
-> Parser (Maybe Int)
-> Parser
     (Bool -> Bool -> Maybe FilePath -> StorageBackend -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
timeDurationReader
       (FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"sync-interval" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
        FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DURATION" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
        FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"If supplied, data is only persisted to disc every DURATION time units." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
              FilePath
"The units 'm' (minutes), 's' (seconds) and 'ms' (milliseconds) can be used. " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
              FilePath
"When omitting this argument, data is persisted after every modification")))
  Parser (Bool -> Bool -> Maybe FilePath -> StorageBackend -> Config)
-> Parser Bool
-> Parser (Bool -> Maybe FilePath -> StorageBackend -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"journaling" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
             FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable journaling. This only has an effect when periodic syncing is enabled.")
  Parser (Bool -> Maybe FilePath -> StorageBackend -> Config)
-> Parser Bool
-> Parser (Maybe FilePath -> StorageBackend -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"disable-sentry-logging" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
             FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Disable error logging via Sentry")
  Parser (Maybe FilePath -> StorageBackend -> Config)
-> Parser (Maybe FilePath) -> Parser (StorageBackend -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (
              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"sentry-dsn" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SENTRY_DSN" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *). HasValue f => FilePath -> Mod f FilePath
environ FilePath
"SENTRY_DSN" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<>
              FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Sentry DSN used for Sentry logging, defaults to the value of the SENTRY_DSN environment variable if present. If no secret is passed, Sentry logging will be disabled."))
  Parser (StorageBackend -> Config)
-> Parser StorageBackend -> Parser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StorageBackend
storageBackend

  where
    environ :: FilePath -> Mod f FilePath
environ FilePath
var = (FilePath -> Mod f FilePath) -> Maybe FilePath -> Mod f FilePath
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FilePath -> Mod f FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (FilePath -> EnvironmentConfig -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
var EnvironmentConfig
environment)

    readFromEnvironment :: Read a => String -> Maybe a
    readFromEnvironment :: FilePath -> Maybe a
readFromEnvironment FilePath
var = FilePath -> EnvironmentConfig -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
var EnvironmentConfig
environment Maybe FilePath -> (FilePath -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe a
forall a. Read a => FilePath -> Maybe a
Read.readMaybe

    secretOption :: Mod OptionFields FilePath -> Parser Signer
secretOption Mod OptionFields FilePath
m = Text -> Signer
JWT.hmacSecret (Text -> Signer) -> (FilePath -> Text) -> FilePath -> Signer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Signer) -> Parser FilePath -> Parser Signer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption Mod OptionFields FilePath
m

configInfo :: EnvironmentConfig -> ParserInfo Config
configInfo :: EnvironmentConfig -> ParserInfo Config
configInfo EnvironmentConfig
environment = Parser Config -> InfoMod Config -> ParserInfo Config
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Config
parser InfoMod Config
forall a. InfoMod a
description
  where
    parser :: Parser Config
parser = Parser (Config -> Config)
forall a. Parser (a -> a)
helper Parser (Config -> Config) -> Parser Config -> Parser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvironmentConfig -> Parser Config
configParser EnvironmentConfig
environment
    description :: InfoMod a
description = InfoMod a
forall a. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<>
      FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
header FilePath
"Icepeak - Fast Json document store with push notification support."

-- * Parsers

storageBackend :: Parser StorageBackend
storageBackend :: Parser StorageBackend
storageBackend = Parser StorageBackend
fileBackend Parser StorageBackend
-> Parser StorageBackend -> Parser StorageBackend
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StorageBackend
sqliteBackend

fileBackend :: Parser StorageBackend
-- The first 'File' here is the default value. We want --file to be used by default, when nothing
-- is specified on the command-line. This ensures backwards-compatibility.
fileBackend :: Parser StorageBackend
fileBackend = StorageBackend
-> StorageBackend
-> Mod FlagFields StorageBackend
-> Parser StorageBackend
forall a. a -> a -> Mod FlagFields a -> Parser a
flag StorageBackend
File StorageBackend
File (FilePath -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"file" Mod FlagFields StorageBackend
-> Mod FlagFields StorageBackend -> Mod FlagFields StorageBackend
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Use a file as the storage backend." )

sqliteBackend :: Parser StorageBackend
sqliteBackend :: Parser StorageBackend
sqliteBackend = StorageBackend
-> Mod FlagFields StorageBackend -> Parser StorageBackend
forall a. a -> Mod FlagFields a -> Parser a
flag' StorageBackend
Sqlite (FilePath -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"sqlite" Mod FlagFields StorageBackend
-> Mod FlagFields StorageBackend -> Mod FlagFields StorageBackend
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields StorageBackend
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Use a sqlite file as the storage backend." )

-- * Reader functions

metricsConfigReader :: ReadM MetricsConfig
metricsConfigReader :: ReadM MetricsConfig
metricsConfigReader = (FilePath -> Either FilePath MetricsConfig) -> ReadM MetricsConfig
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((FilePath -> Either FilePath MetricsConfig)
 -> ReadM MetricsConfig)
-> (FilePath -> Either FilePath MetricsConfig)
-> ReadM MetricsConfig
forall a b. (a -> b) -> a -> b
$ \FilePath
input ->
  case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') FilePath
input of
    (FilePath
hostStr, Char
':':FilePath
portStr) -> HostPreference -> Int -> MetricsConfig
MetricsConfig (FilePath -> HostPreference
forall a. IsString a => FilePath -> a
fromString FilePath
hostStr) (Int -> MetricsConfig)
-> Either FilePath Int -> Either FilePath MetricsConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Either FilePath Int
forall a. Read a => FilePath -> Either FilePath a
Read.readEither FilePath
portStr
    (FilePath
_, FilePath
_) -> FilePath -> Either FilePath MetricsConfig
forall a b. a -> Either a b
Left FilePath
"no port specified"

-- | Read an option as a time duration in microseconds.
timeDurationReader :: ReadM Int
timeDurationReader :: ReadM Int
timeDurationReader = (FilePath -> Either FilePath Int) -> ReadM Int
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((FilePath -> Either FilePath Int) -> ReadM Int)
-> (FilePath -> Either FilePath Int) -> ReadM Int
forall a b. (a -> b) -> a -> b
$ \FilePath
input ->
  case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break Char -> Bool
Char.isLetter FilePath
input of
    (FilePath
"", FilePath
_) -> FilePath -> Either FilePath Int
forall a b. a -> Either a b
Left FilePath
"no amount specified"
    (FilePath
amount, FilePath
unit) -> case FilePath -> [(FilePath, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
unit [(FilePath, Int)]
units of
      Maybe Int
Nothing -> FilePath -> Either FilePath Int
forall a b. a -> Either a b
Left FilePath
"invalid unit"
      Just Int
factor -> (Int -> Int) -> Either FilePath Int -> Either FilePath Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
factor) (Either FilePath Int -> Either FilePath Int)
-> Either FilePath Int -> Either FilePath Int
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Int
forall a. Read a => FilePath -> Either FilePath a
Read.readEither FilePath
amount
  where
    -- defines the available units and how they convert to microseconds
    units :: [(FilePath, Int)]
units = [ (FilePath
"s", Int
1000000)
            , (FilePath
"ms", Int
1000)
            , (FilePath
"m", Int
60000000)
            ]