{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Data.OpenApi.Compare.Validate.SecurityRequirement
  ( Issue (..),
  )
where

import Control.Comonad
import Control.Monad
import Control.Monad.Writer
import Data.Bifunctor
import Data.Either
import Data.Foldable
import Data.Functor
import Data.HList
import qualified Data.HashMap.Strict.InsOrd as IOHM
import qualified Data.List.NonEmpty as NE
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.OAuth2Flows
import Data.OpenApi.Compare.Validate.SecurityScheme ()
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import Data.Traversable

instance Subtree SecurityRequirement where
  type SubtreeLevel SecurityRequirement = 'SecurityRequirementLevel
  type
    CheckEnv SecurityRequirement =
      '[ ProdCons (Traced (Definitions SecurityScheme))
       ]
  checkStructuralCompatibility :: HList (CheckEnv SecurityRequirement)
-> ProdCons (Traced SecurityRequirement)
-> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv SecurityRequirement)
env ProdCons (Traced SecurityRequirement)
pc = do
    let normalized :: ProdCons (Maybe [(Traced SecurityScheme, [Text])])
normalized = do
          SecurityRequirement
sec <- Traced SecurityRequirement -> SecurityRequirement
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced SecurityRequirement -> SecurityRequirement)
-> ProdCons (Traced SecurityRequirement)
-> ProdCons SecurityRequirement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced SecurityRequirement)
pc
          EnvT
  (Trace (Definitions SecurityScheme))
  Identity
  (Definitions SecurityScheme)
defs <- HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
-> ProdCons
     (EnvT
        (Trace (Definitions SecurityScheme))
        Identity
        (Definitions SecurityScheme))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
HList (CheckEnv SecurityRequirement)
env
          -- lookupScheme
          pure $
            [(Text, [Text])]
-> ((Text, [Text]) -> Maybe (Traced SecurityScheme, [Text]))
-> Maybe [(Traced SecurityScheme, [Text])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (InsOrdHashMap Text [Text] -> [(Text, [Text])]
forall k v. InsOrdHashMap k v -> [(k, v)]
IOHM.toList (InsOrdHashMap Text [Text] -> [(Text, [Text])])
-> InsOrdHashMap Text [Text] -> [(Text, [Text])]
forall a b. (a -> b) -> a -> b
$ SecurityRequirement -> InsOrdHashMap Text [Text]
getSecurityRequirement SecurityRequirement
sec) (((Text, [Text]) -> Maybe (Traced SecurityScheme, [Text]))
 -> Maybe [(Traced SecurityScheme, [Text])])
-> ((Text, [Text]) -> Maybe (Traced SecurityScheme, [Text]))
-> Maybe [(Traced SecurityScheme, [Text])]
forall a b. (a -> b) -> a -> b
$ \(Text
key, [Text]
scopes) ->
              (,[Text]
scopes) (Traced SecurityScheme -> (Traced SecurityScheme, [Text]))
-> Maybe (Traced SecurityScheme)
-> Maybe (Traced SecurityScheme, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> EnvT
     (Trace (Definitions SecurityScheme))
     Identity
     (Definitions SecurityScheme)
-> Maybe (Traced SecurityScheme)
lookupScheme Text
key EnvT
  (Trace (Definitions SecurityScheme))
  Identity
  (Definitions SecurityScheme)
defs
    (ProdCons [(Traced SecurityScheme, [Text])]
 -> StructuralCompatFormula ())
-> ProdCons (Maybe [(Traced SecurityScheme, [Text])])
-> StructuralCompatFormula ()
forall a.
(ProdCons a -> StructuralCompatFormula ())
-> ProdCons (Maybe a) -> StructuralCompatFormula ()
structuralMaybeWith
      ( \ProdCons [(Traced SecurityScheme, [Text])]
pc' -> do
          let ProdCons [[Text]]
pScopes [[Text]]
cScopes = ((Traced SecurityScheme, [Text]) -> [Text])
-> [(Traced SecurityScheme, [Text])] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Traced SecurityScheme, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ([(Traced SecurityScheme, [Text])] -> [[Text]])
-> ProdCons [(Traced SecurityScheme, [Text])] -> ProdCons [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons [(Traced SecurityScheme, [Text])]
pc'
          Bool -> StructuralCompatFormula () -> StructuralCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Text]]
pScopes [[Text]] -> [[Text]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Text]]
cScopes) StructuralCompatFormula ()
forall a. StructuralCompatFormula a
structuralIssue
          HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
