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

{- | The document decoders: one 'GroupDecoder' per configuration group, assembled from
"Ecluse.Config.Parser"'s key vocabulary, plus the @FromJSON@ instances that run them.

The instances are orphans because the types live in "Ecluse.Config.Types", which carries no Aeson
dependency. A group's decoder declares every key the group admits, so an unknown key refuses.
-}
module Ecluse.Config.Aeson () where

import Data.Aeson (FromJSON (..), Value (..), withObject)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser)
import Data.IP (IPRange)
import Data.Map.Strict qualified as Map
import Data.Scientific (Scientific, base10Exponent, 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 (..), ecosystemName, parseEcosystem)
import Ecluse.Core.Package (Scope)
import Ecluse.Core.Package.Integrity (parseMinIntegrity, parseMinTrustedIntegrity)
import Ecluse.Core.Registry.Maintenance.Budget (parseQuotaDimension, parseRequestKind)
import Ecluse.Core.Registry.Npm.Project (projectScope)
import Ecluse.Core.Registry.PyPI.FirstParty (PyPIFirstParty, projectFirstPartyEntry)
import Ecluse.Core.Security (parseBlockedRange)
import Ecluse.Core.Security.Egress (RegistryUrl)
import Ecluse.Core.Text (readDecimalText)
import Ecluse.Runtime.Log (parseLogFormat, parseLogLevel)
import Ecluse.Runtime.Telemetry (parseTelemetrySwitch)

-- A mount's refusals name the bare key, because "Ecluse.Config" reports the mount around them.
-- The ecosystem comes from the mounts key, so a per-ecosystem value reads in its own shape.
mountDecoder :: Ecosystem -> GroupDecoder MountConfig
mountDecoder :: Ecosystem -> GroupDecoder MountConfig
mountDecoder Ecosystem
eco =
    Maybe Bool
-> Maybe PrivateEndpoint
-> RegistryUrl
-> Maybe MirrorEndpoint
-> Maybe PublicationEndpoint
-> Maybe FirstParty
-> MountIntegrity
-> RulePatch
-> MountConfig
MountConfig
        (Maybe Bool
 -> Maybe PrivateEndpoint
 -> RegistryUrl
 -> Maybe MirrorEndpoint
 -> Maybe PublicationEndpoint
 -> Maybe FirstParty
 -> MountIntegrity
 -> RulePatch
 -> MountConfig)
-> GroupDecoder (Maybe Bool)
-> GroupDecoder
     (Maybe PrivateEndpoint
      -> RegistryUrl
      -> Maybe MirrorEndpoint
      -> Maybe PublicationEndpoint
      -> Maybe FirstParty
      -> MountIntegrity
      -> RulePatch
      -> MountConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> GroupDecoder (Maybe Bool)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"enabled"
        GroupDecoder
  (Maybe PrivateEndpoint
   -> RegistryUrl
   -> Maybe MirrorEndpoint
   -> Maybe PublicationEndpoint
   -> Maybe FirstParty
   -> MountIntegrity
   -> RulePatch
   -> MountConfig)
-> GroupDecoder (Maybe PrivateEndpoint)
-> GroupDecoder
     (RegistryUrl
      -> Maybe MirrorEndpoint
      -> Maybe PublicationEndpoint
      -> Maybe FirstParty
      -> MountIntegrity
      -> RulePatch
      -> MountConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser PrivateEndpoint)
-> GroupDecoder (Maybe PrivateEndpoint)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"privateUpstream" String -> Value -> Parser PrivateEndpoint
parseReadTarget
        GroupDecoder
  (RegistryUrl
   -> Maybe MirrorEndpoint
   -> Maybe PublicationEndpoint
   -> Maybe FirstParty
   -> MountIntegrity
   -> RulePatch
   -> MountConfig)
-> GroupDecoder RegistryUrl
-> GroupDecoder
     (Maybe MirrorEndpoint
      -> Maybe PublicationEndpoint
      -> Maybe FirstParty
      -> MountIntegrity
      -> RulePatch
      -> MountConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser RegistryUrl)
-> GroupDecoder RegistryUrl
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"publicUpstream" String -> Value -> Parser RegistryUrl
parsePublicUpstream
        GroupDecoder
  (Maybe MirrorEndpoint
   -> Maybe PublicationEndpoint
   -> Maybe FirstParty
   -> MountIntegrity
   -> RulePatch
   -> MountConfig)
-> GroupDecoder (Maybe MirrorEndpoint)
-> GroupDecoder
     (Maybe PublicationEndpoint
      -> Maybe FirstParty -> MountIntegrity -> RulePatch -> MountConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser MirrorEndpoint)
-> GroupDecoder (Maybe MirrorEndpoint)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"mirrorTarget" String -> Value -> Parser MirrorEndpoint
parseMirrorTarget
        GroupDecoder
  (Maybe PublicationEndpoint
   -> Maybe FirstParty -> MountIntegrity -> RulePatch -> MountConfig)
-> GroupDecoder (Maybe PublicationEndpoint)
-> GroupDecoder
     (Maybe FirstParty -> MountIntegrity -> RulePatch -> MountConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser PublicationEndpoint)
-> GroupDecoder (Maybe PublicationEndpoint)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"publicationTarget" String -> Value -> Parser PublicationEndpoint
parsePublicationTarget
        GroupDecoder
  (Maybe FirstParty -> MountIntegrity -> RulePatch -> MountConfig)
-> GroupDecoder (Maybe FirstParty)
-> GroupDecoder (MountIntegrity -> RulePatch -> MountConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser FirstParty)
-> GroupDecoder (Maybe FirstParty)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"firstParty" (Ecosystem -> String -> Value -> Parser FirstParty
parseFirstParty Ecosystem
eco)
        GroupDecoder (MountIntegrity -> RulePatch -> MountConfig)
-> GroupDecoder MountIntegrity
-> GroupDecoder (RulePatch -> MountConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser MountIntegrity)
-> GroupDecoder MountIntegrity
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"integrity" (String
-> GroupDecoder MountIntegrity
-> KeyMap Value
-> Parser MountIntegrity
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"integrity" GroupDecoder MountIntegrity
mountIntegrityDecoder)
        GroupDecoder (RulePatch -> MountConfig)
-> GroupDecoder RulePatch -> GroupDecoder MountConfig
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> RulePatch -> GroupDecoder RulePatch
forall a. FromJSON a => Key -> a -> GroupDecoder a
optionalPlainKeyOr Key
"rules" (Map Text RuleEntry -> RulePatch
RulePatch Map Text RuleEntry
forall k a. Map k a
Map.empty)

-- Each endpoint admits exactly the tags and keys its cell of the store admission matrix names,
-- so a shape outside the cell has nothing to parse into and refuses with the key path.
parsePublicUpstream :: String -> Value -> Parser RegistryUrl
parsePublicUpstream :: String -> Value -> Parser RegistryUrl
parsePublicUpstream = [TagCase RegistryUrl] -> String -> Value -> Parser RegistryUrl
forall a. [TagCase a] -> String -> Value -> Parser a
taggedTarget [Key -> GroupDecoder RegistryUrl -> TagCase RegistryUrl
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
TagRegistry) GroupDecoder RegistryUrl
targetUrl]

parseReadTarget :: String -> Value -> Parser PrivateEndpoint
parseReadTarget :: String -> Value -> Parser PrivateEndpoint
parseReadTarget = [TagCase PrivateEndpoint]
-> String -> Value -> Parser PrivateEndpoint
forall a. [TagCase a] -> String -> Value -> Parser a
taggedTarget [StoreTag -> TagCase PrivateEndpoint
readCase StoreTag
TagRegistry, StoreTag -> TagCase PrivateEndpoint
readCase StoreTag
TagCodeArtifact, TagCase PrivateEndpoint
verdaccio]
  where
    readCase :: StoreTag -> TagCase PrivateEndpoint
