-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Ecluse.Config.Aeson () where

import Data.Aeson (FromJSON (..), Value (..), withObject, withText, (.!=), (.:), (.:?))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser)
import Data.Char (isSpace)
import Data.IP (IPRange)
import Data.Map.Strict qualified as Map
import Data.Scientific (toBoundedInteger)
import Data.Text qualified as T
import Data.Time (NominalDiffTime)

import Ecluse.Config.Parser
import Ecluse.Config.Rule
import Ecluse.Config.Types

import Ecluse.Core.Credential (Secret, mkSecret)
import Ecluse.Core.Ecosystem (Ecosystem, parseEcosystem)
import Ecluse.Core.Package (Scope, mkScope)
import Ecluse.Core.Package.Integrity (parseMinIntegrity, parseMinTrustedIntegrity)
import Ecluse.Core.Package.Merge (parseDivergencePolicy)
import Ecluse.Core.Security (parseBlockedRange)
import Ecluse.Runtime.Log (parseLogFormat)
import Ecluse.Runtime.Telemetry (parseTelemetrySwitch)

instance FromJSON MountConfig where
    parseJSON :: Value -> Parser MountConfig
parseJSON = String
-> (KeyMap Value -> Parser MountConfig)
-> Value
-> Parser MountConfig
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"MountConfig" KeyMap Value -> Parser MountConfig
mountConfigParser

mountConfigParser :: KeyMap.KeyMap Value -> Parser MountConfig
mountConfigParser :: KeyMap Value -> Parser MountConfig
mountConfigParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"mount" [Key]
acceptedMountKeys KeyMap Value
o
    Maybe Bool
-> Maybe RegistryUrl
-> RegistryUrl
-> Maybe RegistryUrl
-> Maybe Secret
-> Maybe Natural
-> Maybe RegistryUrl
-> Maybe Secret
-> [Scope]
-> Maybe MinTrustedIntegrity
-> Maybe DivergencePolicy
-> RulePatch
-> MountConfig
MountConfig
        (Maybe Bool
 -> Maybe RegistryUrl
 -> RegistryUrl
 -> Maybe RegistryUrl
 -> Maybe Secret
 -> Maybe Natural
 -> Maybe RegistryUrl
 -> Maybe Secret
 -> [Scope]
 -> Maybe MinTrustedIntegrity
 -> Maybe DivergencePolicy
 -> RulePatch
 -> MountConfig)
-> Parser (Maybe Bool)
-> Parser
     (Maybe RegistryUrl
      -> RegistryUrl
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> Maybe Natural
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"enabled"
        Parser
  (Maybe RegistryUrl
   -> RegistryUrl
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> Maybe Natural
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser (Maybe RegistryUrl)
-> Parser
     (RegistryUrl
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> Maybe Natural
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"privateUpstream" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe RegistryUrl))
-> Parser (Maybe RegistryUrl)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser RegistryUrl)
-> Maybe Value -> Parser (Maybe RegistryUrl)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser RegistryUrl
parseRegistryUrl)
        Parser
  (RegistryUrl
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> Maybe Natural
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser RegistryUrl
-> Parser
     (Maybe RegistryUrl
      -> Maybe Secret
      -> Maybe Natural
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"publicUpstream" Parser Value -> (Value -> Parser RegistryUrl) -> Parser RegistryUrl
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser RegistryUrl
parseRegistryUrl)
        Parser
  (Maybe RegistryUrl
   -> Maybe Secret
   -> Maybe Natural
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser (Maybe RegistryUrl)
-> Parser
     (Maybe Secret
      -> Maybe Natural
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"mirrorTarget" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe RegistryUrl))
-> Parser (Maybe RegistryUrl)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser RegistryUrl)
-> Maybe Value -> Parser (Maybe RegistryUrl)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser RegistryUrl
parseRegistryUrl)
        Parser
  (Maybe Secret
   -> Maybe Natural
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser (Maybe Secret)
-> Parser
     (Maybe Natural
      -> Maybe RegistryUrl
      -> Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"mirrorTargetToken" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Secret)) -> Parser (Maybe Secret)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Secret) -> Maybe Value -> Parser (Maybe Secret)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser Secret
parseSecret)
        Parser
  (Maybe Natural
   -> Maybe RegistryUrl
   -> Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser (Maybe Natural)
-> Parser
     (Maybe RegistryUrl
      -> Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"mirrorCodeArtifactTokenDuration" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Natural))
