{-# LANGUAGE CPP #-}

module Prometheus.Servant.Internal
  ( Endpoint (..)
  , HasEndpoint (..)
  ) where

import Control.Monad (MonadPlus (..))
import Data.Hashable (Hashable (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import GHC.Types (Type)
import Network.HTTP.Types (Method)
import Network.Wai (Request (..))
import Servant.API

-- | Servant 'Endpoint'.
data Endpoint = Endpoint
  { Endpoint -> [Text]
ePathSegments :: [Text]
  -- ^ Path segments of an endpoint.
  , Endpoint -> Method
eMethod :: Method
  -- ^ Endpoint method.
  }
  deriving stock (Endpoint -> Endpoint -> Bool
(Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool) -> Eq Endpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
/= :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Endpoint -> ShowS
showsPrec :: Int -> Endpoint -> ShowS
$cshow :: Endpoint -> String
show :: Endpoint -> String
$cshowList :: [Endpoint] -> ShowS
showList :: [Endpoint] -> ShowS
Show, (forall x. Endpoint -> Rep Endpoint x)
-> (forall x. Rep Endpoint x -> Endpoint) -> Generic Endpoint
forall x. Rep Endpoint x -> Endpoint
forall x. Endpoint -> Rep Endpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Endpoint -> Rep Endpoint x
from :: forall x. Endpoint -> Rep Endpoint x
$cto :: forall x. Rep Endpoint x -> Endpoint
to :: forall x. Rep Endpoint x -> Endpoint
Generic)
  deriving anyclass (Eq Endpoint
Eq Endpoint
-> (Int -> Endpoint -> Int)
-> (Endpoint -> Int)
-> Hashable Endpoint
Int -> Endpoint -> Int
Endpoint -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Endpoint -> Int
hashWithSalt :: Int -> Endpoint -> Int
$chash :: Endpoint -> Int
hash :: Endpoint -> Int
Hashable)

-- | Specifies that @api@ has servant 'Endpoint'.
class HasEndpoint api where
  -- | Tries to get 'Endpoint' from 'Request' for given @api@.
  getEndpoint :: Proxy api -> Request -> Maybe Endpoint

  -- | Enumerates @api@ to get list of 'Endpoint's.
  enumerateEndpoints :: Proxy api -> [Endpoint]

instance HasEndpoint EmptyAPI where
  getEndpoint :: Proxy EmptyAPI -> Request -> Maybe Endpoint
getEndpoint Proxy EmptyAPI
_ Request
_ = Maybe Endpoint
forall a. Maybe a
Nothing

  enumerateEndpoints :: Proxy EmptyAPI -> [Endpoint]
enumerateEndpoints Proxy EmptyAPI
_ = []

instance HasEndpoint (ToServantApi sub) => HasEndpoint (NamedRoutes sub) where
  getEndpoint :: Proxy (NamedRoutes sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (NamedRoutes sub)
_ = Proxy (ToServantApi sub) -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy (ToServantApi sub)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ToServantApi sub))

  enumerateEndpoints :: Proxy (NamedRoutes sub) -> [Endpoint]
enumerateEndpoints Proxy (NamedRoutes sub)
_ = Proxy (ToServantApi sub) -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy (ToServantApi sub)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (ToServantApi sub))

instance (HasEndpoint (a :: Type), HasEndpoint (b :: Type)) => HasEndpoint (a :<|> b) where
  getEndpoint :: Proxy (a :<|> b) -> Request -> Maybe Endpoint
getEndpoint Proxy (a :<|> b)
_ Request
req =
    Proxy a -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Request
req
      Maybe Endpoint -> Maybe Endpoint -> Maybe Endpoint
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Proxy b -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b) Request
req

  enumerateEndpoints :: Proxy (a :<|> b) -> [Endpoint]
enumerateEndpoints Proxy (a :<|> b)
_ =
    Proxy a -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      [Endpoint] -> [Endpoint] -> [Endpoint]
forall a. Semigroup a => a -> a -> a
<> Proxy b -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