readCase StoreTag
tag = Key -> GroupDecoder PrivateEndpoint -> TagCase PrivateEndpoint
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
tag) (Target -> Maybe Secret -> DeletionConsent -> PrivateEndpoint
PrivateEndpoint (Target -> Maybe Secret -> DeletionConsent -> PrivateEndpoint)
-> (RegistryUrl -> Target)
-> RegistryUrl
-> Maybe Secret
-> DeletionConsent
-> PrivateEndpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreTag -> RegistryUrl -> Target
Target StoreTag
tag (RegistryUrl -> Maybe Secret -> DeletionConsent -> PrivateEndpoint)
-> GroupDecoder RegistryUrl
-> GroupDecoder
     (Maybe Secret -> DeletionConsent -> PrivateEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder RegistryUrl
targetUrl GroupDecoder (Maybe Secret -> DeletionConsent -> PrivateEndpoint)
-> GroupDecoder (Maybe Secret)
-> GroupDecoder (DeletionConsent -> PrivateEndpoint)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Secret -> GroupDecoder (Maybe Secret)
forall a. a -> GroupDecoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Secret
forall a. Maybe a
Nothing GroupDecoder (DeletionConsent -> PrivateEndpoint)
-> GroupDecoder DeletionConsent -> GroupDecoder PrivateEndpoint
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DeletionConsent -> GroupDecoder DeletionConsent
forall a. a -> GroupDecoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeletionConsent
DeletionWithheld)
    verdaccio :: TagCase PrivateEndpoint
verdaccio = Key -> GroupDecoder PrivateEndpoint -> TagCase PrivateEndpoint
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
TagVerdaccio) (Target -> Maybe Secret -> DeletionConsent -> PrivateEndpoint
PrivateEndpoint (Target -> Maybe Secret -> DeletionConsent -> PrivateEndpoint)
-> (RegistryUrl -> Target)
-> RegistryUrl
-> Maybe Secret
-> DeletionConsent
-> PrivateEndpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreTag -> RegistryUrl -> Target
Target StoreTag
TagVerdaccio (RegistryUrl -> Maybe Secret -> DeletionConsent -> PrivateEndpoint)
-> GroupDecoder RegistryUrl
-> GroupDecoder
     (Maybe Secret -> DeletionConsent -> PrivateEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder RegistryUrl
targetUrl GroupDecoder (Maybe Secret -> DeletionConsent -> PrivateEndpoint)
-> GroupDecoder (Maybe Secret)
-> GroupDecoder (DeletionConsent -> PrivateEndpoint)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser Secret)
-> GroupDecoder (Maybe Secret)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"token" String -> Value -> Parser Secret
parseSecret GroupDecoder (DeletionConsent -> PrivateEndpoint)
-> GroupDecoder DeletionConsent -> GroupDecoder PrivateEndpoint
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GroupDecoder DeletionConsent
deletionConsent)

parseMirrorTarget :: String -> Value -> Parser MirrorEndpoint
parseMirrorTarget :: String -> Value -> Parser MirrorEndpoint
parseMirrorTarget =
    [TagCase MirrorEndpoint]
-> String -> Value -> Parser MirrorEndpoint
forall a. [TagCase a] -> String -> Value -> Parser a
taggedTarget
        [ Key -> GroupDecoder MirrorEndpoint -> TagCase MirrorEndpoint
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
TagRegistry) (RegistryUrl -> MirrorWrite -> MirrorEndpoint
MirrorEndpoint (RegistryUrl -> MirrorWrite -> MirrorEndpoint)
-> GroupDecoder RegistryUrl
-> GroupDecoder (MirrorWrite -> MirrorEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder RegistryUrl
targetUrl GroupDecoder (MirrorWrite -> MirrorEndpoint)
-> GroupDecoder MirrorWrite -> GroupDecoder MirrorEndpoint
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Secret -> MirrorWrite
WriteRegistry (Secret -> MirrorWrite)
-> GroupDecoder Secret -> GroupDecoder MirrorWrite
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder Secret
writeToken))
        , Key -> GroupDecoder MirrorEndpoint -> TagCase MirrorEndpoint
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
TagCodeArtifact) (RegistryUrl -> MirrorWrite -> MirrorEndpoint
MirrorEndpoint (RegistryUrl -> MirrorWrite -> MirrorEndpoint)
-> GroupDecoder RegistryUrl
-> GroupDecoder (MirrorWrite -> MirrorEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder RegistryUrl
targetUrl GroupDecoder (MirrorWrite -> MirrorEndpoint)
-> GroupDecoder MirrorWrite -> GroupDecoder MirrorEndpoint
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> MirrorWrite
WriteCodeArtifact (Maybe Natural -> MirrorWrite)
-> GroupDecoder (Maybe Natural) -> GroupDecoder MirrorWrite
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder (Maybe Natural)
mintLifetime))
        , Key -> GroupDecoder MirrorEndpoint -> TagCase MirrorEndpoint
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
TagVerdaccio) (RegistryUrl -> MirrorWrite -> MirrorEndpoint
MirrorEndpoint (RegistryUrl -> MirrorWrite -> MirrorEndpoint)
-> GroupDecoder RegistryUrl
-> GroupDecoder (MirrorWrite -> MirrorEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder RegistryUrl
targetUrl GroupDecoder (MirrorWrite -> MirrorEndpoint)
-> GroupDecoder MirrorWrite -> GroupDecoder MirrorEndpoint
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Secret -> DeletionConsent -> MirrorWrite
WriteVerdaccio (Secret -> DeletionConsent -> MirrorWrite)
-> GroupDecoder Secret
-> GroupDecoder (DeletionConsent -> MirrorWrite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder Secret
writeToken GroupDecoder (DeletionConsent -> MirrorWrite)
-> GroupDecoder DeletionConsent -> GroupDecoder MirrorWrite
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GroupDecoder DeletionConsent
deletionConsent))
        ]
  where
    writeToken :: GroupDecoder Secret
writeToken = Key -> (String -> Value -> Parser Secret) -> GroupDecoder Secret
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"token" String -> Value -> Parser Secret
parseSecret
    mintLifetime :: GroupDecoder (Maybe Natural)
mintLifetime = Key
-> (String -> Value -> Parser Natural)
-> GroupDecoder (Maybe Natural)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"tokenDuration" String -> Value -> Parser Natural
parseCodeArtifactDuration

parsePublicationTarget :: String -> Value -> Parser PublicationEndpoint
parsePublicationTarget :: String -> Value -> Parser PublicationEndpoint
parsePublicationTarget = [TagCase PublicationEndpoint]
-> String -> Value -> Parser PublicationEndpoint
forall a. [TagCase a] -> String -> Value -> Parser a
taggedTarget ((StoreTag -> TagCase PublicationEndpoint)
-> [StoreTag] -> [TagCase PublicationEndpoint]
forall a b. (a -> b) -> [a] -> [b]
map StoreTag -> TagCase PublicationEndpoint
publishCase [StoreTag
TagRegistry, StoreTag
TagCodeArtifact, StoreTag
TagVerdaccio])
  where
    publishCase :: StoreTag -> TagCase PublicationEndpoint
publishCase StoreTag
tag =
        Key
-> GroupDecoder PublicationEndpoint -> TagCase PublicationEndpoint
forall a. Key -> GroupDecoder a -> TagCase a
TagCase (StoreTag -> Key
tagKey StoreTag
tag) (Target -> Maybe Secret -> PublicationEndpoint
PublicationEndpoint (Target -> Maybe Secret -> PublicationEndpoint)
-> (RegistryUrl -> Target)
-> RegistryUrl
-> Maybe Secret
-> PublicationEndpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreTag -> RegistryUrl -> Target
Target StoreTag
tag (RegistryUrl -> Maybe Secret -> PublicationEndpoint)
-> GroupDecoder RegistryUrl
-> GroupDecoder (Maybe Secret -> PublicationEndpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupDecoder RegistryUrl
targetUrl GroupDecoder (Maybe Secret -> PublicationEndpoint)
-> GroupDecoder (Maybe Secret) -> GroupDecoder PublicationEndpoint
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser Secret)
-> GroupDecoder (Maybe Secret)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"token" String -> Value -> Parser Secret
parseSecret)

