{-# OPTIONS_GHC -fno-warn-orphans #-}

module Servant.Auth.OrphanInstances () where

import Control.Lens
import Data.HashMap.Strict.InsOrd qualified as HM
import Data.OpenApi
import Data.Proxy
import Data.Text qualified as T
import Servant.API
import Servant.Auth qualified
import Servant.Auth.JWT.WithSession
import Servant.OpenApi

instance HasOpenApi api => HasOpenApi (Servant.Auth.Auth '[] a :> api) where
  toOpenApi :: Proxy (Auth '[] a :> api) -> OpenApi
toOpenApi Proxy (Auth '[] a :> api)
Proxy = Proxy api -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy api -> OpenApi) -> Proxy api -> OpenApi
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api

instance HasOpenApi (Servant.Auth.Auth auths a :> api) => HasOpenApi (Servant.Auth.Auth (Servant.Auth.BasicAuth : auths) a :> api) where
  toOpenApi :: Proxy (Auth (BasicAuth : auths) a :> api) -> OpenApi
toOpenApi Proxy (Auth (BasicAuth : auths) a :> api)
Proxy = OpenApi -> OpenApi
addSecurity (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall a b. (a -> b) -> a -> b
$ Proxy (Auth auths a :> api) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Auth auths a :> api) -> OpenApi)
-> Proxy (Auth auths a :> api) -> OpenApi
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Servant.Auth.Auth auths a :> api)
   where
    addSecurity :: OpenApi -> OpenApi
addSecurity = Text -> OpenApi -> OpenApi
addSecurityRequirement Text
identifier (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
identifier SecurityScheme
securityScheme
    Text
identifier :: T.Text = Text
"BasicAuth"
    securityScheme :: SecurityScheme
securityScheme =
      SecurityScheme
        { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp HttpSchemeType
HttpSchemeBasic
        , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Basic Authentication"
        }

instance HasOpenApi (Servant.Auth.Auth auths a :> api) => HasOpenApi (Servant.Auth.Auth (Servant.Auth.JWT : auths) a :> api) where
  toOpenApi :: Proxy (Auth (JWT : auths) a :> api) -> OpenApi
toOpenApi Proxy (Auth (JWT : auths) a :> api)
Proxy = OpenApi -> OpenApi
addSecurity (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall a b. (a -> b) -> a -> b
$ Proxy (Auth auths a :> api) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Auth auths a :> api) -> OpenApi)
-> Proxy (Auth auths a :> api) -> OpenApi
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Servant.Auth.Auth auths a :> api)
   where
    addSecurity :: OpenApi -> OpenApi
addSecurity = Text -> OpenApi -> OpenApi
addSecurityRequirement Text
identifier (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
identifier SecurityScheme
securityScheme
    Text
identifier :: T.Text = Text
"JWT"
    securityScheme :: SecurityScheme
securityScheme =
      SecurityScheme
        { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp (HttpSchemeType -> SecuritySchemeType)
-> HttpSchemeType -> SecuritySchemeType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> HttpSchemeType
HttpSchemeBearer (Maybe Text -> HttpSchemeType) -> Maybe Text -> HttpSchemeType
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"JWT"
        , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bearer Authentication"
        }

instance HasOpenApi (Servant.Auth.Auth auths a :> api) => HasOpenApi (Servant.Auth.Auth (JWTWithSession : auths) a :> api) where
  toOpenApi :: Proxy (Auth (JWTWithSession : auths) a :> api) -> OpenApi
toOpenApi Proxy (Auth (JWTWithSession : auths) a :> api)
Proxy = Proxy (Auth (JWT : auths) a :> api) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Auth (JWT : auths) a :> api) -> OpenApi)
-> Proxy (Auth (JWT : auths) a :> api) -> OpenApi
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Servant.Auth.Auth (Servant.Auth.JWT : auths) a :> api)

instance HasOpenApi (Servant.Auth.Auth auths a :> api) => HasOpenApi (Servant.Auth.Auth (Servant.Auth.Cookie : auths) a :> api) where
  toOpenApi :: Proxy (Auth (Cookie : auths) a :> api) -> OpenApi
toOpenApi Proxy (Auth (Cookie : auths) a :> api)
Proxy = OpenApi -> OpenApi
addSecurity (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall a b. (a -> b) -> a -> b
$ Proxy (Auth auths a :> api) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (Auth auths a :> api) -> OpenApi)
-> Proxy (Auth auths a :> api) -> OpenApi
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Servant.Auth.Auth auths a :> api)
   where
    addSecurity :: OpenApi -> OpenApi
addSecurity = Text -> OpenApi -> OpenApi
addSecurityRequirement Text
identifier (OpenApi -> OpenApi) -> (OpenApi -> OpenApi) -> OpenApi -> OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
identifier SecurityScheme
securityScheme
    Text
identifier :: T.Text = Text
"Cookie"
    securityScheme :: SecurityScheme
securityScheme =
      SecurityScheme
        { _securitySchemeType :: SecuritySchemeType
_securitySchemeType = HttpSchemeType -> SecuritySchemeType
SecuritySchemeHttp (HttpSchemeType -> SecuritySchemeType)
-> HttpSchemeType -> SecuritySchemeType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> HttpSchemeType
HttpSchemeBearer (Maybe Text -> HttpSchemeType) -> Maybe Text -> HttpSchemeType
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"JWT"
        , _securitySchemeDescription :: Maybe Text
_securitySchemeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Cookie Authentication"
        }

addSecurityScheme :: T.Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme :: Text -> SecurityScheme -> OpenApi -> OpenApi
addSecurityScheme Text
securityIdentifier SecurityScheme
securityScheme OpenApi
openApi =
  OpenApi
openApi
    { _openApiComponents =
        (_openApiComponents openApi)
          { _componentsSecuritySchemes =
              _componentsSecuritySchemes (_openApiComponents openApi)
                <> SecurityDefinitions (HM.singleton securityIdentifier securityScheme)
          }
    }

addSecurityRequirement :: T.Text -> OpenApi -> OpenApi
addSecurityRequirement :: Text -> OpenApi -> OpenApi
addSecurityRequirement Text
securityRequirement =
  (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations
    ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> (([SecurityRequirement] -> Identity [SecurityRequirement])
    -> Operation -> Identity Operation)
-> ([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SecurityRequirement] -> Identity [SecurityRequirement])
-> Operation -> Identity Operation
forall s a. HasSecurity s a => Lens' s a
Lens' Operation [SecurityRequirement]
security
    (([SecurityRequirement] -> Identity [SecurityRequirement])
 -> OpenApi -> Identity OpenApi)
-> ([SecurityRequirement] -> [SecurityRequirement])
-> OpenApi
-> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((InsOrdHashMap Text [Text] -> SecurityRequirement
SecurityRequirement (InsOrdHashMap Text [Text] -> SecurityRequirement)
-> InsOrdHashMap Text [Text] -> SecurityRequirement
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> InsOrdHashMap Text [Text]
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
HM.singleton Text
securityRequirement []) :)