diff --git a/Spock.cabal b/Spock.cabal --- a/Spock.cabal +++ b/Spock.cabal @@ -1,5 +1,5 @@ name: Spock -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Another Haskell web toolkit based on scotty description: This toolbox provides everything you need to get a quick start into web hacking with haskell: sessions, database helper, authentication and the power of scotty Homepage: https://github.com/agrafix/Spock @@ -13,7 +13,7 @@ cabal-version: >=1.8 library - exposed-modules: Web.Spock, Web.Spock.StaticMiddleware + exposed-modules: Web.Spock other-modules: Web.Spock.SessionManager, Web.Spock.Monad build-depends: base >= 4 && < 5, scotty >= 0.5, wai, filepath, directory, http-types, text, containers, bytestring, mtl, wai-extra, resourcet, stm, crypto-api == 0.10.*, unordered-containers, old-locale, base64-bytestring, time, monad-control, transformers, cryptohash, xsd, aeson, resource-pool diff --git a/Web/Spock/StaticMiddleware.hs b/Web/Spock/StaticMiddleware.hs deleted file mode 100644 --- a/Web/Spock/StaticMiddleware.hs +++ /dev/null @@ -1,207 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | Serve static files, subject to a policy that can filter or --- modify incoming URIs. The flow is: --- --- incoming request URI ==> policies ==> exists? ==> respond --- --- If any of the polices fail, or the file doesn't --- exist, then the middleware gives up and calls the inner application. --- If the file is found, the middleware chooses a content type based --- on the file extension and returns the file contents as the response. --- Stolen from: --- https://github.com/xich/scotty/blob/master/Network/Wai/Middleware/Static.hs -module Web.Spock.StaticMiddleware - ( -- * Middlewares - static, staticPolicy - , -- * Policies - Policy, (<|>), (>->), policy, predicate - , addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, only - , -- * Utilities - tryPolicy - ) where - -import Control.Monad.Trans (liftIO) -import qualified Data.ByteString as B -import Data.List -import qualified Data.Map as M -import Data.Maybe (fromMaybe) -import Data.Monoid -import qualified Data.Text as T - -import Network.HTTP.Types (status200) -import System.Directory (doesFileExist) -import qualified System.FilePath as FP - -import Network.Wai - --- | Take an incoming URI and optionally modify or filter it. --- The result will be treated as a filepath. -newtype Policy = Policy { tryPolicy :: String -> Maybe String -- ^ Run a policy - } - --- | Note: --- 'mempty' == @policy Just@ (the always accepting policy) --- 'mappend' == @>->@ (policy sequencing) -instance Monoid Policy where - mempty = policy Just - mappend p1 p2 = policy (maybe Nothing (tryPolicy p2) . tryPolicy p1) - --- | Lift a function into a 'Policy' -policy :: (String -> Maybe String) -> Policy -policy = Policy - --- | Lift a predicate into a 'Policy' -predicate :: (String -> Bool) -> Policy -predicate p = policy (\s -> if p s then Just s else Nothing) - --- | Sequence two policies. They are run from left to right. (Note: this is `mappend`) -infixr 5 >-> -(>->) :: Policy -> Policy -> Policy -(>->) = mappend - --- | Choose between two policies. If the first fails, run the second. -infixr 4 <|> -(<|>) :: Policy -> Policy -> Policy -p1 <|> p2 = policy (\s -> maybe (tryPolicy p2 s) Just (tryPolicy p1 s)) - --- | Add a base path to the URI --- --- > staticPolicy (addBase "/home/user/files") --- --- GET \"foo\/bar\" looks for \"\/home\/user\/files\/foo\/bar\" --- -addBase :: String -> Policy -addBase b = policy (Just . (b FP.)) - --- | Add an initial slash to to the URI, if not already present. --- --- > staticPolicy addSlash --- --- GET \"foo\/bar\" looks for \"\/foo\/bar\" -addSlash :: Policy -addSlash = policy slashOpt - where slashOpt s@('/':_) = Just s - slashOpt s = Just ('/':s) - --- | Accept only URIs with given suffix -hasSuffix :: String -> Policy -hasSuffix suf = predicate (isSuffixOf suf) - --- | Accept only URIs with given prefix -hasPrefix :: String -> Policy -hasPrefix pre = predicate (isPrefixOf pre) - --- | Accept only URIs containing given string -contains :: String -> Policy -contains s = predicate (isInfixOf s) - --- | Reject URIs containing \"..\" -noDots :: Policy -noDots = predicate (not . isInfixOf "..") - --- | Use URI as the key to an association list, rejecting those not found. --- The policy result is the matching value. --- --- > staticPolicy (only [("foo/bar", "/home/user/files/bar")]) --- --- GET \"foo\/bar\" looks for \"\/home\/user\/files\/bar\" --- GET \"baz\/bar\" doesn't match anything --- -only :: [(String,String)] -> Policy -only al = policy (flip lookup al) - --- | Serve static files out of the application root (current directory). --- If file is found, it is streamed to the client and no further middleware is run. -static :: Middleware -static = staticPolicy mempty - --- | Serve static files subject to a 'Policy' -staticPolicy :: Policy -> Middleware -staticPolicy p app req = - maybe (app req) - (\fp -> do exists <- liftIO $ doesFileExist fp - if exists - then return $ ResponseFile status200 - [("Content-Type", getMimeType fp)] - fp - Nothing - else app req) - (tryPolicy p $ T.unpack $ T.intercalate "/" $ pathInfo req) - -type Ascii = B.ByteString - -getMimeType :: FilePath -> Ascii -getMimeType = go . extensions - where go [] = defaultMimeType - go (ext:exts) = fromMaybe (go exts) $ M.lookup ext defaultMimeTypes - -extensions :: FilePath -> [String] -extensions [] = [] -extensions fp = case dropWhile (/= '.') fp of - [] -> [] - s -> let ext = tail s - in ext : extensions ext - -defaultMimeType :: Ascii -defaultMimeType = "application/octet-stream" - --- This list taken from snap-core's Snap.Util.FileServe -defaultMimeTypes :: M.Map String Ascii -defaultMimeTypes = M.fromList [ - ( "asc" , "text/plain" ), - ( "asf" , "video/x-ms-asf" ), - ( "asx" , "video/x-ms-asf" ), - ( "avi" , "video/x-msvideo" ), - ( "bz2" , "application/x-bzip" ), - ( "c" , "text/plain" ), - ( "class" , "application/octet-stream" ), - ( "conf" , "text/plain" ), - ( "cpp" , "text/plain" ), - ( "css" , "text/css" ), - ( "cxx" , "text/plain" ), - ( "dtd" , "text/xml" ), - ( "dvi" , "application/x-dvi" ), - ( "gif" , "image/gif" ), - ( "gz" , "application/x-gzip" ), - ( "hs" , "text/plain" ), - ( "htm" , "text/html" ), - ( "html" , "text/html" ), - ( "jar" , "application/x-java-archive" ), - ( "jpeg" , "image/jpeg" ), - ( "jpg" , "image/jpeg" ), - ( "js" , "text/javascript" ), - ( "json" , "application/json" ), - ( "log" , "text/plain" ), - ( "m3u" , "audio/x-mpegurl" ), - ( "mov" , "video/quicktime" ), - ( "mp3" , "audio/mpeg" ), - ( "mpeg" , "video/mpeg" ), - ( "mpg" , "video/mpeg" ), - ( "ogg" , "application/ogg" ), - ( "pac" , "application/x-ns-proxy-autoconfig" ), - ( "pdf" , "application/pdf" ), - ( "png" , "image/png" ), - ( "ps" , "application/postscript" ), - ( "qt" , "video/quicktime" ), - ( "sig" , "application/pgp-signature" ), - ( "spl" , "application/futuresplash" ), - ( "svg" , "image/svg+xml" ), - ( "swf" , "application/x-shockwave-flash" ), - ( "tar" , "application/x-tar" ), - ( "tar.bz2" , "application/x-bzip-compressed-tar" ), - ( "tar.gz" , "application/x-tgz" ), - ( "tbz" , "application/x-bzip-compressed-tar" ), - ( "text" , "text/plain" ), - ( "tgz" , "application/x-tgz" ), - ( "torrent" , "application/x-bittorrent" ), - ( "ttf" , "application/x-font-truetype" ), - ( "txt" , "text/plain" ), - ( "wav" , "audio/x-wav" ), - ( "wax" , "audio/x-ms-wax" ), - ( "wma" , "audio/x-ms-wma" ), - ( "wmv" , "video/x-ms-wmv" ), - ( "xbm" , "image/x-xbitmap" ), - ( "xml" , "text/xml" ), - ( "xpm" , "image/x-xpixmap" ), - ( "xwd" , "image/x-xwindowdump" ), - ( "zip" , "application/zip" ) ]