-- The one key every tag admits, refined by the egress boundary's own constructor.
targetUrl :: GroupDecoder RegistryUrl
targetUrl :: GroupDecoder RegistryUrl
targetUrl = Key
-> (String -> Value -> Parser RegistryUrl)
-> GroupDecoder RegistryUrl
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"url" String -> Value -> Parser RegistryUrl
parseRegistryUrl

-- Unwritten, the Dredger holds no consent to delete from the store.
deletionConsent :: GroupDecoder DeletionConsent
deletionConsent :: GroupDecoder DeletionConsent
deletionConsent = Key
-> Bool
-> (String -> Bool -> Parser DeletionConsent)
-> GroupDecoder DeletionConsent
forall b a.
FromJSON b =>
Key -> b -> (String -> b -> Parser a) -> GroupDecoder a
optionalKeyOr Key
"permitDeletion" Bool
False ((Bool -> Parser DeletionConsent)
-> String -> Bool -> Parser DeletionConsent
forall a b. a -> b -> a
const (DeletionConsent -> Parser DeletionConsent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeletionConsent -> Parser DeletionConsent)
-> (Bool -> DeletionConsent) -> Bool -> Parser DeletionConsent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DeletionConsent
consentOf))
  where
    consentOf :: Bool -> DeletionConsent
consentOf Bool
granted = if Bool
granted then DeletionConsent
DeletionPermitted else DeletionConsent
DeletionWithheld

tagKey :: StoreTag -> Key.Key
tagKey :: StoreTag -> Key
tagKey = Text -> Key
Key.fromText (Text -> Key) -> (StoreTag -> Text) -> StoreTag -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreTag -> Text
storeTagName

-- An absent mount integrity object inherits the global trusted floor.
mountIntegrityDecoder :: GroupDecoder MountIntegrity
mountIntegrityDecoder :: GroupDecoder MountIntegrity
mountIntegrityDecoder =
    Maybe MinTrustedIntegrity -> MountIntegrity
MountIntegrity
        (Maybe MinTrustedIntegrity -> MountIntegrity)
-> GroupDecoder (Maybe MinTrustedIntegrity)
-> GroupDecoder MountIntegrity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser MinTrustedIntegrity)
-> GroupDecoder (Maybe MinTrustedIntegrity)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"minTrusted" ((Text -> Either Text MinTrustedIntegrity)
-> String -> Value -> Parser MinTrustedIntegrity
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text MinTrustedIntegrity
parseMinTrustedIntegrity)
        GroupDecoder MountIntegrity
-> GroupDecoder (Maybe ()) -> GroupDecoder MountIntegrity
forall a b. GroupDecoder a -> GroupDecoder b -> GroupDecoder a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Key -> (String -> Value -> Parser ()) -> GroupDecoder (Maybe ())
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"divergencePolicy" String -> Value -> Parser ()
parseLegacyDivergencePolicy

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" (String
-> GroupDecoder AppConfig -> KeyMap Value -> Parser AppConfig
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"document" GroupDecoder AppConfig
documentDecoder)

-- @rules@ is accepted here and read by "Ecluse.Config" out of the merged document, never
-- through this decoder.
documentDecoder :: GroupDecoder AppConfig
documentDecoder :: GroupDecoder AppConfig
documentDecoder =
    ServerSettings
-> QueueSettings
-> LimitsSettings
-> CacheSettings
-> IntegritySettings
-> EgressSettings
-> AdvisoriesSettings
-> RuntimeSettings
-> ObservabilitySettings
-> DredgerSettings
-> Map Ecosystem MountConfig
-> AppConfig
AppConfig
        (ServerSettings
 -> QueueSettings
 -> LimitsSettings
 -> CacheSettings
 -> IntegritySettings
 -> EgressSettings
 -> AdvisoriesSettings
 -> RuntimeSettings
 -> ObservabilitySettings
 -> DredgerSettings
 -> Map Ecosystem MountConfig
 -> AppConfig)