-> Parser (Maybe Natural)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Natural) -> Maybe Value -> Parser (Maybe Natural)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Value -> Parser Natural
parseCodeArtifactDuration String
"mirrorCodeArtifactTokenDuration"))
        Parser
  (Maybe RegistryUrl
   -> Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser (Maybe RegistryUrl)
-> Parser
     (Maybe Secret
      -> [Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"publicationTarget" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe RegistryUrl))
-> Parser (Maybe RegistryUrl)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser RegistryUrl)
-> Maybe Value -> Parser (Maybe RegistryUrl)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser RegistryUrl
parseRegistryUrl)
        Parser
  (Maybe Secret
   -> [Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser (Maybe Secret)
-> Parser
     ([Scope]
      -> Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy
      -> RulePatch
      -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"publicationTargetToken" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Secret)) -> Parser (Maybe Secret)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Secret) -> Maybe Value -> Parser (Maybe Secret)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser Secret
parseSecret)
        Parser
  ([Scope]
   -> Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy
   -> RulePatch
   -> MountConfig)
-> Parser [Scope]
-> Parser
     (Maybe MinTrustedIntegrity
      -> Maybe DivergencePolicy -> RulePatch -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"publishAllow" Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text -> Value
String Text
"" Parser Value -> (Value -> Parser [Scope]) -> Parser [Scope]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser [Scope]
parseScopes)
        Parser
  (Maybe MinTrustedIntegrity
   -> Maybe DivergencePolicy -> RulePatch -> MountConfig)
-> Parser (Maybe MinTrustedIntegrity)
-> Parser (Maybe DivergencePolicy -> RulePatch -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"minTrustedIntegrity" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe MinTrustedIntegrity))
-> Parser (Maybe MinTrustedIntegrity)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser MinTrustedIntegrity)
-> Maybe Value -> Parser (Maybe MinTrustedIntegrity)
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) -> Maybe a -> f (Maybe b)
traverse ((Text -> Either Text MinTrustedIntegrity)
-> String -> Value -> Parser MinTrustedIntegrity
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text MinTrustedIntegrity
parseMinTrustedIntegrity String
"minTrustedIntegrity"))
        Parser (Maybe DivergencePolicy -> RulePatch -> MountConfig)
-> Parser (Maybe DivergencePolicy)
-> Parser (RulePatch -> MountConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"divergencePolicy" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe DivergencePolicy))
-> Parser (Maybe DivergencePolicy)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser DivergencePolicy)
-> Maybe Value -> Parser (Maybe DivergencePolicy)
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) -> Maybe a -> f (Maybe b)
traverse ((Text -> Either Text DivergencePolicy)
-> String -> Value -> Parser DivergencePolicy
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text DivergencePolicy
parseDivergencePolicy String
"divergencePolicy"))
        Parser (RulePatch -> MountConfig)
-> Parser RulePatch -> Parser MountConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe RulePatch)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"rules" Parser (Maybe RulePatch) -> RulePatch -> Parser RulePatch
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text RuleEntry -> RulePatch
RulePatch Map Text RuleEntry
forall k a. Map k a
Map.empty

acceptedMountKeys :: [Key.Key]
acceptedMountKeys :: [Key]
acceptedMountKeys =
    [ Key
"enabled"
    , Key
"privateUpstream"
    , Key
"publicUpstream"
    , Key
"mirrorTarget"
    , Key
"mirrorTargetToken"
    , Key
"mirrorCodeArtifactTokenDuration"
    , Key
"publicationTarget"
    , Key
"publicationTargetToken"
    , Key
"publishAllow"
    , Key
"minTrustedIntegrity"
    , Key
"divergencePolicy"
    , Key
"rules"
    ]

parseScopes :: Value -> Parser [Scope]
parseScopes :: Value -> Parser [Scope]
parseScopes = String -> (Text -> Parser [Scope]) -> Value -> Parser [Scope]
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Scopes" ((Text -> Parser [Scope]) -> Value -> Parser [Scope])
-> (Text -> Parser [Scope]) -> Value -> Parser [Scope]
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    if Text -> Bool
T.null (Text -> Text
T.strip Text
t)
        then [Scope] -> Parser [Scope]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        else (Text -> Parser Scope) -> [Text] -> Parser [Scope]
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 -> Parser Scope
parseScopeEntry (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
t)

-- Reject a publishAllow segment that no conforming scope can equal (an empty
-- segment from a stray comma, or one bearing a wrong separator), so a typo fails
-- the load rather than seeding a dead allow-list that refuses every publish at
-- request time. Mirrors 'parseBlockedRangeEntry' for the sibling comma list.
parseScopeEntry :: Text -> Parser Scope
parseScopeEntry :: Text -> Parser Scope
parseScopeEntry Text
entry =
    let trimmed :: Text
trimmed = Text -> Text
T.strip Text
entry
        body :: Text
body = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
trimmed (Text -> Text -> Maybe Text
T.stripPrefix Text
"@" Text
trimmed)
     in if Text -> Bool
