-- | Timeout requests
module Network.Wai.Middleware.Timeout
    ( timeout
    , timeoutStatus
    , timeoutAs
    ) where

import Network.HTTP.Types (Status, status503)
import Network.Wai
import qualified System.Timeout as Timeout

-- | Time out the request after the given number of seconds
--
-- Timeouts respond with @'status503'@. See @'timeoutStatus'@ or @'timeoutAs'@
-- to customize the behavior of the timed-out case.
--
-- @since 3.0.24.0@
timeout :: Int -> Middleware
timeout :: Int -> Middleware
timeout = Status -> Int -> Middleware
timeoutStatus Status
status503

-- | Time out with the given @'Status'@
--
-- @since 3.0.24.0@
timeoutStatus :: Status -> Int -> Middleware
timeoutStatus :: Status -> Int -> Middleware
timeoutStatus Status
status = Response -> Int -> Middleware
timeoutAs (Response -> Int -> Middleware) -> Response -> Int -> Middleware
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status [] ByteString
""

-- | Time out with the given @'Response'@
--
-- @since 3.0.24.0@
timeoutAs :: Response -> Int -> Middleware
timeoutAs :: Response -> Int -> Middleware
timeoutAs Response
timeoutReponse Int
seconds Application
app Request
req Response -> IO ResponseReceived
respond =
    IO ResponseReceived
-> (ResponseReceived -> IO ResponseReceived)
-> Maybe ResponseReceived
-> IO ResponseReceived
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Response -> IO ResponseReceived
respond Response
timeoutReponse) ResponseReceived -> IO ResponseReceived
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Maybe ResponseReceived -> IO ResponseReceived)
-> IO (Maybe ResponseReceived) -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO ResponseReceived -> IO (Maybe ResponseReceived)
forall a. Int -> IO a -> IO (Maybe a)
Timeout.timeout (Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) (Application
app Request
req Response -> IO ResponseReceived
respond)