-> GroupDecoder ServerSettings
-> GroupDecoder
     (QueueSettings
      -> LimitsSettings
      -> CacheSettings
      -> IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (KeyMap Value -> Parser ServerSettings)
-> GroupDecoder ServerSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"server" (String
-> GroupDecoder ServerSettings
-> KeyMap Value
-> Parser ServerSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"server" GroupDecoder ServerSettings
serverDecoder)
        GroupDecoder
  (QueueSettings
   -> LimitsSettings
   -> CacheSettings
   -> IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder QueueSettings
-> GroupDecoder
     (LimitsSettings
      -> CacheSettings
      -> IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser QueueSettings)
-> GroupDecoder QueueSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"queue" (String
-> GroupDecoder QueueSettings
-> KeyMap Value
-> Parser QueueSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"queue" GroupDecoder QueueSettings
queueDecoder)
        GroupDecoder
  (LimitsSettings
   -> CacheSettings
   -> IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder LimitsSettings
-> GroupDecoder
     (CacheSettings
      -> IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser LimitsSettings)
-> GroupDecoder LimitsSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"limits" (String
-> GroupDecoder LimitsSettings
-> KeyMap Value
-> Parser LimitsSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"limits" GroupDecoder LimitsSettings
limitsDecoder)
        GroupDecoder
  (CacheSettings
   -> IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder CacheSettings
-> GroupDecoder
     (IntegritySettings
      -> EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser CacheSettings)
-> GroupDecoder CacheSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"cache" (String
-> GroupDecoder CacheSettings
-> KeyMap Value
-> Parser CacheSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"cache" GroupDecoder CacheSettings
cacheDecoder)
        GroupDecoder
  (IntegritySettings
   -> EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder IntegritySettings
-> GroupDecoder
     (EgressSettings
      -> AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser IntegritySettings)
-> GroupDecoder IntegritySettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"integrity" (String
-> GroupDecoder IntegritySettings
-> KeyMap Value
-> Parser IntegritySettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"integrity" GroupDecoder IntegritySettings
integrityDecoder)
        GroupDecoder
  (EgressSettings
   -> AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder EgressSettings
-> GroupDecoder
     (AdvisoriesSettings
      -> RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser EgressSettings)
-> GroupDecoder EgressSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"egress" (String
-> GroupDecoder EgressSettings
-> KeyMap Value
-> Parser EgressSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"egress" GroupDecoder EgressSettings
egressDecoder)
        GroupDecoder
  (AdvisoriesSettings
   -> RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder AdvisoriesSettings
-> GroupDecoder
     (RuntimeSettings
      -> ObservabilitySettings
      -> DredgerSettings
      -> Map Ecosystem MountConfig
      -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser AdvisoriesSettings)
-> GroupDecoder AdvisoriesSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"advisories" (String
-> GroupDecoder AdvisoriesSettings
-> KeyMap Value
-> Parser AdvisoriesSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"advisories" GroupDecoder AdvisoriesSettings
advisoriesDecoder)
        GroupDecoder
  (RuntimeSettings
   -> ObservabilitySettings
   -> DredgerSettings
   -> Map Ecosystem MountConfig
   -> AppConfig)
-> GroupDecoder RuntimeSettings
-> GroupDecoder
     (ObservabilitySettings
      -> DredgerSettings -> Map Ecosystem MountConfig -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser RuntimeSettings)
-> GroupDecoder RuntimeSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"runtime" (String
-> GroupDecoder RuntimeSettings
-> KeyMap Value
-> Parser RuntimeSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"runtime" GroupDecoder RuntimeSettings
runtimeDecoder)
        GroupDecoder
  (ObservabilitySettings
   -> DredgerSettings -> Map Ecosystem MountConfig -> AppConfig)
-> GroupDecoder ObservabilitySettings
-> GroupDecoder
     (DredgerSettings -> Map Ecosystem MountConfig -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser ObservabilitySettings)
-> GroupDecoder ObservabilitySettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"observability" (String
-> GroupDecoder ObservabilitySettings
-> KeyMap Value
-> Parser ObservabilitySettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"observability" GroupDecoder ObservabilitySettings
observabilityDecoder)
        GroupDecoder
  (DredgerSettings -> Map Ecosystem MountConfig -> AppConfig)
-> GroupDecoder DredgerSettings
-> GroupDecoder (Map Ecosystem MountConfig -> AppConfig)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser DredgerSettings)
-> GroupDecoder DredgerSettings
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"dredger" (String
-> GroupDecoder DredgerSettings
-> KeyMap Value
-> Parser DredgerSettings
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"dredger" GroupDecoder DredgerSettings
dredgerDecoder)
        GroupDecoder (Map Ecosystem MountConfig -> AppConfig)
-> GroupDecoder (Map Ecosystem MountConfig)
-> GroupDecoder AppConfig
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> KeyMap Value
-> (String -> KeyMap Value -> Parser (Map Ecosystem MountConfig))
-> GroupDecoder (Map Ecosystem MountConfig)
forall b a.
FromJSON b =>
Key -> b -> (String -> b -> Parser a) -> GroupDecoder a
optionalKeyOr Key
"mounts" KeyMap Value
forall a. Monoid a => a
mempty ((KeyMap Value -> Parser (Map Ecosystem MountConfig))
-> String -> KeyMap Value -> Parser (Map Ecosystem MountConfig)
forall a b. a -> b -> a
const KeyMap Value -> Parser (Map Ecosystem MountConfig)
parseMounts)
        GroupDecoder AppConfig -> GroupDecoder () -> GroupDecoder AppConfig
forall a b. GroupDecoder a -> GroupDecoder b -> GroupDecoder a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Key -> GroupDecoder ()
unreadKey Key
"rules"

serverDecoder :: GroupDecoder ServerSettings
serverDecoder :: GroupDecoder ServerSettings
serverDecoder =
    Int
-> Maybe Url -> Maybe Secret -> Maybe Text -> Int -> ServerSettings
ServerSettings
        (Int
 -> Maybe Url
 -> Maybe Secret
 -> Maybe Text
 -> Int
 -> ServerSettings)
-> GroupDecoder Int
-> GroupDecoder
     (Maybe Url -> Maybe Secret -> Maybe Text -> Int -> ServerSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"port" String -> Int -> Parser Int
parsePort
        GroupDecoder
  (Maybe Url -> Maybe Secret -> Maybe Text -> Int -> ServerSettings)
-> GroupDecoder (Maybe Url)
-> GroupDecoder
     (Maybe Secret -> Maybe Text -> Int -> ServerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Value -> Parser Url) -> GroupDecoder (Maybe Url)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"publicUrl" String -> Value -> Parser Url
parseHttpUrl
        GroupDecoder (Maybe Secret -> Maybe Text -> Int -> ServerSettings)
-> GroupDecoder (Maybe Secret)
-> GroupDecoder (Maybe Text -> Int -> ServerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser Secret)
-> GroupDecoder (Maybe Secret)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"authToken" String -> Value -> Parser Secret
parseSecret
        GroupDecoder (Maybe Text -> Int -> ServerSettings)
-> GroupDecoder (Maybe Text)
-> GroupDecoder (Int -> ServerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Text)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"helpMessage"
        GroupDecoder (Int -> ServerSettings)
-> GroupDecoder Int -> GroupDecoder ServerSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"shutdownDrainTimeout" String -> Int -> Parser Int
parsePositiveInt

queueDecoder :: GroupDecoder QueueSettings
queueDecoder :: GroupDecoder QueueSettings
queueDecoder =
    Maybe QueueUrl -> Maybe Int -> Int -> QueueSettings
QueueSettings
        (Maybe QueueUrl -> Maybe Int -> Int -> QueueSettings)
-> GroupDecoder (Maybe QueueUrl)
-> GroupDecoder (Maybe Int -> Int -> QueueSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser QueueUrl)
-> GroupDecoder (Maybe QueueUrl)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"url" String -> Value -> Parser QueueUrl
parseQueueUrl
        GroupDecoder (Maybe Int -> Int -> QueueSettings)
-> GroupDecoder (Maybe Int) -> GroupDecoder (Int -> QueueSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxMemoryDepth" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Int -> QueueSettings)
-> GroupDecoder Int -> GroupDecoder QueueSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"maxReceiveCount" String -> Int -> Parser Int
parsePositiveInt

limitsDecoder :: GroupDecoder LimitsSettings
limitsDecoder :: GroupDecoder LimitsSettings
limitsDecoder =
    Maybe Int
-> Int
-> Int
-> Int
-> Int
-> Maybe Int
-> Maybe Int
-> Int
-> Int
-> LimitsSettings
LimitsSettings
        (Maybe Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Maybe Int
 -> Maybe Int
 -> Int
 -> Int
 -> LimitsSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder
     (Int
      -> Int
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Int
      -> Int
      -> LimitsSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxResponseBytes" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Int
   -> Int
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Int
   -> Int
   -> LimitsSettings)
-> GroupDecoder Int
-> GroupDecoder
     (Int
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Int
      -> Int
      -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"maxVersionCount" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Int
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Int
   -> Int
   -> LimitsSettings)
-> GroupDecoder Int
-> GroupDecoder
     (Int
      -> Int -> Maybe Int -> Maybe Int -> Int -> Int -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"maxArtifactCount" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Int
   -> Int -> Maybe Int -> Maybe Int -> Int -> Int -> LimitsSettings)
-> GroupDecoder Int
-> GroupDecoder
     (Int -> Maybe Int -> Maybe Int -> Int -> Int -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"maxNestingDepth" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Int -> Maybe Int -> Maybe Int -> Int -> Int -> LimitsSettings)
-> GroupDecoder Int
-> GroupDecoder
     (Maybe Int -> Maybe Int -> Int -> Int -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"maxAdvisoryDatabaseBytes" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Maybe Int -> Maybe Int -> Int -> Int -> LimitsSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder (Maybe Int -> Int -> Int -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxRequestBytes" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Maybe Int -> Int -> Int -> LimitsSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder (Int -> Int -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxArtifactBytes" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Int -> Int -> LimitsSettings)
-> GroupDecoder Int -> GroupDecoder (Int -> LimitsSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder Int
forall a. FromJSON a => Key -> GroupDecoder a
plainKey Key
"progressWindow"
        GroupDecoder (Int -> LimitsSettings)
-> GroupDecoder Int -> GroupDecoder LimitsSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder Int
forall a. FromJSON a => Key -> GroupDecoder a
plainKey Key
"minProgressBytes"

cacheDecoder :: GroupDecoder CacheSettings
cacheDecoder :: GroupDecoder CacheSettings
cacheDecoder =
    NominalDiffTime -> Maybe Int -> Maybe Int -> CacheSettings
CacheSettings
        (NominalDiffTime -> Maybe Int -> Maybe Int -> CacheSettings)
-> GroupDecoder NominalDiffTime
-> GroupDecoder (Maybe Int -> Maybe Int -> CacheSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder NominalDiffTime
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"ttl" String -> Value -> Parser NominalDiffTime
parseSeconds
        GroupDecoder (Maybe Int -> Maybe Int -> CacheSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder (Maybe Int -> CacheSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxEntries" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Maybe Int -> CacheSettings)
-> GroupDecoder (Maybe Int) -> GroupDecoder CacheSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxBytes" String -> Int -> Parser Int
parsePositiveInt

integrityDecoder :: GroupDecoder IntegritySettings
integrityDecoder :: GroupDecoder IntegritySettings
integrityDecoder =
    MinIntegrity -> MinTrustedIntegrity -> IntegritySettings
IntegritySettings
        (MinIntegrity -> MinTrustedIntegrity -> IntegritySettings)
-> GroupDecoder MinIntegrity
-> GroupDecoder (MinTrustedIntegrity -> IntegritySettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser MinIntegrity)
-> GroupDecoder MinIntegrity
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"minPublic" ((Text -> Either Text MinIntegrity)
-> String -> Value -> Parser MinIntegrity
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text MinIntegrity
parseMinIntegrity)
        GroupDecoder (MinTrustedIntegrity -> IntegritySettings)
-> GroupDecoder MinTrustedIntegrity
-> GroupDecoder IntegritySettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser MinTrustedIntegrity)
-> GroupDecoder MinTrustedIntegrity
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"minTrusted" ((Text -> Either Text MinTrustedIntegrity)
-> String -> Value -> Parser MinTrustedIntegrity
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text MinTrustedIntegrity
parseMinTrustedIntegrity)
        GroupDecoder IntegritySettings
-> GroupDecoder (Maybe ()) -> GroupDecoder IntegritySettings
forall a b. GroupDecoder a -> GroupDecoder b -> GroupDecoder a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Key -> (String -> Value -> Parser ()) -> GroupDecoder (Maybe ())
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"divergencePolicy" String -> Value -> Parser ()
parseLegacyDivergencePolicy

-- A removed refusal must fail at boot instead of silently becoming private preference.
parseLegacyDivergencePolicy :: String -> Value -> Parser ()
parseLegacyDivergencePolicy :: String -> Value -> Parser ()
parseLegacyDivergencePolicy String
field = String -> (Text -> Parser ()) -> Value -> Parser ()
forall a. String -> (Text -> Parser a) -> Value -> Parser a
expectString String
field ((Text -> Parser ()) -> Value -> Parser ())
-> (Text -> Parser ()) -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ \Text
value ->
    case Text -> Text
T.toLower (Text -> Text
T.strip Text
value) of
        Text
"warn" -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Text
removed
            | Text
removed Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text
"fail-closed", Text
"fail_closed", Text
"failclosed"] ->
                String -> Parser ()
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
": fail-closed was removed. Remove this setting after accepting private preference and divergence alarms.")
        Text
_ -> String -> Parser ()
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
": expected deprecated warn, or remove this setting")

egressDecoder :: GroupDecoder EgressSettings
egressDecoder :: GroupDecoder EgressSettings
egressDecoder =
    [IPRange] -> EgressSettings
EgressSettings
        ([IPRange] -> EgressSettings)
-> GroupDecoder [IPRange] -> GroupDecoder EgressSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> Value
-> (String -> Value -> Parser [IPRange])
-> GroupDecoder [IPRange]
forall b a.
FromJSON b =>
Key -> b -> (String -> b -> Parser a) -> GroupDecoder a
optionalKeyOr Key
"additionalBlockedRanges" (Text -> Value
String Text
"") String -> Value -> Parser [IPRange]
parseBlockedRanges

advisoriesDecoder :: GroupDecoder AdvisoriesSettings
advisoriesDecoder :: GroupDecoder AdvisoriesSettings
advisoriesDecoder =
    Maybe AdvisoryStoreUrl
-> NominalDiffTime
-> NominalDiffTime
-> String
-> Url
-> Url
-> Map Ecosystem NominalDiffTime
-> NominalDiffTime
-> Maybe NominalDiffTime
-> AdvisoriesSettings
AdvisoriesSettings
        (Maybe AdvisoryStoreUrl
 -> NominalDiffTime
 -> NominalDiffTime
 -> String
 -> Url
 -> Url
 -> Map Ecosystem NominalDiffTime
 -> NominalDiffTime
 -> Maybe NominalDiffTime
 -> AdvisoriesSettings)
-> GroupDecoder (Maybe AdvisoryStoreUrl)
-> GroupDecoder
     (NominalDiffTime
      -> NominalDiffTime
      -> String
      -> Url
      -> Url
      -> Map Ecosystem NominalDiffTime
      -> NominalDiffTime
      -> Maybe NominalDiffTime
      -> AdvisoriesSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser AdvisoryStoreUrl)
-> GroupDecoder (Maybe AdvisoryStoreUrl)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"url" String -> Value -> Parser AdvisoryStoreUrl
parseAdvisoryStoreUrl
        GroupDecoder
  (NominalDiffTime
   -> NominalDiffTime
   -> String
   -> Url
   -> Url
   -> Map Ecosystem NominalDiffTime
   -> NominalDiffTime
   -> Maybe NominalDiffTime
   -> AdvisoriesSettings)
-> GroupDecoder NominalDiffTime
-> GroupDecoder
     (NominalDiffTime
      -> String
      -> Url
      -> Url
      -> Map Ecosystem NominalDiffTime
      -> NominalDiffTime
      -> Maybe NominalDiffTime
      -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder NominalDiffTime
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"pollInterval" String -> Value -> Parser NominalDiffTime
parseDelaySeconds
        GroupDecoder
  (NominalDiffTime
   -> String
   -> Url
   -> Url
   -> Map Ecosystem NominalDiffTime
   -> NominalDiffTime
   -> Maybe NominalDiffTime
   -> AdvisoriesSettings)
-> GroupDecoder NominalDiffTime
-> GroupDecoder
     (String
      -> Url
      -> Url
      -> Map Ecosystem NominalDiffTime
      -> NominalDiffTime
      -> Maybe NominalDiffTime
      -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder NominalDiffTime
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"compileInterval" String -> Value -> Parser NominalDiffTime
parseDelaySeconds
        GroupDecoder
  (String
   -> Url
   -> Url
   -> Map Ecosystem NominalDiffTime
   -> NominalDiffTime
   -> Maybe NominalDiffTime
   -> AdvisoriesSettings)
-> GroupDecoder String
-> GroupDecoder
     (Url
      -> Url
      -> Map Ecosystem NominalDiffTime
      -> NominalDiffTime
      -> Maybe NominalDiffTime
      -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder String
forall a. FromJSON a => Key -> GroupDecoder a
plainKey Key
"dataDir"
        GroupDecoder
  (Url
   -> Url
   -> Map Ecosystem NominalDiffTime
   -> NominalDiffTime
   -> Maybe NominalDiffTime
   -> AdvisoriesSettings)
-> GroupDecoder Url
-> GroupDecoder
     (Url
      -> Map Ecosystem NominalDiffTime
      -> NominalDiffTime
      -> Maybe NominalDiffTime
      -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Value -> Parser Url) -> GroupDecoder Url
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"osvExportBaseUrl" String -> Value -> Parser Url
parseHttpUrl
        GroupDecoder
  (Url
   -> Map Ecosystem NominalDiffTime
   -> NominalDiffTime
   -> Maybe NominalDiffTime
   -> AdvisoriesSettings)
-> GroupDecoder Url
-> GroupDecoder
     (Map Ecosystem NominalDiffTime
      -> NominalDiffTime -> Maybe NominalDiffTime -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Value -> Parser Url) -> GroupDecoder Url
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"epssFeedUrl" String -> Value -> Parser Url
parseHttpUrl
        GroupDecoder
  (Map Ecosystem NominalDiffTime
   -> NominalDiffTime -> Maybe NominalDiffTime -> AdvisoriesSettings)
-> GroupDecoder (Map Ecosystem NominalDiffTime)
-> GroupDecoder
     (NominalDiffTime -> Maybe NominalDiffTime -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser (Map Ecosystem NominalDiffTime))
-> GroupDecoder (Map Ecosystem NominalDiffTime)
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"quietTime" KeyMap Value -> Parser (Map Ecosystem NominalDiffTime)
parseQuietTimes
        GroupDecoder
  (NominalDiffTime -> Maybe NominalDiffTime -> AdvisoriesSettings)
-> GroupDecoder NominalDiffTime
-> GroupDecoder (Maybe NominalDiffTime -> AdvisoriesSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder NominalDiffTime
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"epssQuietTime" String -> Value -> Parser NominalDiffTime
parseDelaySeconds
        GroupDecoder (Maybe NominalDiffTime -> AdvisoriesSettings)
-> GroupDecoder (Maybe NominalDiffTime)
-> GroupDecoder AdvisoriesSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder (Maybe NominalDiffTime)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxAgeSeconds" String -> Value -> Parser NominalDiffTime
parseDelaySeconds

runtimeDecoder :: GroupDecoder RuntimeSettings
runtimeDecoder :: GroupDecoder RuntimeSettings
runtimeDecoder =
    Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> RuntimeSettings
RuntimeSettings
        (Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> RuntimeSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> RuntimeSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"cores" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> RuntimeSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder
     (Maybe Int
      -> Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"coresCeiling" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Maybe Int
   -> Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder
     (Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"maxHeapBytes" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (Maybe Int -> Maybe Int -> Maybe Int -> RuntimeSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder (Maybe Int -> Maybe Int -> RuntimeSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"serveMaxInFlight" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Maybe Int -> Maybe Int -> RuntimeSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder (Maybe Int -> RuntimeSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"publicConnectionsPerHost" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Maybe Int -> RuntimeSettings)
-> GroupDecoder (Maybe Int) -> GroupDecoder RuntimeSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"privateConnectionsPerHost" String -> Int -> Parser Int
parsePositiveInt

observabilityDecoder :: GroupDecoder ObservabilitySettings
observabilityDecoder :: GroupDecoder ObservabilitySettings
observabilityDecoder =
    LogFormat -> LogLevel -> TelemetrySwitch -> ObservabilitySettings
ObservabilitySettings
        (LogFormat -> LogLevel -> TelemetrySwitch -> ObservabilitySettings)
-> GroupDecoder LogFormat
-> GroupDecoder
     (LogLevel -> TelemetrySwitch -> ObservabilitySettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser LogFormat) -> GroupDecoder LogFormat
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"logFormat" ((Text -> Either Text LogFormat)
-> String -> Value -> Parser LogFormat
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text LogFormat
parseLogFormat)
        GroupDecoder (LogLevel -> TelemetrySwitch -> ObservabilitySettings)
-> GroupDecoder LogLevel
-> GroupDecoder (TelemetrySwitch -> ObservabilitySettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser LogLevel) -> GroupDecoder LogLevel
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"logLevel" ((Text -> Either Text LogLevel)
-> String -> Value -> Parser LogLevel
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text LogLevel
parseLogLevel)
        GroupDecoder (TelemetrySwitch -> ObservabilitySettings)
-> GroupDecoder TelemetrySwitch
-> GroupDecoder ObservabilitySettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser TelemetrySwitch)
-> GroupDecoder TelemetrySwitch
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"telemetry" ((Text -> Either Text TelemetrySwitch)
-> String -> Value -> Parser TelemetrySwitch
forall a. (Text -> Either Text a) -> String -> Value -> Parser a
parseEnum Text -> Either Text TelemetrySwitch
parseTelemetrySwitch)

dredgerDecoder :: GroupDecoder DredgerSettings
dredgerDecoder :: GroupDecoder DredgerSettings
dredgerDecoder =
    Int
-> NominalDiffTime
-> NominalDiffTime
-> Maybe NominalDiffTime
-> Maybe Rational
-> Map Text QuotaOverride
-> Maybe Int
-> Bool
-> DredgerSettings
DredgerSettings
        (Int
 -> NominalDiffTime
 -> NominalDiffTime
 -> Maybe NominalDiffTime
 -> Maybe Rational
 -> Map Text QuotaOverride
 -> Maybe Int
 -> Bool
 -> DredgerSettings)
-> GroupDecoder Int
-> GroupDecoder
     (NominalDiffTime
      -> NominalDiffTime
      -> Maybe NominalDiffTime
      -> Maybe Rational
      -> Map Text QuotaOverride
      -> Maybe Int
      -> Bool
      -> DredgerSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> (String -> Int -> Parser Int) -> GroupDecoder Int
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"chunkSize" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder
  (NominalDiffTime
   -> NominalDiffTime
   -> Maybe NominalDiffTime
   -> Maybe Rational
   -> Map Text QuotaOverride
   -> Maybe Int
   -> Bool
   -> DredgerSettings)
-> GroupDecoder NominalDiffTime
-> GroupDecoder
     (NominalDiffTime
      -> Maybe NominalDiffTime
      -> Maybe Rational
      -> Map Text QuotaOverride
      -> Maybe Int
      -> Bool
      -> DredgerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder NominalDiffTime
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"chunkPause" String -> Value -> Parser NominalDiffTime
parseDelaySeconds
        GroupDecoder
  (NominalDiffTime
   -> Maybe NominalDiffTime
   -> Maybe Rational
   -> Map Text QuotaOverride
   -> Maybe Int
   -> Bool
   -> DredgerSettings)
-> GroupDecoder NominalDiffTime
-> GroupDecoder
     (Maybe NominalDiffTime
      -> Maybe Rational
      -> Map Text QuotaOverride
      -> Maybe Int
      -> Bool
      -> DredgerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder NominalDiffTime
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder a
requiredKey Key
"cyclePause" String -> Value -> Parser NominalDiffTime
parseDelaySeconds
        GroupDecoder
  (Maybe NominalDiffTime
   -> Maybe Rational
   -> Map Text QuotaOverride
   -> Maybe Int
   -> Bool
   -> DredgerSettings)
-> GroupDecoder (Maybe NominalDiffTime)
-> GroupDecoder
     (Maybe Rational
      -> Map Text QuotaOverride -> Maybe Int -> Bool -> DredgerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser NominalDiffTime)
-> GroupDecoder (Maybe NominalDiffTime)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"targetCycleWindow" String -> Value -> Parser NominalDiffTime
parseDelaySeconds
        GroupDecoder
  (Maybe Rational
   -> Map Text QuotaOverride -> Maybe Int -> Bool -> DredgerSettings)
-> GroupDecoder (Maybe Rational)
-> GroupDecoder
     (Map Text QuotaOverride -> Maybe Int -> Bool -> DredgerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (String -> Value -> Parser Rational)
-> GroupDecoder (Maybe Rational)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"requestBudgetFraction" String -> Value -> Parser Rational
parseUnitFraction
        GroupDecoder
  (Map Text QuotaOverride -> Maybe Int -> Bool -> DredgerSettings)
-> GroupDecoder (Map Text QuotaOverride)
-> GroupDecoder (Maybe Int -> Bool -> DredgerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser (Map Text QuotaOverride))
-> GroupDecoder (Map Text QuotaOverride)
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"quotaOverrides" KeyMap Value -> Parser (Map Text QuotaOverride)
parseQuotaOverrides
        GroupDecoder (Maybe Int -> Bool -> DredgerSettings)
-> GroupDecoder (Maybe Int)
-> GroupDecoder (Bool -> DredgerSettings)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> (String -> Int -> Parser Int) -> GroupDecoder (Maybe Int)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"deletionCap" String -> Int -> Parser Int
parsePositiveInt
        GroupDecoder (Bool -> DredgerSettings)
-> GroupDecoder Bool -> GroupDecoder DredgerSettings
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder Bool
forall a. FromJSON a => Key -> GroupDecoder a
plainKey Key
"fullWalk"

-- The key is the store URL the entry describes, kept as written so the boot can match it against
-- the endpoints the mounts declare.
parseQuotaOverrides :: KeyMap.KeyMap Value -> Parser (Map.Map Text QuotaOverride)
parseQuotaOverrides :: KeyMap Value -> Parser (Map Text QuotaOverride)
parseQuotaOverrides KeyMap Value
km = [(Text, QuotaOverride)] -> Map Text QuotaOverride
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, QuotaOverride)] -> Map Text QuotaOverride)
-> Parser [(Text, QuotaOverride)]
-> Parser (Map Text QuotaOverride)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Parser (Text, QuotaOverride))
-> [(Key, Value)] -> Parser [(Text, QuotaOverride)]
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, QuotaOverride)
parseQuotaOverrideEntry (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList KeyMap Value
km)

parseQuotaOverrideEntry :: (Key.Key, Value) -> Parser (Text, QuotaOverride)
parseQuotaOverrideEntry :: (Key, Value) -> Parser (Text, QuotaOverride)
parseQuotaOverrideEntry (Key
k, Value
v) =
    (Key -> Text
Key.toText Key
k,) (QuotaOverride -> (Text, QuotaOverride))
-> Parser QuotaOverride -> Parser (Text, QuotaOverride)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (KeyMap Value -> Parser QuotaOverride)
-> Value
-> Parser QuotaOverride
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"QuotaOverride" (String
-> GroupDecoder QuotaOverride
-> KeyMap Value
-> Parser QuotaOverride
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeBareGroup String
entryPath (String -> GroupDecoder QuotaOverride
quotaOverrideDecoder String
entryPath)) Value
v
  where
    entryPath :: String
entryPath = String
"dredger.quotaOverrides." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Key -> String
Key.toString Key
k

quotaOverrideDecoder :: String -> GroupDecoder QuotaOverride
quotaOverrideDecoder :: String -> GroupDecoder QuotaOverride
quotaOverrideDecoder String
entryPath =
    Maybe Text
-> Map QuotaDimension Rational
-> Map RequestKind Rational
-> QuotaOverride
QuotaOverride
        (Maybe Text
 -> Map QuotaDimension Rational
 -> Map RequestKind Rational
 -> QuotaOverride)
-> GroupDecoder (Maybe Text)
-> GroupDecoder
     (Map QuotaDimension Rational
      -> Map RequestKind Rational -> QuotaOverride)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (String -> Value -> Parser Text) -> GroupDecoder (Maybe Text)
forall b a.
FromJSON b =>
Key -> (String -> b -> Parser a) -> GroupDecoder (Maybe a)
optionalKey Key
"scope" (String -> (Text -> Parser Text) -> Value -> Parser Text
forall a. String -> (Text -> Parser a) -> Value -> Parser a
`expectString` Text -> Parser Text
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        GroupDecoder
  (Map QuotaDimension Rational
   -> Map RequestKind Rational -> QuotaOverride)
-> GroupDecoder (Map QuotaDimension Rational)
-> GroupDecoder (Map RequestKind Rational -> QuotaOverride)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser (Map QuotaDimension Rational))
-> GroupDecoder (Map QuotaDimension Rational)
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"quotas" (String
-> (Text -> Maybe QuotaDimension)
-> String
-> KeyMap Value
-> Parser (Map QuotaDimension Rational)
forall key.
Ord key =>
String
-> (Text -> Maybe key)
-> String
-> KeyMap Value
-> Parser (Map key Rational)
parseRates String
entryPath Text -> Maybe QuotaDimension
parseQuotaDimension String
"quota dimension")
        GroupDecoder (Map RequestKind Rational -> QuotaOverride)
-> GroupDecoder (Map RequestKind Rational)
-> GroupDecoder QuotaOverride
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key
-> (KeyMap Value -> Parser (Map RequestKind Rational))
-> GroupDecoder (Map RequestKind Rational)
forall a. Key -> (KeyMap Value -> Parser a) -> GroupDecoder a
nestedKey Key
"requestWeights" (String
-> (Text -> Maybe RequestKind)
-> String
-> KeyMap Value
-> Parser (Map RequestKind Rational)
forall key.
Ord key =>
String
-> (Text -> Maybe key)
-> String
-> KeyMap Value
-> Parser (Map key Rational)
parseRates String
entryPath Text -> Maybe RequestKind
parseRequestKind String
"request kind")

{- Every entry under one map of positive rates, keyed by a name this build meters under. An
unknown name fails the load, because a rate nothing reads would silently pace nothing. -}
parseRates :: (Ord key) => String -> (Text -> Maybe key) -> String -> KeyMap.KeyMap Value -> Parser (Map.Map key Rational)
parseRates :: forall key.
Ord key =>
String
-> (Text -> Maybe key)
-> String
-> KeyMap Value
-> Parser (Map key Rational)
parseRates String
entryPath Text -> Maybe key
readKey String
subject KeyMap Value
km = [(key, Rational)] -> Map key Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(key, Rational)] -> Map key Rational)
-> Parser [(key, Rational)] -> Parser (Map key Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Parser (key, Rational))
-> [(Key, Value)] -> Parser [(key, Rational)]
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 (key, Rational)
rate (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList KeyMap Value
km)
  where
    rate :: (Key, Value) -> Parser (key, Rational)
rate (Key
k, Value
v) = case Text -> Maybe key
readKey (Key -> Text
Key.toText Key
k) of
        Maybe key
Nothing -> String -> Parser (key, Rational)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
entryPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Key -> String
Key.toString Key
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
subject String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" this build meters")
        Just key
metered -> (key
metered,) (Rational -> (key, Rational))
-> Parser Rational -> Parser (key, Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Value -> Parser Rational
parsePositiveRate (String
entryPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Key -> String
Key.toString Key
k) Value
v

parseQuietTimes :: KeyMap.KeyMap Value -> Parser (Map.Map Ecosystem NominalDiffTime)
parseQuietTimes :: KeyMap Value -> Parser (Map Ecosystem NominalDiffTime)
parseQuietTimes KeyMap Value
km = [(Ecosystem, NominalDiffTime)] -> Map Ecosystem NominalDiffTime
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Ecosystem, NominalDiffTime)] -> Map Ecosystem NominalDiffTime)
-> Parser [(Ecosystem, NominalDiffTime)]
-> Parser (Map Ecosystem NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Parser (Ecosystem, NominalDiffTime))
-> [(Key, Value)] -> Parser [(Ecosystem, NominalDiffTime)]
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, NominalDiffTime)
parseQuietTimeEntry (KeyMap Value -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList KeyMap Value
km)

parseQuietTimeEntry :: (Key.Key, Value) -> Parser (Ecosystem, NominalDiffTime)
parseQuietTimeEntry :: (Key, Value) -> Parser (Ecosystem, NominalDiffTime)
parseQuietTimeEntry (Key
k, Value
v) = do
    eco <- String -> Key -> Parser Ecosystem
ecosystemKey String
" in advisories.quietTime" Key
k
    (eco,) <$> parseDelaySeconds ("advisories.quietTime." <> T.unpack (Key.toText k)) v

-- Every mount in the merged object, the shipped per-ecosystem templates included.
-- "Ecluse.Config" decides which of them are active and must be complete.
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 <- String -> Key -> Parser Ecosystem
ecosystemKey String
"" Key
k
    mcfg <- withObject "MountConfig" (decodeBareGroup "mount" (mountDecoder eco)) v
    pure (eco, mcfg)

-- A map key spelled as a mounts key is, so an unknown ecosystem fails the load rather than
-- configuring nothing. The location is appended to the refusal that names the key.
ecosystemKey :: String -> Key.Key -> Parser Ecosystem
ecosystemKey :: String -> Key -> Parser Ecosystem
ecosystemKey String
location Key
k = Parser Ecosystem
-> (Ecosystem -> Parser Ecosystem)
-> Maybe Ecosystem
-> Parser Ecosystem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Ecosystem
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
refusal) Ecosystem -> Parser Ecosystem
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Ecosystem
parseEcosystem (Key -> Text
Key.toText Key
k))
  where
    refusal :: String
refusal = String
"Invalid ecosystem" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
location String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Key -> Text
Key.toText Key
k)

parseSecret :: String -> Value -> Parser Secret
parseSecret :: String -> Value -> Parser Secret
parseSecret String
field = String -> (Text -> Parser Secret) -> Value -> Parser Secret
forall a. String -> (Text -> Parser a) -> Value -> Parser a
expectString String
field (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)

-- Every arm is explicit, so an added 'Ecosystem' surfaces here as a compiler error. One with no
-- namespace shape yet refuses the key rather than parsing it as another ecosystem's.
parseFirstParty :: Ecosystem -> String -> Value -> Parser FirstParty
parseFirstParty :: Ecosystem -> String -> Value -> Parser FirstParty
parseFirstParty Ecosystem
eco String
field Value
v = case Ecosystem
eco of
    Ecosystem
Npm -> NonEmpty Scope -> FirstParty
FirstPartyNpmScopes (NonEmpty Scope -> FirstParty)
-> Parser (NonEmpty Scope) -> Parser FirstParty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Value -> Parser (NonEmpty Scope)
parseNpmScopes String
field Value
v
    Ecosystem
PyPI -> NonEmpty PyPIFirstParty -> FirstParty
FirstPartyPyPI (NonEmpty PyPIFirstParty -> FirstParty)
-> Parser (NonEmpty PyPIFirstParty) -> Parser FirstParty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Value -> Parser (NonEmpty PyPIFirstParty)
parsePyPIFirstParty String
field Value
v
    Ecosystem
RubyGems -> String -> Parser FirstParty
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
" is not supported for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString (Ecosystem -> Text
ecosystemName Ecosystem
eco) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" yet")

-- A configured list that names nothing privileges nothing, so it fails the load instead.
parseNpmScopes :: String -> Value -> Parser (NonEmpty Scope)
parseNpmScopes :: String -> Value -> Parser (NonEmpty Scope)
parseNpmScopes String
field Value
v = do
    scopes <- String -> (Text -> Parser Scope) -> Value -> Parser [Scope]
forall a. String -> (Text -> Parser a) -> Value -> Parser [a]
commaSeparated String
field Text -> Parser Scope
parseScopeEntry Value
v
    maybe (fail (field <> " must name at least one scope")) pure (nonEmpty scopes)

-- Reject a firstParty segment no scope can equal, an empty one or a wrong separator, so a typo
-- fails the load instead of seeding a privilege that covers nothing.
parseScopeEntry :: Text -> Parser Scope
parseScopeEntry :: Text -> Parser Scope
parseScopeEntry Text
entry =
    (ParseError -> Parser Scope)
-> (Scope -> Parser Scope)
-> Either ParseError Scope
-> Parser Scope
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser Scope -> ParseError -> Parser Scope
forall a b. a -> b -> a
const (String -> Parser Scope
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid scope in firstParty: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
entry))) Scope -> Parser Scope
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either ParseError Scope
projectScope Text
entry)

-- A configured list that names nothing privileges nothing, so it fails the load instead.
parsePyPIFirstParty :: String -> Value -> Parser (NonEmpty PyPIFirstParty)
parsePyPIFirstParty :: String -> Value -> Parser (NonEmpty PyPIFirstParty)
parsePyPIFirstParty String
field Value
v = do
    entries <- String
-> (Text -> Parser PyPIFirstParty)
-> Value
-> Parser [PyPIFirstParty]
forall a. String -> (Text -> Parser a) -> Value -> Parser [a]
commaSeparated String
field (String -> Text -> Parser PyPIFirstParty
parsePyPIEntry String
field) Value
v
    maybe (fail (field <> " must name at least one distribution or prefix")) pure (nonEmpty entries)

-- Reject a firstParty segment no distribution name or prefix can equal, so a typo fails the load
-- instead of seeding a privilege that covers nothing.
parsePyPIEntry :: String -> Text -> Parser PyPIFirstParty
parsePyPIEntry :: String -> Text -> Parser PyPIFirstParty
parsePyPIEntry String
field Text
entry =
    (ParseError -> Parser PyPIFirstParty)
-> (PyPIFirstParty -> Parser PyPIFirstParty)
-> Either ParseError PyPIFirstParty
-> Parser PyPIFirstParty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser PyPIFirstParty -> ParseError -> Parser PyPIFirstParty
forall a b. a -> b -> a
const (String -> Parser PyPIFirstParty
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid entry in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
field String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
entry))) PyPIFirstParty -> Parser PyPIFirstParty
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either ParseError PyPIFirstParty
projectFirstPartyEntry Text
entry)

