{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module HTTP ( hostHeaderMissing , authenticationFailed , accessDenied , badRequest , mkResponse , mkTextResponse , mkHtmlResponse ) where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Network.HTTP.Types import Network.HTTP.Toolkit import Network.HTTP.Toolkit.Body import Text.InterpolatedString.Perl6 (qc) import qualified Logging as Log hostHeaderMissing :: Request a -> IO (Response BodyReader) hostHeaderMissing r = do Log.warn $ "Host header missing for request: " ++ show (requestMethod r, requestPath r, requestHeaders r) mkTextResponse badRequest400 "400 Bad Request" authenticationFailed :: String -> IO (Response BodyReader) authenticationFailed err = do Log.error err mkHtmlResponse internalServerError500 [qc| Authentication Failed

Authentication Failed

Authentication Failed for an unknown reason.

Try again!

|] accessDenied :: String -> IO (Response BodyReader) accessDenied email = mkHtmlResponse forbidden403 [qc| Access Denied

Access Denied

You are currently logged in as {email}.

logout

|] badRequest :: IO (Response BodyReader) badRequest = mkTextResponse badRequest400 "400 Bad Request" mkResponse :: Status -> [Header] -> ByteString -> IO (Response BodyReader) mkResponse status headers_ body = Response status headers <$> fromByteString body where headers = ("Content-Length", B.pack . show . B.length $ body) : headers_ mkTextResponse :: Status -> ByteString -> IO (Response BodyReader) mkTextResponse status = mkResponse status [("Content-Type", "text/plain")] mkHtmlResponse :: Status -> ByteString -> IO (Response BodyReader) mkHtmlResponse status = mkResponse status [("Content-Type", "text/html")]