-> ProdCons [Traced SecurityScheme] -> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
HList (CheckEnv SecurityRequirement)
env (ProdCons [Traced SecurityScheme] -> StructuralCompatFormula ())
-> ProdCons [Traced SecurityScheme] -> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ ((Traced SecurityScheme, [Text]) -> Traced SecurityScheme)
-> [(Traced SecurityScheme, [Text])] -> [Traced SecurityScheme]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Traced SecurityScheme, [Text]) -> Traced SecurityScheme
forall a b. (a, b) -> a
fst ([(Traced SecurityScheme, [Text])] -> [Traced SecurityScheme])
-> ProdCons [(Traced SecurityScheme, [Text])]
-> ProdCons [Traced SecurityScheme]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons [(Traced SecurityScheme, [Text])]
pc'
          pure ()
      )
      ProdCons (Maybe [(Traced SecurityScheme, [Text])])
normalized
    pure ()
  checkSemanticCompatibility :: HList (CheckEnv SecurityRequirement)
-> Behavior (SubtreeLevel SecurityRequirement)
-> ProdCons (Traced SecurityRequirement)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv SecurityRequirement)
env Behavior (SubtreeLevel SecurityRequirement)
bhv' ProdCons (Traced SecurityRequirement)
pc = do
    let schemes :: ProdCons
  (EnvT
     (Trace (Definitions SecurityScheme))
     Identity
     (Definitions SecurityScheme))
schemes = HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
-> ProdCons
     (EnvT
        (Trace (Definitions SecurityScheme))
        Identity
        (Definitions SecurityScheme))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons (Traced (Definitions SecurityScheme))) HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
