module PostgREST.Middleware where
import Control.Monad (unless)
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as M
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Data.Text
import Data.Time.Clock (NominalDiffTime)
import qualified Hasql.Transaction as H
import Network.HTTP.Types.Header (hAccept, hAuthorization)
import Network.HTTP.Types.Status (status400, status415)
import Network.Wai (Application, Request (..),
Response, requestHeaders)
import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Middleware.Gzip (def, gzip)
import Network.Wai.Middleware.Static (only, staticPolicy)
import PostgREST.ApiRequest (pickContentType)
import PostgREST.Auth (setRole, jwtClaims, claimsToSQL)
import PostgREST.Config (AppConfig (..), corsPolicy)
import PostgREST.Error (errResponse)
import Prelude hiding (concat, null)
runWithClaims :: AppConfig -> NominalDiffTime ->
(Request -> H.Transaction Response) ->
Request -> H.Transaction Response
runWithClaims conf time app req = do
H.sql setAnon
let tokenStr = case split (== ' ') (cs auth) of
("Bearer" : t : _) -> t
_ -> ""
eClaims = jwtClaims jwtSecret tokenStr time
case eClaims of
Left e -> clientErr e
Right claims ->
if M.null claims && not (null tokenStr)
then clientErr "Invalid JWT"
else do
let cmdBatch = mconcat $ claimsToSQL claims
unless (BS.null cmdBatch) (H.sql cmdBatch)
app req
where
hdrs = requestHeaders req
jwtSecret = configJwtSecret conf
auth = fromMaybe "" $ lookup hAuthorization hdrs
anon = cs $ configAnonRole conf
setAnon = setRole anon
clientErr = return . errResponse status400
unsupportedAccept :: Application -> Application
unsupportedAccept app req respond =
case accept of
Left _ -> respond $ errResponse status415 "Unsupported Accept header, try: application/json"
Right _ -> app req respond
where accept = pickContentType $ lookup hAccept $ requestHeaders req
defaultMiddle :: Application -> Application
defaultMiddle =
gzip def
. cors corsPolicy
. staticPolicy (only [("favicon.ico", "static/favicon.ico")])
. unsupportedAccept