T.null Text
body Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
invalidScopeChar Text
body
            then String -> Parser Scope
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid scope in publishAllow: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
trimmed)
            else Scope -> Parser Scope
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Scope
mkScope Text
trimmed)
  where
    invalidScopeChar :: Char -> Bool
invalidScopeChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c

instance FromJSON AppConfig where
    parseJSON :: Value -> Parser AppConfig
parseJSON = String
-> (KeyMap Value -> Parser AppConfig) -> Value -> Parser AppConfig
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"AppConfig" KeyMap Value -> Parser AppConfig
appConfigParser

appConfigParser :: KeyMap.KeyMap Value -> Parser AppConfig
appConfigParser :: KeyMap Value -> Parser AppConfig
appConfigParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"document" [Key]
acceptedDocumentKeys KeyMap Value
o
    ServerSettings
-> QueueSettings
-> LimitsSettings
-> CacheSettings
-> IntegritySettings
-> EgressSettings
-> AdvisoriesSettings
-> RuntimeSettings
-> ObservabilitySettings
-> Map Ecosystem MountConfig
-> AppConfig
AppConfig
        (ServerSettings
 -> QueueSettings
 -> LimitsSettings
 -> CacheSettings
 -> IntegritySettings
 -> EgressSettings
 -> AdvisoriesSettings
 -> RuntimeSettings
 -> ObservabilitySettings
 -> Map Ecosystem MountConfig
 -> AppConfig)
-> Parser ServerSettings
-> Parser
     (QueueSettings
      -> LimitsSettings
      -> CacheSettings
      -> IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"server" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser ServerSettings) -> Parser ServerSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser ServerSettings
serverParser)
        Parser
  (QueueSettings
   -> LimitsSettings
   -> CacheSettings
   -> IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> Parser QueueSettings
-> Parser
     (LimitsSettings
      -> CacheSettings
      -> IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"queue" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser QueueSettings) -> Parser QueueSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser QueueSettings
queueParser)
        Parser
  (LimitsSettings
   -> CacheSettings
   -> IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> Parser LimitsSettings
-> Parser
     (CacheSettings
      -> IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"limits" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser LimitsSettings) -> Parser LimitsSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser LimitsSettings
limitsParser)
        Parser
  (CacheSettings
   -> IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> Parser CacheSettings
-> Parser
     (IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"cache" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser CacheSettings) -> Parser CacheSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser CacheSettings
cacheParser)
        Parser
  (IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> Parser IntegritySettings
-> Parser
     (EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"integrity" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser IntegritySettings)
-> Parser IntegritySettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser IntegritySettings
integrityParser)
        Parser
  (EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> Parser EgressSettings
-> Parser
     (AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"egress" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser EgressSettings) -> Parser EgressSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser EgressSettings
egressParser)
        Parser
  (AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> Parser AdvisoriesSettings
-> Parser
     (RuntimeSettings
      -> ObservabilitySettings -> Map Ecosystem MountConfig -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"advisories" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser AdvisoriesSettings)
-> Parser AdvisoriesSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser AdvisoriesSettings
advisoriesParser)
        Parser
  (RuntimeSettings
   -> ObservabilitySettings -> Map Ecosystem MountConfig -> AppConfig)
-> Parser RuntimeSettings
-> Parser
     (ObservabilitySettings -> Map Ecosystem MountConfig -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"runtime" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser RuntimeSettings)
-> Parser RuntimeSettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser RuntimeSettings
runtimeParser)
        Parser
  (ObservabilitySettings -> Map Ecosystem MountConfig -> AppConfig)
-> Parser ObservabilitySettings
-> Parser (Map Ecosystem MountConfig -> AppConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
"observability" KeyMap Value
o Parser (KeyMap Value)
-> (KeyMap Value -> Parser ObservabilitySettings)
-> Parser ObservabilitySettings
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser ObservabilitySettings
observabilityParser)
        Parser (Map Ecosystem MountConfig -> AppConfig)
-> Parser (Map Ecosystem MountConfig) -> Parser AppConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe (KeyMap Value))
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"mounts" Parser (Maybe (KeyMap Value))
-> KeyMap Value -> Parser (KeyMap Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= KeyMap Value
forall a. Monoid a => a
mempty Parser (KeyMap Value)
-> (KeyMap Value -> Parser (Map Ecosystem MountConfig))
-> Parser (Map Ecosystem MountConfig)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyMap Value -> Parser (Map Ecosystem MountConfig)
parseMounts)

-- An absent group reads as empty (its required keys, pinned in the embedded
-- defaults, are then reported missing by its own parser).
groupOf :: Key.Key -> KeyMap.KeyMap Value -> Parser (KeyMap.KeyMap Value)
groupOf :: Key -> KeyMap Value -> Parser (KeyMap Value)
groupOf Key
key KeyMap Value
o = case Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
key KeyMap Value
o of
    Maybe Value
