module IHP.Controller.Response
( respondWith
, respondAndExit
, addResponseHeaders
, addResponseHeadersFromContext
-- Re-exported from Network.Wai.Middleware.EarlyReturn
, earlyReturn
, EarlyReturnException (..)
, responseHeadersVaultKey
)
where

import ClassyPrelude
import Network.HTTP.Types.Header
import qualified Network.Wai
import Network.Wai (Response, Request, ResponseReceived)
import Wai.Request.Params.Middleware (Respond)
import qualified Data.Vault.Lazy as Vault
import System.IO.Unsafe (unsafePerformIO)
import IHP.RequestVault.Helper (lookupRequestVault)
import Network.Wai.Middleware.EarlyReturn (earlyReturn, EarlyReturnException(..))

-- | Sends a response to the client. Used by render functions.
--
-- This is the normal way to respond - it calls the WAI respond callback directly
-- and returns the ResponseReceived.
respondWith :: (?request :: Request, ?respond :: Respond) => Response -> IO ResponseReceived
respondWith :: (?request::Request, ?respond::Respond) => Respond
respondWith Response
response = do
    responseWithHeaders <- (?request::Request) => Response -> IO Response
Response -> IO Response
addResponseHeadersFromContext Response
response
    ?respond responseWithHeaders
{-# INLINE respondWith #-}

-- | Add headers to current response
-- | Returns a Response with headers
--
-- > addResponseHeaders [("Content-Type", "text/html")] response
--
addResponseHeaders :: [Header] -> Response -> Response
addResponseHeaders :: ResponseHeaders -> Response -> Response
addResponseHeaders ResponseHeaders
headers = (ResponseHeaders -> ResponseHeaders) -> Response -> Response
Network.Wai.mapResponseHeaders (\ResponseHeaders
hs -> ResponseHeaders
headers ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
hs)
{-# INLINE addResponseHeaders #-}

-- | Add headers to current response, getting the headers from the request vault
-- | Returns a Response with headers
--
-- > addResponseHeadersFromContext response
-- You probabaly want `setHeader`
--
addResponseHeadersFromContext :: (?request :: Request) => Response -> IO Response
addResponseHeadersFromContext :: (?request::Request) => Response -> IO Response
addResponseHeadersFromContext Response
response = do
    headers <- IORef ResponseHeaders -> IO ResponseHeaders
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (Key (IORef ResponseHeaders) -> Request -> IORef ResponseHeaders
forall value. Typeable value => Key value -> Request -> value
lookupRequestVault Key (IORef ResponseHeaders)
responseHeadersVaultKey ?request::Request
Request
?request)
    let responseWithHeaders = ResponseHeaders -> Response -> Response
addResponseHeaders ResponseHeaders
headers Response
response
    pure responseWithHeaders
{-# INLINE addResponseHeadersFromContext #-}

responseHeadersVaultKey :: Vault.Key (IORef [Header])
responseHeadersVaultKey :: Key (IORef ResponseHeaders)
responseHeadersVaultKey = IO (Key (IORef ResponseHeaders)) -> Key (IORef ResponseHeaders)
forall a. IO a -> a
unsafePerformIO IO (Key (IORef ResponseHeaders))
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE responseHeadersVaultKey #-}

-- | Sends a response and exits the current action via early return.
-- Sends the response via 'respondWith' then throws 'EarlyReturnException'
-- so the action short-circuits.
respondAndExit :: (?request :: Request, ?respond :: Respond) => Response -> IO a
respondAndExit :: forall a.
(?request::Request, ?respond::Respond) =>
Response -> IO a
respondAndExit Response
response = IO ResponseReceived -> IO a
forall a. IO ResponseReceived -> IO a
earlyReturn ((?request::Request, ?respond::Respond) => Respond
Respond
respondWith Response
response)
{-# INLINE respondAndExit #-}