parseBlockedRanges :: String -> Value -> Parser [IPRange]
parseBlockedRanges :: String -> Value -> Parser [IPRange]
parseBlockedRanges String
field = String -> (Text -> Parser IPRange) -> Value -> Parser [IPRange]
forall a. String -> (Text -> Parser a) -> Value -> Parser [a]
commaSeparated String
field Text -> Parser IPRange
parseBlockedRangeEntry

parseBlockedRangeEntry :: Text -> Parser IPRange
parseBlockedRangeEntry :: Text -> Parser IPRange
parseBlockedRangeEntry Text
entry =
    case Text -> Maybe IPRange
parseBlockedRange Text
entry 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
entry)

-- A rate of zero admits no request at all, so it is refused rather than read as a store that may
-- never be swept.
parsePositiveRate :: String -> Value -> Parser Rational
parsePositiveRate :: String -> Value -> Parser Rational
parsePositiveRate String
field Value
value = case Value
value of
    Number Scientific
n | Just Rational
rate <- Scientific -> Maybe Rational
boundedRational Scientific
n, Rational
rate Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 -> Rational -> Parser Rational
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
rate
    Value
_ -> String -> Parser Rational
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 number written within nine decimal places")

-- Neither end of the range is a share, so both are refused rather than read as a sweep that
-- stops or one that takes the whole store.
parseUnitFraction :: String -> Value -> Parser Rational
parseUnitFraction :: String -> Value -> Parser Rational
parseUnitFraction String
field Value
value = case Value
value of
    Number Scientific