Nothing -> KeyMap Value -> Parser (KeyMap Value)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
forall v. KeyMap v
KeyMap.empty
    Just Value
v -> case Value
v of
        Object KeyMap Value
g -> KeyMap Value -> Parser (KeyMap Value)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
g
        Value
other -> String -> Parser (KeyMap Value)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Key -> String
Key.toString Key
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be an object, but encountered " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
valueKind Value
other)

serverParser :: KeyMap.KeyMap Value -> Parser ServerSettings
serverParser :: KeyMap Value -> Parser ServerSettings
serverParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"server" [Key
"port", Key
"publicUrl", Key
"authToken", Key
"helpMessage", Key
"shutdownDrainTimeout"] KeyMap Value
o
    Int
-> Maybe Url -> Maybe Secret -> Maybe Text -> Int -> ServerSettings
ServerSettings
        (Int
 -> Maybe Url
 -> Maybe Secret
 -> Maybe Text
 -> Int
 -> ServerSettings)
-> Parser Int
-> Parser
     (Maybe Url -> Maybe Secret -> Maybe Text -> Int -> ServerSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"port" Parser Int -> (Int -> Parser Int) -> Parser Int
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser Int
parsePort String
"server.port")
        Parser
  (Maybe Url -> Maybe Secret -> Maybe Text -> Int -> ServerSettings)
-> Parser (Maybe Url)
-> Parser (Maybe Secret -> Maybe Text -> Int -> ServerSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"publicUrl" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Url)) -> Parser (Maybe Url)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Url) -> Maybe Value -> Parser (Maybe Url)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Value -> Parser Url
parseHttpUrl String
"server.publicUrl"))
        Parser (Maybe Secret -> Maybe Text -> Int -> ServerSettings)
-> Parser (Maybe Secret)
-> Parser (Maybe Text -> Int -> ServerSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"authToken" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Secret)) -> Parser (Maybe Secret)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Secret) -> Maybe Value -> Parser (Maybe Secret)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser Secret
parseSecret)
        Parser (Maybe Text -> Int -> ServerSettings)
-> Parser (Maybe Text) -> Parser (Int -> ServerSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"helpMessage"
        Parser (Int -> ServerSettings)
-> Parser Int -> Parser ServerSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"shutdownDrainTimeout" Parser Int -> (Int -> Parser Int) -> Parser Int
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser Int
parsePositiveInt String
"server.shutdownDrainTimeout")

queueParser :: KeyMap.KeyMap Value -> Parser QueueSettings
queueParser :: KeyMap Value -> Parser QueueSettings
queueParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"queue" [Key
"url", Key
"memoryMaxDepth"] KeyMap Value
o
    Maybe Url -> Maybe Int -> QueueSettings
QueueSettings
        (Maybe Url -> Maybe Int -> QueueSettings)
-> Parser (Maybe Url) -> Parser (Maybe Int -> QueueSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"url" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Url)) -> Parser (Maybe Url)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Url) -> Maybe Value -> Parser (Maybe Url)
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) -> Maybe a -> f (Maybe b)
traverse Value -> Parser Url
parseUrl)
        Parser (Maybe Int -> QueueSettings)
-> Parser (Maybe Int) -> Parser QueueSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"memoryMaxDepth" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"queue.memoryMaxDepth"))

limitsParser :: KeyMap.KeyMap Value -> Parser LimitsSettings
limitsParser :: KeyMap Value -> Parser LimitsSettings
limitsParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"limits" [Key
"maxResponseBytes", Key
"maxVersionCount", Key
"maxNestingDepth", Key
"maxRequestBytes", Key
"maxArtifactBytes"] KeyMap Value
o
    Maybe Int -> Int -> Int -> Maybe Int -> Maybe Int -> LimitsSettings
LimitsSettings
        (Maybe Int
 -> Int -> Int -> Maybe Int -> Maybe Int -> LimitsSettings)
-> Parser (Maybe Int)
-> Parser (Int -> Int -> Maybe Int -> Maybe Int -> LimitsSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"maxResponseBytes" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"limits.maxResponseBytes"))
        Parser (Int -> Int -> Maybe Int -> Maybe Int -> LimitsSettings)
-> Parser Int
-> Parser (Int -> Maybe Int -> Maybe Int -> LimitsSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"maxVersionCount" Parser Int -> (Int -> Parser Int) -> Parser Int
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser Int
parsePositiveInt String
"limits.maxVersionCount")
        Parser (Int -> Maybe Int -> Maybe Int -> LimitsSettings)
-> Parser Int -> Parser (Maybe Int -> Maybe Int -> LimitsSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"maxNestingDepth" Parser Int -> (Int -> Parser Int) -> Parser Int
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser Int
parsePositiveInt String
"limits.maxNestingDepth")
        Parser (Maybe Int -> Maybe Int -> LimitsSettings)