instance
  (KnownSymbol (path :: Symbol), HasEndpoint (sub :: Type))
  => HasEndpoint (path :> sub)
  where
  getEndpoint :: Proxy (path :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (path :> sub)
_ Request
req =
    case Request -> [Text]
pathInfo Request
req of
      Text
p : [Text]
ps | Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack (Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path)) -> do
        Endpoint{[Text]
Method
ePathSegments :: Endpoint -> [Text]
eMethod :: Endpoint -> Method
ePathSegments :: [Text]
eMethod :: Method
..} <- Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub) Request
req{pathInfo :: [Text]
pathInfo = [Text]
ps}
        Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ [Text] -> Method -> Endpoint
Endpoint (Text
p Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ePathSegments) Method
eMethod
      [Text]
_otherwise -> Maybe Endpoint
forall a. Maybe a
Nothing

  enumerateEndpoints :: Proxy (path :> sub) -> [Endpoint]
enumerateEndpoints Proxy (path :> sub)
_ = do
    let currentSegment :: Text
currentSegment = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path)
        qualify :: Endpoint -> Endpoint
qualify Endpoint{[Text]
Method
ePathSegments :: Endpoint -> [Text]
eMethod :: Endpoint -> Method
ePathSegments :: [Text]
eMethod :: Method
..} = [Text] -> Method -> Endpoint
Endpoint (Text
currentSegment Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ePathSegments) Method
eMethod
    (Endpoint -> Endpoint) -> [Endpoint] -> [Endpoint]
forall a b. (a -> b) -> [a] -> [b]
map Endpoint -> Endpoint
qualify ([Endpoint] -> [Endpoint]) -> [Endpoint] -> [Endpoint]
forall a b. (a -> b) -> a -> b
$ Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance
  (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: Type))
  => HasEndpoint (Capture' mods capture a :> sub)
  where
  getEndpoint :: Proxy (Capture' mods capture a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (Capture' mods capture a :> sub)
_ Request
req =
    case Request -> [Text]
pathInfo Request
req of
      Text
_ : [Text]
ps -> do
        Endpoint{[Text]
Method
ePathSegments :: Endpoint -> [Text]
eMethod :: Endpoint -> Method
ePathSegments :: [Text]
eMethod :: Method
..} <- Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub) Request
req{pathInfo :: [Text]
pathInfo = [Text]
ps}
        let p :: Text
p = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char
':' :) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy capture -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy capture
forall {k} (t :: k). Proxy t
Proxy :: Proxy capture)
        Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ [Text] -> Method -> Endpoint
Endpoint (Text
p Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ePathSegments) Method
eMethod
      [Text]
_otherwise -> Maybe Endpoint
forall a. Maybe a
Nothing

  enumerateEndpoints :: Proxy (Capture' mods capture a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (Capture' mods capture a :> sub)
_ = do
    let currentSegment :: Text
currentSegment = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char
':' :) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy capture -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy capture
forall {k} (t :: k). Proxy t
Proxy :: Proxy capture)
        qualify :: Endpoint -> Endpoint
qualify Endpoint{[Text]
Method
ePathSegments :: Endpoint -> [Text]
eMethod :: Endpoint -> Method
ePathSegments :: [Text]
eMethod :: Method
..} = [Text] -> Method -> Endpoint
Endpoint (Text
currentSegment Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ePathSegments) Method
eMethod
    (Endpoint -> Endpoint) -> [Endpoint] -> [Endpoint]