n | Just Rational
share <- Scientific -> Maybe Rational
boundedRational Scientific
n, Rational
share Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0, Rational
share Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
1 -> Rational -> Parser Rational
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
share
    Value
_ -> String -> Parser Rational
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 number above 0 and below 1")

-- The exponent is bounded before the rational is realised, so a 1e999999999 is refused rather
-- than expanded.
boundedRational :: Scientific -> Maybe Rational
boundedRational :: Scientific -> Maybe Rational
boundedRational Scientific
n
    | Scientific -> Int
base10Exponent Scientific
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rationalExponentBound Bool -> Bool -> Bool
|| Scientific -> Int
base10Exponent Scientific
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
forall a. Num a => a -> a
negate Int
rationalExponentBound = Maybe Rational
forall a. Maybe a
Nothing
    | Bool
otherwise = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
n)

rationalExponentBound :: Int
rationalExponentBound :: Int
rationalExponentBound = Int
9

parseSeconds :: String -> Value -> Parser NominalDiffTime
parseSeconds :: String -> Value -> Parser NominalDiffTime
parseSeconds String
field = \case
    String Text
t -> case Text -> Maybe Integer
forall a. Integral a => Text -> Maybe a
readDecimalText 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' value, and its exponent guard
    -- rejects a pathological 1e999999999999 without ever realising the integer.
    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 " 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 and bounded. Zero would spin the poll without yielding, and the