-> Parser (Maybe Int) -> Parser (Maybe Int -> LimitsSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"maxRequestBytes" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"limits.maxRequestBytes"))
        Parser (Maybe Int -> LimitsSettings)
-> Parser (Maybe Int) -> Parser LimitsSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"maxArtifactBytes" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"limits.maxArtifactBytes"))

cacheParser :: KeyMap.KeyMap Value -> Parser CacheSettings
cacheParser :: KeyMap Value -> Parser CacheSettings
cacheParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"cache" [Key
"ttl", Key
"maxEntries", Key
"maxBytes"] KeyMap Value
o
    NominalDiffTime -> Maybe Int -> Maybe Int -> CacheSettings
CacheSettings
        (NominalDiffTime -> Maybe Int -> Maybe Int -> CacheSettings)
-> Parser NominalDiffTime
-> Parser (Maybe Int -> Maybe Int -> CacheSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"ttl" Parser Value
-> (Value -> Parser NominalDiffTime) -> Parser NominalDiffTime
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Value -> Parser NominalDiffTime
parseSeconds String
"cache.ttl")
        Parser (Maybe Int -> Maybe Int -> CacheSettings)
-> Parser (Maybe Int) -> Parser (Maybe Int -> CacheSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"maxEntries" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"cache.maxEntries"))
        Parser (Maybe Int -> CacheSettings)
-> Parser (Maybe Int) -> Parser CacheSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"maxBytes" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"cache.maxBytes"))

integrityParser :: KeyMap.KeyMap Value -> Parser IntegritySettings
integrityParser :: KeyMap Value -> Parser IntegritySettings
integrityParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"integrity" [Key
"minPublic", Key
"minTrusted", Key
"divergencePolicy"] KeyMap Value
o
    MinIntegrity
-> MinTrustedIntegrity -> DivergencePolicy -> IntegritySettings
IntegritySettings
        (MinIntegrity
 -> MinTrustedIntegrity -> DivergencePolicy -> IntegritySettings)
-> Parser MinIntegrity
-> Parser
     (MinTrustedIntegrity -> DivergencePolicy -> IntegritySettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"minPublic" Parser Value
-> (Value -> Parser MinIntegrity) -> Parser MinIntegrity
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either Text MinIntegrity)
-> String -> Value -> Parser MinIntegrity
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text MinIntegrity
parseMinIntegrity String
"integrity.minPublic")
        Parser
  (MinTrustedIntegrity -> DivergencePolicy -> IntegritySettings)
-> Parser MinTrustedIntegrity
-> Parser (DivergencePolicy -> IntegritySettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"minTrusted" Parser Value
-> (Value -> Parser MinTrustedIntegrity)
-> Parser MinTrustedIntegrity
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either Text MinTrustedIntegrity)
-> String -> Value -> Parser MinTrustedIntegrity
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text MinTrustedIntegrity
parseMinTrustedIntegrity String
"integrity.minTrusted")
        Parser (DivergencePolicy -> IntegritySettings)
-> Parser DivergencePolicy -> Parser IntegritySettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"divergencePolicy" Parser Value
-> (Value -> Parser DivergencePolicy) -> Parser DivergencePolicy
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either Text DivergencePolicy)
-> String -> Value -> Parser DivergencePolicy
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text DivergencePolicy
parseDivergencePolicy String
"integrity.divergencePolicy")

egressParser :: KeyMap.KeyMap Value -> Parser EgressSettings
egressParser :: KeyMap Value -> Parser EgressSettings
egressParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"egress" [Key
"additionalBlockedRanges"] KeyMap Value
o
    [IPRange] -> EgressSettings
EgressSettings
        ([IPRange] -> EgressSettings)
-> Parser [IPRange] -> Parser EgressSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"additionalBlockedRanges" Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text -> Value
String Text
"" Parser Value -> (Value -> Parser [IPRange]) -> Parser [IPRange]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser [IPRange]
parseAdditionalBlockedRanges)

advisoriesParser :: KeyMap.KeyMap Value -> Parser AdvisoriesSettings
advisoriesParser :: KeyMap Value -> Parser AdvisoriesSettings
advisoriesParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"advisories" [Key
"bucket", Key
"pollInterval", Key
"compileInterval", Key
"dataDir", Key
"osvExportBaseUrl", Key
"maxDatabaseBytes"] KeyMap Value
o
    Maybe Text
-> NominalDiffTime
-> NominalDiffTime
-> String
-> Text
-> Int
-> AdvisoriesSettings
AdvisoriesSettings
        (Maybe Text
 -> NominalDiffTime
 -> NominalDiffTime
 -> String
 -> Text
 -> Int
 -> AdvisoriesSettings)