forall a b. (a -> b) -> [a] -> [b]
map Endpoint -> Endpoint
qualify ([Endpoint] -> [Endpoint]) -> [Endpoint] -> [Endpoint]
forall a b. (a -> b) -> a -> b
$ Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (Summary d :> sub) where
  getEndpoint :: Proxy (Summary d :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (Summary d :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (Summary d :> sub) -> [Endpoint]
enumerateEndpoints Proxy (Summary d :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (Description d :> sub) where
  getEndpoint :: Proxy (Description d :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (Description d :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (Description d :> sub) -> [Endpoint]
enumerateEndpoints Proxy (Description d :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (Header' mods h a :> sub) where
  getEndpoint :: Proxy (Header' mods h a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (Header' mods h a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (Header' mods h a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (Header' mods h a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

#if MIN_VERSION_servant(0,18,2)
instance HasEndpoint (sub :: Type) => HasEndpoint (Fragment a :> sub) where
  getEndpoint :: Proxy (Fragment a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (Fragment a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (Fragment a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (Fragment a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
#endif

instance
  HasEndpoint (sub :: Type)
  => HasEndpoint (QueryParam' mods (h :: Symbol) a :> sub)
  where
  getEndpoint :: Proxy (QueryParam' mods h a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (QueryParam' mods h a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (QueryParam' mods h a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (QueryParam' mods h a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (QueryParams (h :: Symbol) a :> sub) where
  getEndpoint :: Proxy (QueryParams h a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (QueryParams h a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (QueryParams h a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (QueryParams h a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (QueryFlag h :> sub) where
  getEndpoint :: Proxy (QueryFlag h :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (QueryFlag h :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (QueryFlag h :> sub) -> [Endpoint]
enumerateEndpoints Proxy (QueryFlag h :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (ReqBody' mods cts a :> sub) where
  getEndpoint :: Proxy (ReqBody' mods cts a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (ReqBody' mods cts a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (ReqBody' mods cts a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (ReqBody' mods cts a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

#if MIN_VERSION_servant(0,15,0)
instance HasEndpoint (sub :: Type) => HasEndpoint (StreamBody' mods framing cts a :> sub) where
  getEndpoint :: Proxy (StreamBody' mods framing cts a :> sub)
-> Request -> Maybe Endpoint
getEndpoint Proxy (StreamBody' mods framing cts a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (StreamBody' mods framing cts a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (StreamBody' mods framing cts a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
#endif

instance HasEndpoint (sub :: Type) => HasEndpoint (RemoteHost :> sub) where
  getEndpoint :: Proxy (RemoteHost :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (RemoteHost :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (RemoteHost :> sub) -> [Endpoint]
enumerateEndpoints Proxy (RemoteHost :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (IsSecure :> sub) where
  getEndpoint :: Proxy (IsSecure :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (IsSecure :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (IsSecure :> sub) -> [Endpoint]
enumerateEndpoints Proxy (IsSecure :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (HttpVersion :> sub) where
  getEndpoint :: Proxy (HttpVersion :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (HttpVersion :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (HttpVersion :> sub) -> [Endpoint]
enumerateEndpoints Proxy (HttpVersion :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (Vault :> sub) where
  getEndpoint :: Proxy (Vault :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (Vault :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (Vault :> sub) -> [Endpoint]
enumerateEndpoints Proxy (Vault :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (WithNamedContext x y sub) where
  getEndpoint :: Proxy (WithNamedContext x y sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (WithNamedContext x y sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (WithNamedContext x y sub) -> [Endpoint]
enumerateEndpoints Proxy (WithNamedContext x y sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance ReflectMethod method => HasEndpoint (Verb method status cts a) where
  getEndpoint :: Proxy (Verb method status cts a) -> Request -> Maybe Endpoint
getEndpoint Proxy (Verb method status cts a)
_ Request
req = case Request -> [Text]
pathInfo Request
req of
    [] | Request -> Method
requestMethod Request
req Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
method -> Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just ([Text] -> Method -> Endpoint
Endpoint [] Method
method)
    [Text]
_otherwise -> Maybe Endpoint
forall a. Maybe a
Nothing
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)

  enumerateEndpoints :: Proxy (Verb method status cts a) -> [Endpoint]
enumerateEndpoints Proxy (Verb method status cts a)
_ = [[Text] -> Method -> Endpoint
Endpoint [Text]
forall a. Monoid a => a
mempty Method
method]
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)

#if MIN_VERSION_servant(0,5,0)
instance HasEndpoint (sub :: Type) => HasEndpoint (AuthProtect a :> sub) where
  getEndpoint :: Proxy (AuthProtect a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (AuthProtect a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (AuthProtect a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (AuthProtect a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
#endif

#if MIN_VERSION_servant(0,17,0)
instance ReflectMethod method => HasEndpoint (NoContentVerb method) where
  getEndpoint :: Proxy (NoContentVerb method) -> Request -> Maybe Endpoint
getEndpoint Proxy (NoContentVerb method)
_ Request
req = case Request -> [Text]
pathInfo Request
req of
    [] | Request -> Method
requestMethod Request
req Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
method -> Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just ([Text] -> Method -> Endpoint
Endpoint [] Method
method)
    [Text]
_ -> Maybe Endpoint
forall a. Maybe a
Nothing
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)

  enumerateEndpoints :: Proxy (NoContentVerb method) -> [Endpoint]
enumerateEndpoints Proxy (NoContentVerb method)
_ = [[Text] -> Method -> Endpoint
Endpoint [Text]
forall a. Monoid a => a
mempty Method
method]
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
#endif

#if MIN_VERSION_servant(0,18,1)
instance ReflectMethod method => HasEndpoint (UVerb method contentType as) where
  getEndpoint :: Proxy (UVerb method contentType as) -> Request -> Maybe Endpoint
getEndpoint Proxy (UVerb method contentType as)
_ Request
req = case Request -> [Text]
pathInfo Request
req of
    [] | Request -> Method
requestMethod Request
req Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
method -> Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just ([Text] -> Method -> Endpoint
Endpoint [] Method
method)
    [Text]
_ -> Maybe Endpoint
forall a. Maybe a
Nothing
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)

  enumerateEndpoints :: Proxy (UVerb method contentType as) -> [Endpoint]
enumerateEndpoints Proxy (UVerb method contentType as)
_ = [[Text] -> Method -> Endpoint
Endpoint [Text]
forall a. Monoid a => a
mempty Method
method]
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
#endif

instance ReflectMethod method => HasEndpoint (Stream method status framing ct a) where
  getEndpoint :: Proxy (Stream method status framing ct a)
-> Request -> Maybe Endpoint
getEndpoint Proxy (Stream method status framing ct a)
_ Request
req = case Request -> [Text]
pathInfo Request
req of
    [] | Request -> Method
requestMethod Request
req Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
method -> Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just ([Text] -> Method -> Endpoint
Endpoint [] Method
method)
    [Text]
_ -> Maybe Endpoint
forall a. Maybe a
Nothing
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)

  enumerateEndpoints :: Proxy (Stream method status framing ct a) -> [Endpoint]
enumerateEndpoints Proxy (Stream method status framing ct a)
_ = [[Text] -> Method -> Endpoint
Endpoint [Text]
forall a. Monoid a => a
mempty Method
method]
    where
      method :: Method
method = Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall {k} (t :: k). Proxy t
Proxy :: Proxy method)

instance HasEndpoint Raw where
  getEndpoint :: Proxy Raw -> Request -> Maybe Endpoint
getEndpoint Proxy Raw
_ Request
_ = Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just ([Text] -> Method -> Endpoint
Endpoint [] Method
"RAW")

  enumerateEndpoints :: Proxy Raw -> [Endpoint]
enumerateEndpoints Proxy Raw
_ = [[Text] -> Method -> Endpoint
Endpoint [] Method
"RAW"]

instance HasEndpoint (sub :: Type) => HasEndpoint (CaptureAll (h :: Symbol) a :> sub) where
  getEndpoint :: Proxy (CaptureAll h a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (CaptureAll h a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (CaptureAll h a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (CaptureAll h a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance HasEndpoint (sub :: Type) => HasEndpoint (BasicAuth (realm :: Symbol) a :> sub) where
  getEndpoint :: Proxy (BasicAuth realm a :> sub) -> Request -> Maybe Endpoint
getEndpoint Proxy (BasicAuth realm a :> sub)
_ = Proxy sub -> Request -> Maybe Endpoint
forall {k} (api :: k).
HasEndpoint api =>
Proxy api -> Request -> Maybe Endpoint
getEndpoint (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

  enumerateEndpoints :: Proxy (BasicAuth realm a :> sub) -> [Endpoint]
enumerateEndpoints Proxy (BasicAuth realm a :> sub)
_ = Proxy sub -> [Endpoint]
forall {k} (api :: k). HasEndpoint api => Proxy api -> [Endpoint]
enumerateEndpoints (Proxy sub
forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)