bound keeps the microsecond conversion inside 'Int' rather than wrapping to a 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
-> GroupDecoder RuleEntry -> KeyMap Value -> Parser RuleEntry
forall a. String -> GroupDecoder a -> KeyMap Value -> Parser a
decodeGroup String
"rule" GroupDecoder RuleEntry
ruleEntryDecoder KeyMap Value
o

ruleEntryDecoder :: GroupDecoder RuleEntry
ruleEntryDecoder :: GroupDecoder RuleEntry
ruleEntryDecoder =
    Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe Double
-> Maybe Text
-> RuleEntry
RuleEntry
        (Maybe Text
 -> Maybe Int
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Double
 -> Maybe Double
 -> Maybe Text
 -> RuleEntry)
-> GroupDecoder (Maybe Text)
-> GroupDecoder
     (Maybe Int
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> GroupDecoder (Maybe Text)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"type"
        GroupDecoder
  (Maybe Int
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> GroupDecoder (Maybe Int)
-> GroupDecoder
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Int)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"precedence"
        GroupDecoder
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> GroupDecoder (Maybe Bool)
-> GroupDecoder
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Bool)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"enabled"
        GroupDecoder
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> GroupDecoder (Maybe Integer)
-> GroupDecoder
     (Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> Maybe Text
      -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Integer)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"ageSeconds"
        GroupDecoder
  (Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> Maybe Text
   -> RuleEntry)