-> Parser (Maybe Text)
-> Parser
     (NominalDiffTime
      -> NominalDiffTime -> String -> Text -> Int -> AdvisoriesSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"bucket"
        Parser
  (NominalDiffTime
   -> NominalDiffTime -> String -> Text -> Int -> AdvisoriesSettings)
-> Parser NominalDiffTime
-> Parser
     (NominalDiffTime -> String -> Text -> Int -> AdvisoriesSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"pollInterval" Parser Value
-> (Value -> Parser NominalDiffTime) -> Parser NominalDiffTime
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Value -> Parser NominalDiffTime
parseDelaySeconds String
"advisories.pollInterval")
        Parser
  (NominalDiffTime -> String -> Text -> Int -> AdvisoriesSettings)
-> Parser NominalDiffTime
-> Parser (String -> Text -> Int -> AdvisoriesSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"compileInterval" Parser Value
-> (Value -> Parser NominalDiffTime) -> Parser NominalDiffTime
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Value -> Parser NominalDiffTime
parseDelaySeconds String
"advisories.compileInterval")
        Parser (String -> Text -> Int -> AdvisoriesSettings)
-> Parser String -> Parser (Text -> Int -> AdvisoriesSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"dataDir"
        Parser (Text -> Int -> AdvisoriesSettings)
-> Parser Text -> Parser (Int -> AdvisoriesSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"osvExportBaseUrl"
        Parser (Int -> AdvisoriesSettings)
-> Parser Int -> Parser AdvisoriesSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"maxDatabaseBytes" Parser Int -> (Int -> Parser Int) -> Parser Int
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser Int
parsePositiveInt String
"advisories.maxDatabaseBytes")

runtimeParser :: KeyMap.KeyMap Value -> Parser RuntimeSettings
runtimeParser :: KeyMap Value -> Parser RuntimeSettings
runtimeParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"runtime" [Key
"cores", Key
"maxHeapBytes", Key
"serveMaxInFlight", Key
"publicConnectionsPerHost", Key
"privateConnectionsPerHost"] KeyMap Value
o
    Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> RuntimeSettings
RuntimeSettings
        (Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> RuntimeSettings)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"cores" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"runtime.cores"))
        Parser
  (Maybe Int
   -> Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"maxHeapBytes" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"runtime.maxHeapBytes"))
        Parser (Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> RuntimeSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"serveMaxInFlight" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"runtime.serveMaxInFlight"))
        Parser (Maybe Int -> Maybe Int -> RuntimeSettings)
-> Parser (Maybe Int) -> Parser (Maybe Int -> RuntimeSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"publicConnectionsPerHost" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"runtime.publicConnectionsPerHost"))
        Parser (Maybe Int -> RuntimeSettings)
-> Parser (Maybe Int) -> Parser RuntimeSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"privateConnectionsPerHost" Parser (Maybe Int)
-> (Maybe Int -> Parser (Maybe Int)) -> Parser (Maybe Int)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser Int) -> Maybe Int -> Parser (Maybe Int)
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) -> Maybe a -> f (Maybe b)
traverse (String -> Int -> Parser Int
parsePositiveInt String
"runtime.privateConnectionsPerHost"))

observabilityParser :: KeyMap.KeyMap Value -> Parser ObservabilitySettings
observabilityParser :: KeyMap Value -> Parser ObservabilitySettings
observabilityParser KeyMap Value
o = do
    String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"observability" [Key
"logFormat", Key
"telemetry"] KeyMap Value
o
    LogFormat -> TelemetrySwitch -> ObservabilitySettings
ObservabilitySettings
        (LogFormat -> TelemetrySwitch -> ObservabilitySettings)
-> Parser LogFormat
-> Parser (TelemetrySwitch -> ObservabilitySettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"logFormat" Parser Value -> (Value -> Parser LogFormat) -> Parser LogFormat
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either Text LogFormat)
-> String -> Value -> Parser LogFormat
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text LogFormat
parseLogFormat String
"observability.logFormat")
        Parser (TelemetrySwitch -> ObservabilitySettings)
-> Parser TelemetrySwitch -> Parser ObservabilitySettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap Value
o KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"telemetry" Parser Value
-> (Value -> Parser TelemetrySwitch) -> Parser TelemetrySwitch
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either Text TelemetrySwitch)
-> String -> Value -> Parser TelemetrySwitch
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text TelemetrySwitch
parseTelemetrySwitch String
"observability.telemetry")

acceptedDocumentKeys :: [Key.Key]
acceptedDocumentKeys :: [Key]
acceptedDocumentKeys =
    [ Key
"server"
    , Key
"queue"
    , Key
"limits"
    , Key
"cache"
    , Key
"integrity"
    , Key
"egress"
    , Key
"advisories"
    , Key
"runtime"
    , Key
"observability"
    , Key
"mounts"
    , Key
"rules"
    ]