HList (CheckEnv SecurityRequirement)
env
        ( ProdCons [Issue 'SecurityRequirementLevel]
pErrs [Issue 'SecurityRequirementLevel]
cErrs
          , (ProdCons [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
pSchemes [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
cSchemes) ::
              ProdCons [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
          ) =
            ProdCons
  ([Issue 'SecurityRequirementLevel],
   [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
-> (ProdCons [Issue 'SecurityRequirementLevel],
    ProdCons
      [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip (ProdCons
   ([Issue 'SecurityRequirementLevel],
    [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
 -> (ProdCons [Issue 'SecurityRequirementLevel],
     ProdCons
       [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]))
-> ProdCons
     ([Issue 'SecurityRequirementLevel],
      [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
-> (ProdCons [Issue 'SecurityRequirementLevel],
    ProdCons
      [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
forall a b. (a -> b) -> a -> b
$
              [Either
   (Issue 'SecurityRequirementLevel)
   (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
-> ([Issue 'SecurityRequirementLevel],
    [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either
    (Issue 'SecurityRequirementLevel)
    (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
 -> ([Issue 'SecurityRequirementLevel],
     [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]))
-> ProdCons
     [Either
        (Issue 'SecurityRequirementLevel)
        (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
-> ProdCons
     ([Issue 'SecurityRequirementLevel],
      [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                Traced SecurityRequirement
req <- ProdCons (Traced SecurityRequirement)
pc
                EnvT
  (Trace (Definitions SecurityScheme))
  Identity
  (Definitions SecurityScheme)
scheme <- ProdCons
  (EnvT
     (Trace (Definitions SecurityScheme))
     Identity
     (Definitions SecurityScheme))
schemes
                pure $
                  let -- [(key, scopes)]
                      pairs :: [(Text, [Text])]
pairs = InsOrdHashMap Text [Text] -> [(Text, [Text])]
forall k v. InsOrdHashMap k v -> [(k, v)]
IOHM.toList (InsOrdHashMap Text [Text] -> [(Text, [Text])])
-> (Traced SecurityRequirement -> InsOrdHashMap Text [Text])
-> Traced SecurityRequirement
-> [(Text, [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecurityRequirement -> InsOrdHashMap Text [Text]
getSecurityRequirement (SecurityRequirement -> InsOrdHashMap Text [Text])
-> (Traced SecurityRequirement -> SecurityRequirement)
-> Traced SecurityRequirement
-> InsOrdHashMap Text [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced SecurityRequirement -> SecurityRequirement
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced SecurityRequirement -> [(Text, [Text])])
-> Traced SecurityRequirement -> [(Text, [Text])]
forall a b. (a -> b) -> a -> b
$ Traced SecurityRequirement
req
                   in [(Text, [Text])]
pairs [(Text, [Text])]
-> ((Text, [Text])
    -> Either
         (Issue 'SecurityRequirementLevel)
         (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text]))
-> [Either
      (Issue 'SecurityRequirementLevel)
      (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
key, [Text]
scopes) -> do
                        case Text
-> EnvT
     (Trace (Definitions SecurityScheme))
     Identity
     (Definitions SecurityScheme)
-> Maybe (Traced SecurityScheme)
lookupScheme Text
key EnvT
  (Trace (Definitions SecurityScheme))
  Identity
  (Definitions SecurityScheme)
scheme of
                          Maybe (Traced SecurityScheme)
Nothing -> Issue 'SecurityRequirementLevel
-> Either
     (Issue 'SecurityRequirementLevel)
     (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
forall a b. a -> Either a b
Left (Issue 'SecurityRequirementLevel
 -> Either
      (Issue 'SecurityRequirementLevel)
      (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text]))
-> Issue 'SecurityRequirementLevel
-> Either
     (Issue 'SecurityRequirementLevel)
     (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
forall a b. (a -> b) -> a -> b
$ Text -> Issue 'SecurityRequirementLevel
UndefinedSecurityScheme Text
key
                          Just Traced SecurityScheme
x -> (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
-> Either
     (Issue 'SecurityRequirementLevel)
     (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
forall a b. b -> Either a b
Right (Paths Behave 'APILevel 'SecurityRequirementLevel
Behavior (SubtreeLevel SecurityRequirement)
bhv' Paths Behave 'APILevel 'SecurityRequirementLevel
-> Paths Behave 'SecurityRequirementLevel 'SecuritySchemeLevel
-> Behavior 'SecuritySchemeLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'SecurityRequirementLevel 'SecuritySchemeLevel
-> Paths Behave 'SecurityRequirementLevel 'SecuritySchemeLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Behave 'SecurityRequirementLevel 'SecuritySchemeLevel
SecuritySchemeStep Text
key), Traced SecurityScheme
x, [Text]
scopes)
        lookSimilar :: SecurityScheme -> SecurityScheme -> Bool
        lookSimilar :: SecurityScheme -> SecurityScheme -> Bool
lookSimilar SecurityScheme
x SecurityScheme
y = case (SecurityScheme -> SecuritySchemeType
_securitySchemeType SecurityScheme
x, SecurityScheme -> SecuritySchemeType
_securitySchemeType SecurityScheme
y) of
          (SecuritySchemeOAuth2 {}, SecuritySchemeOAuth2 {}) -> Bool
True
          (SecuritySchemeHttp {}, SecuritySchemeHttp {}) -> Bool
True
          (SecuritySchemeApiKey {}, SecuritySchemeApiKey {}) -> Bool
True
          (SecuritySchemeOpenIdConnect {}, SecuritySchemeOpenIdConnect {}) -> Bool
True
          (SecuritySchemeType, SecuritySchemeType)
_ -> Bool
False
    Paths Behave 'APILevel 'SecurityRequirementLevel
-> Issue 'SecurityRequirementLevel
-> CompatFormula' Behave AnIssue 'APILevel Any
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'SecurityRequirementLevel
Behavior (SubtreeLevel SecurityRequirement)
bhv' (Issue 'SecurityRequirementLevel
 -> CompatFormula' Behave AnIssue 'APILevel Any)
-> [Issue 'SecurityRequirementLevel] -> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` [Issue 'SecurityRequirementLevel]
pErrs
    Paths Behave 'APILevel 'SecurityRequirementLevel
-> Issue 'SecurityRequirementLevel
-> CompatFormula' Behave AnIssue 'APILevel Any
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'SecurityRequirementLevel
Behavior (SubtreeLevel SecurityRequirement)
bhv' (Issue 'SecurityRequirementLevel
 -> CompatFormula' Behave AnIssue 'APILevel Any)
-> [Issue 'SecurityRequirementLevel] -> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` [Issue 'SecurityRequirementLevel]
cErrs
    [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
-> ((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
pSchemes (((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
  -> SemanticCompatFormula ())
 -> SemanticCompatFormula ())
-> ((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Behavior 'SecuritySchemeLevel
bhv, Traced SecurityScheme
pScheme, [Text]
pScopes) -> do
      let lookPromising :: [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
lookPromising = ((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
 -> Bool)
-> [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
-> [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (SecurityScheme -> SecurityScheme -> Bool
lookSimilar (Traced SecurityScheme -> SecurityScheme
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced SecurityScheme
pScheme) (SecurityScheme -> Bool)
-> ((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
    -> SecurityScheme)
-> (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced SecurityScheme -> SecurityScheme
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced SecurityScheme -> SecurityScheme)
-> ((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
    -> Traced SecurityScheme)
-> (Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
-> SecurityScheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Behavior 'SecuritySchemeLevel
_, Traced SecurityScheme
x, [Text]
_) -> Traced SecurityScheme
x)) [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
cSchemes
      Behavior 'SecuritySchemeLevel
-> Issue 'SecuritySchemeLevel
-> [SemanticCompatFormula ()]
-> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l
-> Issue l
-> [CompatFormula' q AnIssue r a]
-> CompatFormula' q AnIssue r a
anyOfAt Behavior 'SecuritySchemeLevel
bhv Issue 'SecuritySchemeLevel
SecuritySchemeNotMatched ([SemanticCompatFormula ()] -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
        [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
lookPromising [(Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])]
-> ((Behavior 'SecuritySchemeLevel, Traced SecurityScheme, [Text])
    -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Behavior 'SecuritySchemeLevel
_, Traced SecurityScheme
cScheme, [Text]
cScopes) -> do
          let untracedSchemes :: (SecuritySchemeType, SecuritySchemeType)
untracedSchemes = ((Traced SecurityScheme -> SecuritySchemeType)
 -> (Traced SecurityScheme -> SecuritySchemeType)
 -> (Traced SecurityScheme, Traced SecurityScheme)
 -> (SecuritySchemeType, SecuritySchemeType))
-> (Traced SecurityScheme -> SecuritySchemeType)
-> (Traced SecurityScheme, Traced SecurityScheme)
-> (SecuritySchemeType, SecuritySchemeType)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Traced SecurityScheme -> SecuritySchemeType)
-> (Traced SecurityScheme -> SecuritySchemeType)
-> (Traced SecurityScheme, Traced SecurityScheme)
-> (SecuritySchemeType, SecuritySchemeType)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SecurityScheme -> SecuritySchemeType
_securitySchemeType (SecurityScheme -> SecuritySchemeType)
-> (Traced SecurityScheme -> SecurityScheme)
-> Traced SecurityScheme
-> SecuritySchemeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced SecurityScheme -> SecurityScheme
forall (w :: * -> *) a. Comonad w => w a -> a
extract) (Traced SecurityScheme
pScheme, Traced SecurityScheme
cScheme)
              scopedFlow :: Set Text -> OAuth2Flow t -> Writer [Issue 'SecuritySchemeLevel] (OAuth2Flow t)
              scopedFlow :: Set Text
-> OAuth2Flow t
-> Writer [Issue 'SecuritySchemeLevel] (OAuth2Flow t)
scopedFlow Set Text
scopes OAuth2Flow t
x = do
                let scopesMap :: InsOrdHashMap Text Text
scopesMap = OAuth2Flow t -> InsOrdHashMap Text Text
forall p. OAuth2Flow p -> InsOrdHashMap Text Text
_oAuth2Scopes OAuth2Flow t
x
                Set Text
-> (Text -> WriterT [Issue 'SecuritySchemeLevel] Identity ())
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set Text
scopes ((Text -> WriterT [Issue 'SecuritySchemeLevel] Identity ())
 -> WriterT [Issue 'SecuritySchemeLevel] Identity ())
-> (Text -> WriterT [Issue 'SecuritySchemeLevel] Identity ())
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
forall a b. (a -> b) -> a -> b
$ \Text
scope -> Bool
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
scope Text -> InsOrdHashMap Text Text -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
`IOHM.member` InsOrdHashMap Text Text
scopesMap) (WriterT [Issue 'SecuritySchemeLevel] Identity ()
 -> WriterT [Issue 'SecuritySchemeLevel] Identity ())
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
forall a b. (a -> b) -> a -> b
$ [Issue 'SecuritySchemeLevel]
-> WriterT [Issue 'SecuritySchemeLevel] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> Issue 'SecuritySchemeLevel
ScopeNotDefined Text
scope]
                pure $ OAuth2Flow t
x {_oAuth2Scopes :: InsOrdHashMap Text Text
_oAuth2Scopes = (Text -> Text -> Bool)
-> InsOrdHashMap Text Text -> InsOrdHashMap Text Text
forall k v.
(k -> v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
IOHM.filterWithKey (\Text
k Text
_ -> Text
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
scopes) InsOrdHashMap Text Text
scopesMap}
              scopedSchemeType :: [Text] -> SecuritySchemeType -> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
              scopedSchemeType :: [Text]
-> SecuritySchemeType
-> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
scopedSchemeType [Text]
scopes (SecuritySchemeOAuth2 (OAuth2Flows Maybe (OAuth2Flow OAuth2ImplicitFlow)
a Maybe (OAuth2Flow OAuth2PasswordFlow)
b Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
c Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
d)) =
                (OAuth2Flows -> SecuritySchemeType)
-> WriterT [Issue 'SecuritySchemeLevel] Identity OAuth2Flows
-> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OAuth2Flows -> SecuritySchemeType
SecuritySchemeOAuth2 (WriterT [Issue 'SecuritySchemeLevel] Identity OAuth2Flows
 -> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType)
-> WriterT [Issue 'SecuritySchemeLevel] Identity OAuth2Flows
-> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
forall a b. (a -> b) -> a -> b
$ Maybe (OAuth2Flow OAuth2ImplicitFlow)
-> Maybe (OAuth2Flow OAuth2PasswordFlow)
-> Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
-> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
-> OAuth2Flows
OAuth2Flows (Maybe (OAuth2Flow OAuth2ImplicitFlow)
 -> Maybe (OAuth2Flow OAuth2PasswordFlow)
 -> Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
 -> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
 -> OAuth2Flows)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2ImplicitFlow))
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2PasswordFlow)
      -> Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
      -> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
      -> OAuth2Flows)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (OAuth2Flow OAuth2ImplicitFlow)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2ImplicitFlow))
forall t.
Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
flow Maybe (OAuth2Flow OAuth2ImplicitFlow)
a WriterT
  [Issue 'SecuritySchemeLevel]
  Identity
  (Maybe (OAuth2Flow OAuth2PasswordFlow)
   -> Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
   -> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
   -> OAuth2Flows)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2PasswordFlow))
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
      -> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow) -> OAuth2Flows)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (OAuth2Flow OAuth2PasswordFlow)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2PasswordFlow))
forall t.
Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
flow Maybe (OAuth2Flow OAuth2PasswordFlow)
b WriterT
  [Issue 'SecuritySchemeLevel]
  Identity
  (Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
   -> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow) -> OAuth2Flows)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2ClientCredentialsFlow))
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow) -> OAuth2Flows)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2ClientCredentialsFlow))
forall t.
Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
flow Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
c WriterT
  [Issue 'SecuritySchemeLevel]
  Identity
  (Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow) -> OAuth2Flows)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow))
-> WriterT [Issue 'SecuritySchemeLevel] Identity OAuth2Flows
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow))
forall t.
Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
flow Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
d
                where
                  flow :: Maybe (OAuth2Flow t) -> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
                  flow :: Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
flow = (OAuth2Flow t
 -> WriterT [Issue 'SecuritySchemeLevel] Identity (OAuth2Flow t))
-> Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((OAuth2Flow t
  -> WriterT [Issue 'SecuritySchemeLevel] Identity (OAuth2Flow t))
 -> Maybe (OAuth2Flow t)
 -> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t)))
-> (OAuth2Flow t
    -> WriterT [Issue 'SecuritySchemeLevel] Identity (OAuth2Flow t))
-> Maybe (OAuth2Flow t)
-> Writer [Issue 'SecuritySchemeLevel] (Maybe (OAuth2Flow t))
forall a b. (a -> b) -> a -> b
$ Set Text
-> OAuth2Flow t
-> WriterT [Issue 'SecuritySchemeLevel] Identity (OAuth2Flow t)
forall t.
Set Text
-> OAuth2Flow t
-> Writer [Issue 'SecuritySchemeLevel] (OAuth2Flow t)
scopedFlow (Set Text
 -> OAuth2Flow t
 -> WriterT [Issue 'SecuritySchemeLevel] Identity (OAuth2Flow t))
-> Set Text
-> OAuth2Flow t
-> WriterT [Issue 'SecuritySchemeLevel] Identity (OAuth2Flow t)
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
scopes
              scopedSchemeType [Text]
_ SecuritySchemeType
x = SecuritySchemeType
-> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecuritySchemeType
x
              scopedScheme :: [Text]
-> SecurityScheme
-> WriterT [Issue 'SecuritySchemeLevel] Identity SecurityScheme
scopedScheme [Text]
scopes SecurityScheme
x = do
                SecuritySchemeType
sType <- [Text]
-> SecuritySchemeType
-> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
scopedSchemeType [Text]
scopes (SecuritySchemeType
 -> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType)
-> SecuritySchemeType
-> Writer [Issue 'SecuritySchemeLevel] SecuritySchemeType
forall a b. (a -> b) -> a -> b
$ SecurityScheme -> SecuritySchemeType
_securitySchemeType SecurityScheme
x
                pure $ SecurityScheme
x {_securitySchemeType :: SecuritySchemeType
_securitySchemeType = SecuritySchemeType
sType}
              (ProdCons (Traced SecurityScheme)
pc', [Issue 'SecuritySchemeLevel]
errs) = Writer
  [Issue 'SecuritySchemeLevel] (ProdCons (Traced SecurityScheme))
-> (ProdCons (Traced SecurityScheme), [Issue 'SecuritySchemeLevel])
forall w a. Writer w a -> (a, w)
runWriter (Writer
   [Issue 'SecuritySchemeLevel] (ProdCons (Traced SecurityScheme))
 -> (ProdCons (Traced SecurityScheme),
     [Issue 'SecuritySchemeLevel]))
-> Writer
     [Issue 'SecuritySchemeLevel] (ProdCons (Traced SecurityScheme))
-> (ProdCons (Traced SecurityScheme), [Issue 'SecuritySchemeLevel])
forall a b. (a -> b) -> a -> b
$ Traced SecurityScheme
-> Traced SecurityScheme -> ProdCons (Traced SecurityScheme)
forall a. a -> a -> ProdCons a
ProdCons (Traced SecurityScheme
 -> Traced SecurityScheme -> ProdCons (Traced SecurityScheme))
-> WriterT
     [Issue 'SecuritySchemeLevel] Identity (Traced SecurityScheme)
-> WriterT
     [Issue 'SecuritySchemeLevel]
     Identity
     (Traced SecurityScheme -> ProdCons (Traced SecurityScheme))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
-> SecurityScheme
-> WriterT [Issue 'SecuritySchemeLevel] Identity SecurityScheme
scopedScheme [Text]
pScopes (SecurityScheme
 -> WriterT [Issue 'SecuritySchemeLevel] Identity SecurityScheme)
-> Traced SecurityScheme
-> WriterT
     [Issue 'SecuritySchemeLevel] Identity (Traced SecurityScheme)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Traced SecurityScheme
pScheme WriterT
  [Issue 'SecuritySchemeLevel]
  Identity
  (Traced SecurityScheme -> ProdCons (Traced SecurityScheme))
-> WriterT
     [Issue 'SecuritySchemeLevel] Identity (Traced SecurityScheme)
-> Writer
     [Issue 'SecuritySchemeLevel] (ProdCons (Traced SecurityScheme))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Text]
-> SecurityScheme
-> WriterT [Issue 'SecuritySchemeLevel] Identity SecurityScheme
scopedScheme [Text]
cScopes (SecurityScheme
 -> WriterT [Issue 'SecuritySchemeLevel] Identity SecurityScheme)
-> Traced SecurityScheme
-> WriterT
     [Issue 'SecuritySchemeLevel] Identity (Traced SecurityScheme)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Traced SecurityScheme
cScheme
          case (SecuritySchemeType, SecuritySchemeType)
untracedSchemes of
            (SecuritySchemeOpenIdConnect URL
_, SecuritySchemeOpenIdConnect URL
_) -> do
              let missingScopes :: Set Text
missingScopes = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
cScopes Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.\\ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
pScopes
              Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Text -> Bool
forall a. Set a -> Bool
S.null Set Text
missingScopes) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Behavior 'SecuritySchemeLevel
-> Issue 'SecuritySchemeLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Behavior 'SecuritySchemeLevel
bhv (Set Text -> Issue 'SecuritySchemeLevel
ScopesMissing Set Text
missingScopes)
            (SecuritySchemeOAuth2 {}, SecuritySchemeOAuth2 {}) -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            (SecuritySchemeType, SecuritySchemeType)
_ -> Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
pScopes Bool -> Bool -> Bool
&& [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cScopes) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Behavior 'SecuritySchemeLevel
-> Issue 'SecuritySchemeLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Behavior 'SecuritySchemeLevel
bhv Issue 'SecuritySchemeLevel
CanNotHaveScopes
          [Issue 'SecuritySchemeLevel]
-> (Issue 'SecuritySchemeLevel
    -> CompatFormula' Behave AnIssue 'APILevel Any)
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Issue 'SecuritySchemeLevel]
errs ((Issue 'SecuritySchemeLevel
  -> CompatFormula' Behave AnIssue 'APILevel Any)
 -> SemanticCompatFormula ())
-> (Issue 'SecuritySchemeLevel
    -> CompatFormula' Behave AnIssue 'APILevel Any)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Behavior 'SecuritySchemeLevel
-> Issue 'SecuritySchemeLevel
-> CompatFormula' Behave AnIssue 'APILevel Any
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Behavior 'SecuritySchemeLevel
bhv
          Behavior (SubtreeLevel SecurityScheme)
-> HList
     '[ProdCons
         (EnvT
            (Trace (Definitions SecurityScheme))
            Identity
            (Definitions SecurityScheme))]
-> ProdCons (Traced SecurityScheme)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Behavior 'SecuritySchemeLevel
Behavior (SubtreeLevel SecurityScheme)
bhv HList
  '[ProdCons
      (EnvT
         (Trace (Definitions SecurityScheme))
         Identity
         (Definitions SecurityScheme))]
HList (CheckEnv SecurityRequirement)
env ProdCons (Traced SecurityScheme)
pc'
          pure ()
    pure ()

lookupScheme :: Text -> Traced (Definitions SecurityScheme) -> Maybe (Traced SecurityScheme)
lookupScheme :: Text
-> EnvT
     (Trace (Definitions SecurityScheme))
     Identity
     (Definitions SecurityScheme)
-> Maybe (Traced SecurityScheme)
lookupScheme Text
k (Traced Trace (Definitions SecurityScheme)
t Definitions SecurityScheme
m) = Trace SecurityScheme -> SecurityScheme -> Traced SecurityScheme
forall a b. Trace a -> b -> Traced' a b
Traced (Trace (Definitions SecurityScheme)
t Trace (Definitions SecurityScheme)
-> Paths Step (Definitions SecurityScheme) SecurityScheme
-> Trace SecurityScheme
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step (Definitions SecurityScheme) SecurityScheme
-> Paths Step (Definitions SecurityScheme) SecurityScheme
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Step (Definitions SecurityScheme) SecurityScheme
forall k v. k -> Step (InsOrdHashMap k v) v
InsOrdHashMapKeyStep Text
k)) (SecurityScheme -> Traced SecurityScheme)
-> Maybe SecurityScheme -> Maybe (Traced SecurityScheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Definitions SecurityScheme -> Maybe SecurityScheme
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
IOHM.lookup Text
k Definitions SecurityScheme
m