git.iko.soy/obelisk
on decrease-android-validity help sign in
obelisk/lib/snap-extras/src/Obelisk/Snap/Extras.hs
52 lines 1.9 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Obelisk.Snap.Extras
3 ( cachePermanently
4 , doNotCache
5 , serveFileIfExists
6 , serveFileIfExistsAs
7 ) where
9import Control.Monad.IO.Class
10import Data.ByteString (ByteString)
11import Data.Monoid
12import Data.String
13import Snap.Core
14import Snap.Util.FileServe
15import System.Directory
17-- | Set response header for "permanent" caching
18cachePermanently :: MonadSnap m => m ()
19cachePermanently = do
20 modifyResponse $ setHeader "Cache-Control" "public, max-age=315360000"
21 modifyResponse $ setHeader "Expires" "Tue, 01 Feb 2050 00:00:00 GMT" --TODO: This should be set to "approximately one year from the time the response is sent"
23-- | Set response header to not cache
24doNotCache :: MonadSnap m => m ()
25doNotCache = do
26 modifyResponse $ setHeader "Cache-Control" "no-cache, no-store, must-revalidate"
27 modifyResponse $ setHeader "Expires" "0"
29-- | Serves the specified file if it exists; otherwise, 'pass'es
30serveFileIfExists :: MonadSnap m => FilePath -> m ()
31serveFileIfExists f = do
32 exists <- liftIO $ doesFileExist f
33 if exists then serveFile f else pass
35-- | Like 'serveFileIfExists', but with a given MIME type
36serveFileIfExistsAs :: MonadSnap m => ByteString -> FilePath -> m ()
37serveFileIfExistsAs mimeType f = do
38 exists <- liftIO $ doesFileExist f
39 if exists then serveFileAs mimeType f else pass
41-- | Only run the given handler when the connection is "secure" (i.e. made with HTTPS)
42ensureSecure
43 :: MonadSnap m
44 => Int -- ^ The port where this server answers HTTPS requests
45 -> m () -- ^ A handler to be run only when the connection is secure
46 -> m ()
47ensureSecure port h = do
48 s <- getsRequest rqIsSecure
49 if s then h else do
50 uri <- getsRequest rqURI
51 host <- getsRequest rqHostName --TODO: It might be better to use the canonical base of the server
52 redirect $ "https://" <> host <> (if port == 443 then "" else ":" <> fromString (show port)) <> uri