yesod-static 0.3.2.1 → 0.10.1
raw patch · 4 files changed
+129/−108 lines, 4 filesdep +conduitdep +crypto-conduitdep +cryptohashdep −enumeratordep −pureMD5dep ~basedep ~textdep ~wai
Dependencies added: conduit, crypto-conduit, cryptohash
Dependencies removed: enumerator, pureMD5
Dependency ranges changed: base, text, wai, wai-app-static, yesod-core
Files
- Yesod/Static.hs +102/−75
- test/tests.hs +7/−0
- tests.hs +0/−7
- yesod-static.cabal +20/−26
Yesod/Static.hs view
@@ -9,20 +9,28 @@ -- -- | Serve static files from a Yesod app. ----- This is great for developming your application, but also for a dead-simple deployment.--- Caching headers are automatically taken care of.+-- This is great for developing your application, but also for a+-- dead-simple deployment. Caching headers are automatically+-- taken care of. -- -- If you are running a proxy server (like Apache or Nginx), -- you may want to have that server do the static serving instead. ----- In fact, in an ideal setup you'll serve your static files from a separate--- domain name to save time on transmitting cookies. In that case, you may wish--- to use 'urlRenderOverride' to redirect requests to this subsite to a--- separate domain name.+-- In fact, in an ideal setup you'll serve your static files from+-- a separate domain name to save time on transmitting+-- cookies. In that case, you may wish to use 'urlRenderOverride'+-- to redirect requests to this subsite to a separate domain+-- name.+--+-- Note that this module's static subsite ignores all files and+-- directories that are hidden by Unix conventions (i.e. start+-- with a dot, such as @\".ssh\"@) and the directory "tmp" on the+-- root of the directory with static files. module Yesod.Static ( -- * Subsite Static (..)- , StaticRoute (..)+ , Route (..)+ , StaticRoute -- * Smart constructor , static , staticDevel@@ -33,29 +41,29 @@ , publicFiles -- * Hashing , base64md5-#ifdef TEST- , getFileListPieces +#ifdef TEST_EXPORT+ , getFileListPieces #endif ) where import Prelude hiding (FilePath) import qualified Prelude import System.Directory---import qualified System.Time import Control.Monad import Data.FileEmbed (embedDir) -import Yesod.Handler-import Yesod.Core+import Yesod.Core hiding (lift) import Data.List (intercalate) import Language.Haskell.TH import Language.Haskell.TH.Syntax -import qualified Data.ByteString.Lazy as L-import Data.Digest.Pure.MD5+import Crypto.Conduit (hashFile, sinkHash)+import Crypto.Hash.MD5 (MD5)+ import qualified Data.ByteString.Base64 import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L import qualified Data.Serialize import Data.Text (Text, pack) import Data.Monoid (mempty)@@ -68,9 +76,9 @@ import Network.HTTP.Types (status301) import System.PosixCompat.Files (getFileStatus, modificationTime) import System.Posix.Types (EpochTime)-import qualified Data.Enumerator as E-import qualified Data.Enumerator.List as EL-import qualified Data.Enumerator.Binary as EB+import Data.Conduit (($$), runResourceT)+import Data.Conduit.List (sourceList)+import Control.Monad.ST (runST) import Network.Wai.Application.Static ( StaticSettings (..)@@ -85,54 +93,64 @@ , webAppSettingsWithLookup ) +-- | Type used for the subsite with static contents. newtype Static = Static StaticSettings --- | Default value of 'Static' for a given file folder.+type StaticRoute = Route Static++-- | Produce a default value of 'Static' for a given file+-- folder. ----- Does not have index files or directory listings.--- Expects static files to *never* change+-- Does not have index files or directory listings. The static+-- files' contents /must not/ change, however new files can be+-- added. static :: Prelude.FilePath -> IO Static static dir = do hashLookup <- cachedETagLookup dir return $ Static $ webAppSettingsWithLookup (toFilePath dir) hashLookup --- | like static, but checks to see if the file has changed+-- | Same as 'static', but does not assumes that the files do not+-- change and checks their modification time whenever a request+-- is made. staticDevel :: Prelude.FilePath -> IO Static staticDevel dir = do hashLookup <- cachedETagLookupDevel dir return $ Static $ webAppSettingsWithLookup (toFilePath dir) hashLookup --- | Produces a 'Static' based on embedding file contents in the executable at--- compile time.+-- | Produce a 'Static' based on embedding all of the static+-- files' contents in the executable at compile time. embed :: Prelude.FilePath -> Q Exp embed fp = [|Static (defaultWebAppSettings { ssFolder = embeddedLookup (toEmbedded $(embedDir fp)) })|] ---- | Manually construct a static route.--- The first argument is a sub-path to the file being served whereas the second argument is the key value pairs in the query string.--- For example,--- > StaticRoute $ StaticR ["thumb001.jpg"] [("foo", "5"), ("bar", "choc")]--- would generate a url such as 'http://site.com/static/thumb001.jpg?foo=5&bar=choc'--- The StaticRoute constructor can be used when url's cannot be statically generated at compile-time.--- E.g. When generating image galleries.-data StaticRoute = StaticRoute [Text] [(Text, Text)]- deriving (Eq, Show, Read)--type instance Route Static = StaticRoute--instance RenderRoute StaticRoute where+instance RenderRoute Static where+ -- | A route on the static subsite (see also 'staticFiles').+ --+ -- You may use this constructor directly to manually link to a+ -- static file. The first argument is the sub-path to the file+ -- being served whereas the second argument is the key-value+ -- pairs in the query string. For example,+ --+ -- > StaticRoute $ StaticR [\"thumb001.jpg\"] [(\"foo\", \"5\"), (\"bar\", \"choc\")]+ --+ -- would generate a url such as+ -- @http://www.example.com/static/thumb001.jpg?foo=5&bar=choc@+ -- The StaticRoute constructor can be used when the URL cannot be+ -- statically generated at compile-time (e.g. when generating+ -- image galleries).+ data Route Static = StaticRoute [Text] [(Text, Text)]+ deriving (Eq, Show, Read) renderRoute (StaticRoute x y) = (x, y) instance Yesod master => YesodDispatch Static master where -- Need to append trailing slash to make relative links work- yesodDispatch _ _ [] _ _ = Just $- \req -> return $ responseLBS status301 [("Location", rawPathInfo req `S.append` "/")] ""+ yesodDispatch _ _ _ _ _ _ [] _ req =+ return $ responseLBS status301 [("Location", rawPathInfo req `S.append` "/")] "" - yesodDispatch (Static set) _ textPieces _ _ = Just $- \req -> staticApp set req { pathInfo = textPieces }+ yesodDispatch _ (Static set) _ _ _ _ textPieces _ req =+ staticApp set req { pathInfo = textPieces } notHidden :: Prelude.FilePath -> Bool notHidden "tmp" = False@@ -155,22 +173,36 @@ dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs return $ concat $ files' : dirs' --- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create:+-- | Template Haskell function that automatically creates routes+-- for all of your static files. ----- > style_css = StaticRoute ["style.css"] []+-- For example, if you used+--+-- > staticFiles "static/"+--+-- and you had files @\"static\/style.css\"@ and+-- @\"static\/js\/script.js\"@, then the following top-level+-- definitions would be created:+--+-- > style_css = StaticRoute ["style.css"] [] -- > js_script_js = StaticRoute ["js/script.js"] []+--+-- Note that dots (@.@), dashes (@-@) and slashes (@\/@) are+-- replaced by underscores (@\_@) to create valid Haskell+-- identifiers. staticFiles :: Prelude.FilePath -> Q [Dec] staticFiles dir = mkStaticFiles dir --- | Same as 'staticFiles', but takes an explicit list of files to create--- identifiers for. The files are given relative to the static folder. For--- example, to get the files \"static/js/jquery.js\" and--- \"static/css/normalize.css\", you would use:+-- | Same as 'staticFiles', but takes an explicit list of files+-- to create identifiers for. The files path given are relative+-- to the static folder. For example, to create routes for the+-- files @\"static\/js\/jquery.js\"@ and+-- @\"static\/css\/normalize.css\"@, you would use: ----- > staticFilesList "static" ["js/jquery.js"], ["css/normalize.css"]]+-- > staticFilesList \"static\" [\"js\/jquery.js\", \"css\/normalize.css\"] ----- This can be useful when you have a very large number of static files, but--- only need to refer to a few of them from Haskell.+-- This can be useful when you have a very large number of static+-- files, but only need to refer to a few of them from Haskell. staticFilesList :: Prelude.FilePath -> [Prelude.FilePath] -> Q [Dec] staticFilesList dir fs = mkStaticFilesList dir (map split fs) "StaticRoute" True@@ -181,9 +213,16 @@ let (a, b) = break (== '/') x in a : split (drop 1 b) --- | like staticFiles, but doesn't append an etag to the query string--- This will compile faster, but doesn't achieve as great of caching.--- The browser can avoid downloading the file, but it always needs to send a request with the etag value or the last-modified value to the server to see if its copy is up to dat+-- | Same as 'staticFiles', but doesn't append an ETag to the+-- query string.+--+-- Using 'publicFiles' will speed up the compilation, since there+-- won't be any need for hashing files during compile-time.+-- However, since the ETag ceases to be part of the URL, the+-- 'Static' subsite won't be able to set the expire date too far+-- on the future. Browsers still will be able to cache the+-- contents, however they'll need send a request to the server to+-- see if their copy is up-to-date. publicFiles :: Prelude.FilePath -> Q [Dec] publicFiles dir = mkStaticFiles' dir "StaticRoute" False @@ -277,35 +316,23 @@ ] ] --- don't use L.readFile here, since it doesn't close handles quickly enough if--- there are lots of files in the static folder, it will cause exhausted file--- descriptors base64md5File :: Prelude.FilePath -> IO String-base64md5File file = do- bss <- E.run_ $ EB.enumFile file E.$$ EL.consume- return $ base64md5 $ L.fromChunks bss- -- FIXME I'd like something streaming instead- {-- fmap (base64 . finalize) $ E.run_ $- EB.enumFile file E.$$ EL.fold go (md5InitialContext, "")- where- go (context, prev) next = (md5Update context prev, next)- finalize (context, end) = md5Finalize context end- -}+base64md5File = fmap (base64 . encode) . hashFile+ where encode d = Data.Serialize.encode (d :: MD5) --- | md5-hashes the given lazy bytestring and returns the hash as--- base64url-encoded string.------ This function returns the first 8 characters of the hash. base64md5 :: L.ByteString -> String-base64md5 = base64 . md5+base64md5 lbs =+ base64 $ encode+ $ runST $ runResourceT+ $ sourceList (L.toChunks lbs) $$ sinkHash+ where+ encode d = Data.Serialize.encode (d :: MD5) -base64 :: MD5Digest -> String+base64 :: S.ByteString -> String base64 = map tr . take 8 . S8.unpack . Data.ByteString.Base64.encode- . Data.Serialize.encode where tr '+' = '-' tr '/' = '_'@@ -325,7 +352,7 @@ -- */ end CPP comment getStaticHandler :: Static -> (StaticRoute -> Route sub) -> [String] -> GHandler sub y ChooseRep getStaticHandler static toSubR pieces = do- toMasterR <- getRouteToMaster + toMasterR <- getRouteToMaster toMasterHandler (toMasterR . toSubR) toSub route handler where route = StaticRoute pieces [] toSub _ = static
+ test/tests.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Hspec+import YesodStaticTest (specs)++main :: IO ()+main = hspecX $ descriptions specs
− tests.hs
@@ -1,7 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Test.Hspec-import YesodStaticTest (specs)--main :: IO ()-main = hspecX $ descriptions specs
yesod-static.cabal view
@@ -1,5 +1,5 @@ name: yesod-static-version: 0.3.2.1+version: 0.10.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -13,34 +13,28 @@ description: Static file serving subsite for Yesod Web Framework. extra-source-files: test/YesodStaticTest.hs- tests.hs--flag test- description: Build for use with running tests- default: False+ test/tests.hs library- if flag(test)- cpp-options: -DTEST- build-depends: base >= 4 && < 5 , containers >= 0.2 && < 0.5 , old-time >= 1.0- , yesod-core >= 0.9 && < 0.10+ , yesod-core >= 0.10.1 && < 0.11 , base64-bytestring >= 0.1.0.1 && < 0.2- , pureMD5 >= 2.1.0.3 && < 2.2 , cereal >= 0.3 && < 0.4 , bytestring >= 0.9.1.4 && < 0.10 , template-haskell , directory >= 1.0 && < 1.2 , transformers >= 0.2.2 && < 0.3- , wai-app-static >= 0.3.2.1 && < 0.4- , wai >= 0.4 && < 0.5- , text >= 0.9 && < 0.12+ , wai-app-static >= 1.1 && < 1.2+ , wai >= 1.1 && < 1.2+ , text >= 0.9 && < 1.0 , file-embed >= 0.0.4.1 && < 0.5 , http-types >= 0.6.5 && < 0.7 , unix-compat >= 0.2- , enumerator >= 0.4.8 && < 0.5+ , conduit >= 0.2+ , crypto-conduit >= 0.1.1.2 && < 0.2+ , cryptohash >= 0.6.1 exposed-modules: Yesod.Static ghc-options: -Wall @@ -48,32 +42,32 @@ hs-source-dirs: ., test main-is: tests.hs type: exitcode-stdio-1.0- cpp-options: -DTEST- build-depends:- hspec >= 0.8 && < 0.10+ cpp-options: -DTEST_EXPORT+ build-depends: base+ , hspec >= 0.8 && < 0.10 , HUnit -- copy from above- , base >= 4 && < 5 , containers >= 0.2 && < 0.5 , old-time >= 1.0- , yesod-core >= 0.9 && < 0.10+ , yesod-core >= 0.10 && < 0.11 , base64-bytestring >= 0.1.0.1 && < 0.2- , pureMD5 >= 2.1.0.3 && < 2.2 , cereal >= 0.3 && < 0.4 , bytestring >= 0.9.1.4 && < 0.10 , template-haskell , directory >= 1.0 && < 1.2 , transformers >= 0.2.2 && < 0.3- , wai-app-static >= 0.3.2.1 && < 0.4- , wai >= 0.4 && < 0.5- , text >= 0.9 && < 0.12+ , wai-app-static >= 1.1 && < 1.2+ , wai >= 1.1 && < 1.2+ , text >= 0.9 && < 1.0 , file-embed >= 0.0.4.1 && < 0.5 , http-types >= 0.6.5 && < 0.7 , unix-compat >= 0.2- , enumerator >= 0.4.8 && < 0.5+ , conduit >= 0.2+ , crypto-conduit >= 0.1.1.2 && < 0.2+ , cryptohash >= 0.6.1 ghc-options: -Wall source-repository head type: git- location: git://github.com/yesodweb/yesod.git+ location: https://github.com/yesodweb/yesod