{- | Parse every mount in the merged @mounts@ object, the shipped per-ecosystem
templates included. Which of them are /active/ (operator-declared, served, and
required to be complete) is decided against the operator overlay in
"Ecluse.Config"; this parser stays a faithful projection of the merged document.
-}
parseMounts :: KeyMap.KeyMap Value -> Parser (Map.Map Ecosystem MountConfig)
parseMounts :: KeyMap Value -> Parser (Map Ecosystem MountConfig)
parseMounts KeyMap Value
km = [(Ecosystem, MountConfig)] -> Map Ecosystem MountConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Ecosystem, MountConfig)] -> Map Ecosystem MountConfig)
-> Parser [(Ecosystem, MountConfig)]
-> Parser (Map Ecosystem MountConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Parser (Ecosystem, MountConfig))
-> [(Key, Value)] -> Parser [(Ecosystem, MountConfig)]
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 (Key, Value) -> Parser (Ecosystem, MountConfig)
parseMountEntry (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList KeyMap Value
km)

parseMountEntry :: (Key.Key, Value) -> Parser (Ecosystem, MountConfig)
parseMountEntry :: (Key, Value) -> Parser (Ecosystem, MountConfig)
parseMountEntry (Key
k, Value
v) = do
    eco <- case Text -> Maybe Ecosystem
parseEcosystem (Key -> Text
Key.toText Key
k) of
        Just Ecosystem
e -> Ecosystem -> Parser Ecosystem
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ecosystem
e
        Maybe Ecosystem
Nothing -> String -> Parser Ecosystem
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid ecosystem: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Key -> Text
Key.toText Key
k))
    mcfg <- parseJSON v
    pure (eco, mcfg)

parseSecret :: Value -> Parser Secret
parseSecret :: Value -> Parser Secret
parseSecret = String -> (Text -> Parser Secret) -> Value -> Parser Secret
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Secret" (Secret -> Parser Secret
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Secret -> Parser Secret)
-> (Text -> Secret) -> Text -> Parser Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Secret
mkSecret)

parseAdditionalBlockedRanges :: Value -> Parser [IPRange]
parseAdditionalBlockedRanges :: Value -> Parser [IPRange]
parseAdditionalBlockedRanges = String -> (Text -> Parser [IPRange]) -> Value -> Parser [IPRange]
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"IPRange list" ((Text -> Parser [IPRange]) -> Value -> Parser [IPRange])
-> (Text -> Parser [IPRange]) -> Value -> Parser [IPRange]
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    if Text -> Bool
T.null (Text -> Text
T.strip Text
t)
        then [IPRange] -> Parser [IPRange]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        else (Text -> Parser IPRange) -> [Text] -> Parser [IPRange]
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 -> Parser IPRange
parseBlockedRangeEntry (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
t)

parseBlockedRangeEntry :: Text -> Parser IPRange
parseBlockedRangeEntry :: Text -> Parser IPRange
parseBlockedRangeEntry Text
entry =
    let trimmed :: Text
trimmed = Text -> Text
T.strip Text
entry
     in case Text -> Maybe IPRange
parseBlockedRange Text
trimmed of
            Just IPRange
range -> IPRange -> Parser IPRange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPRange
range
            Maybe IPRange
Nothing -> String -> Parser IPRange
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid CIDR range in additionalBlockedRanges: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
trimmed)

parseSeconds :: String -> Value -> Parser NominalDiffTime
parseSeconds :: String -> Value -> Parser NominalDiffTime
parseSeconds String
field = \case
    String Text
t -> case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) :: Maybe Integer of
        Just Integer
n -> String -> Integer -> Parser NominalDiffTime
boundedSeconds String
field Integer
n
        Maybe Integer
Nothing -> String -> String -> Parser NominalDiffTime
forall a. String -> String -> Parser a
secondsFailure String
field (Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
t)
    -- 'toBoundedInteger' refuses a fractional or out-of-'Int64'-range value, and
    -- its exponent guard rejects a pathological 1e999999999999 without ever
    -- realising the integer, so a hostile config or env value fails the load
    -- instead of hanging or exhausting memory at boot.
    Number Scientific
n -> case Scientific -> Maybe Int64
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
n :: Maybe Int64 of
        Just Int64
val -> String -> Integer -> Parser NominalDiffTime
boundedSeconds String
field (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
val)
        Maybe Int64
Nothing -> String -> String -> Parser NominalDiffTime
forall a. String -> String -> Parser a
secondsFailure String
field (Scientific -> String
forall b a. (Show a, IsString b) => a -> b
show Scientific
n)
    Value
other -> String -> Parser NominalDiffTime
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
field String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be a non-negative integer count of seconds, but encountered a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
valueKind Value
other)