-> GroupDecoder (Maybe Text)
-> GroupDecoder
     (Maybe Text
      -> Maybe Double -> Maybe Double -> Maybe Text -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Text)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"scope"
        GroupDecoder
  (Maybe Text
   -> Maybe Double -> Maybe Double -> Maybe Text -> RuleEntry)
-> GroupDecoder (Maybe Text)
-> GroupDecoder
     (Maybe Double -> Maybe Double -> Maybe Text -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Text)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"identity"
        GroupDecoder
  (Maybe Double -> Maybe Double -> Maybe Text -> RuleEntry)
-> GroupDecoder (Maybe Double)
-> GroupDecoder (Maybe Double -> Maybe Text -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Double)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"minCvss"
        GroupDecoder (Maybe Double -> Maybe Text -> RuleEntry)
-> GroupDecoder (Maybe Double)
-> GroupDecoder (Maybe Text -> RuleEntry)
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Double)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"minEpss"
        GroupDecoder (Maybe Text -> RuleEntry)
-> GroupDecoder (Maybe Text) -> GroupDecoder RuleEntry
forall a b.
GroupDecoder (a -> b) -> GroupDecoder a -> GroupDecoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> GroupDecoder (Maybe Text)
forall a. FromJSON a => Key -> GroupDecoder (Maybe a)
optionalPlainKey Key
"onUnavailable"