{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Hercules.API.Orphans where

import Control.Lens.Operators ((<>~))
import Data.Data (Typeable)
import Data.Function ((&), (.))
import Data.Maybe (Maybe (Just))
import Data.OpenApi qualified as O3
import Data.Proxy
import Data.Swagger
import Servant.API
import Servant.Auth (Auth, JWT)
import Servant.OpenApi qualified as SO3

-- | Ignores Headers.
--
-- FIXME: don't ignore headers
instance forall a hs. (ToSchema a) => ToSchema (Headers hs a) where
  declareNamedSchema :: Proxy (Headers hs a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Headers hs a)
_ = Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

-- | Ignores Headers.
--
-- FIXME: don't ignore headers
instance forall a hs. (O3.ToSchema a, Typeable hs) => O3.ToSchema (Headers hs a) where
  declareNamedSchema :: Proxy (Headers hs a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Headers hs a)
_ = Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
O3.declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance (SO3.HasOpenApi a) => SO3.HasOpenApi (Auth '[JWT] x :> a) where
  toOpenApi :: Proxy (Auth '[JWT] x :> a) -> OpenApi
toOpenApi Proxy (Auth '[JWT] x :> a)
_ =
    Proxy a -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
SO3.toOpenApi (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& ([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi -> Identity OpenApi
forall s a. HasSecurity s a => Lens' s a
Lens' OpenApi [SecurityRequirement]
O3.security
        (([SecurityRequirement] -> Identity [SecurityRequirement])
 -> OpenApi -> Identity OpenApi)
-> [SecurityRequirement] -> OpenApi -> OpenApi
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [ InsOrdHashMap Text [Text] -> SecurityRequirement
O3.SecurityRequirement [(Text
"jwt", [])]
            ]
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Components -> Identity Components) -> OpenApi -> Identity OpenApi
forall s a. HasComponents s a => Lens' s a
Lens' OpenApi Components
O3.components ((Components -> Identity Components)
 -> OpenApi -> Identity OpenApi)
-> ((SecurityDefinitions -> Identity SecurityDefinitions)
    -> Components -> Identity Components)
-> (SecurityDefinitions -> Identity SecurityDefinitions)
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SecurityDefinitions -> Identity SecurityDefinitions)
-> Components -> Identity Components
forall s a. HasSecuritySchemes s a => Lens' s a
Lens' Components SecurityDefinitions
O3.securitySchemes
        ((SecurityDefinitions -> Identity SecurityDefinitions)
 -> OpenApi -> Identity OpenApi)
-> SecurityDefinitions -> OpenApi -> OpenApi
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Definitions SecurityScheme -> SecurityDefinitions
O3.SecurityDefinitions
          [ ( Text
"jwt",
              SecuritySchemeType -> Maybe Text -> SecurityScheme
O3.SecurityScheme
                (HttpSchemeType -> SecuritySchemeType
O3.SecuritySchemeHttp (Maybe Text -> HttpSchemeType
O3.HttpSchemeBearer (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"jwt")))
                (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"JSON Web Token authentication")
            )
          ]