---------------------------------------------------------

---------------------------------------------------------

-- |
-- Module        : Network.Wai.Middleware.HealthCheckEndpoint
-- Copyright     : Michael Snoyman
-- License       : BSD3
--
-- Maintainer    : Michael Snoyman <michael@snoyman.com>
-- Stability     : Unstable
-- Portability   : portable
--
-- Add empty endpoint (for Health check tests)
module Network.Wai.Middleware.HealthCheckEndpoint (
    healthCheck,
    voidEndpoint,
)
where

import Data.ByteString (ByteString)
import Network.HTTP.Types (status200)
import Network.Wai

-- | Add empty endpoint (for Health check tests) called \"/_healthz\"
--
-- @since 3.1.9
healthCheck :: Middleware
healthCheck :: Middleware
healthCheck = ByteString -> Middleware
voidEndpoint ByteString
"/_healthz"

-- | Add empty endpoint
--
-- @since 3.1.9
voidEndpoint :: ByteString -> Middleware
voidEndpoint :: ByteString -> Middleware
voidEndpoint ByteString
endpointPath Application
router Request
request Response -> IO ResponseReceived
respond =
    if Request -> ByteString
rawPathInfo Request
request ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
endpointPath
        then Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 ResponseHeaders
forall a. Monoid a => a
mempty ByteString
"-"
        else Application
router Request
request Response -> IO ResponseReceived
respond