boundedSeconds :: String -> Integer -> Parser NominalDiffTime
boundedSeconds :: String -> Integer -> Parser NominalDiffTime
boundedSeconds String
field Integer
n
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64) = NominalDiffTime -> Parser NominalDiffTime
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger Integer
n)
    | Bool
otherwise = String -> String -> Parser NominalDiffTime
forall a. String -> String -> Parser a
secondsFailure String
field (Integer -> String
forall b a. (Show a, IsString b) => a -> b
show Integer
n)

secondsFailure :: String -> String -> Parser a
secondsFailure :: forall a. String -> String -> Parser a
secondsFailure String
field String
got =
    String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
field String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be a non-negative integer count of seconds, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
got)

parsePositiveInt :: String -> Int -> Parser Int
parsePositiveInt :: String -> Int -> Parser Int
parsePositiveInt String
field Int
value
    | Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Parser Int
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
value
    | Bool
otherwise = String -> Parser Int
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
field String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must be a positive integer")

{- A recurring delay: positive (zero would spin the poll without
yielding) and bounded so its microsecond conversion fits 'Int'
rather than wrapping into an invalid negative delay.
-}
parseDelaySeconds :: String -> Value -> Parser NominalDiffTime
parseDelaySeconds :: String -> Value -> Parser NominalDiffTime
parseDelaySeconds String
field Value
v = do
    secs <- String -> Value -> Parser NominalDiffTime
parseSeconds String
field Value
v
    let n = NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate NominalDiffTime
secs :: Integer
        maxDelay = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1_000_000
    if n >= 1 && n <= maxDelay
        then pure secs
        else fail (field <> " must be a positive integer count of seconds, at most " <> show maxDelay)

instance FromJSON RulePatch where
    parseJSON :: Value -> Parser RulePatch
parseJSON = String
-> (KeyMap Value -> Parser RulePatch) -> Value -> Parser RulePatch
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"rules" ((KeyMap Value -> Parser RulePatch) -> Value -> Parser RulePatch)
-> (KeyMap Value -> Parser RulePatch) -> Value -> Parser RulePatch
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o ->
        Map Text RuleEntry -> RulePatch
RulePatch (Map Text RuleEntry -> RulePatch)
-> ([(Text, RuleEntry)] -> Map Text RuleEntry)
-> [(Text, RuleEntry)]
-> RulePatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, RuleEntry)] -> Map Text RuleEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, RuleEntry)] -> RulePatch)
-> Parser [(Text, RuleEntry)] -> Parser RulePatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Parser (Text, RuleEntry))
-> [(Key, Value)] -> Parser [(Text, RuleEntry)]
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 (Key, Value) -> Parser (Text, RuleEntry)
forall {a}. FromJSON a => (Key, Value) -> Parser (Text, a)
decodeEntry (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList KeyMap Value
o)
      where
        decodeEntry :: (Key, Value) -> Parser (Text, a)
decodeEntry (Key
k, Value
v) = (Key -> Text
Key.toText Key
k,) (a -> (Text, a)) -> Parser a -> Parser (Text, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance FromJSON RuleEntry where
    parseJSON :: Value -> Parser RuleEntry
parseJSON = String
-> (KeyMap Value -> Parser RuleEntry) -> Value -> Parser RuleEntry
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"rule" ((KeyMap Value -> Parser RuleEntry) -> Value -> Parser RuleEntry)
-> (KeyMap Value -> Parser RuleEntry) -> Value -> Parser RuleEntry
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
        KeyMap Value -> Parser ()
rejectSecretKeys KeyMap Value
o
        String -> [Key] -> KeyMap Value -> Parser ()
rejectUnknownKeys String
"rule" [Key
"type", Key
"precedence", Key
"enabled", Key
"ageSeconds", Key
"scope", Key
"identity", Key
"minSeverity", Key
"onUnavailable"] KeyMap Value
o
        Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe Text
-> RuleEntry
RuleEntry
            (Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Double
 -> Maybe Text
 -> RuleEntry)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"type"
            Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Int)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"precedence"
            Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"enabled"
            Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Double -> Maybe Text -> RuleEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"ageSeconds"
            Parser
  (Maybe Text
   -> Maybe Text -> Maybe Double -> Maybe Text -> RuleEntry)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Double -> Maybe Text -> RuleEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"scope"
            Parser (Maybe Text -> Maybe Double -> Maybe Text -> RuleEntry)
-> Parser (Maybe Text)
-> Parser (Maybe Double -> Maybe Text -> RuleEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"identity"
            Parser (Maybe Double -> Maybe Text -> RuleEntry)
-> Parser (Maybe Double) -> Parser (Maybe Text -> RuleEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Double)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"minSeverity"
            Parser (Maybe Text -> RuleEntry)
-> Parser (Maybe Text) -> Parser RuleEntry
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"onUnavailable"