diff --git a/Yesod/Static.hs b/Yesod/Static.hs --- a/Yesod/Static.hs +++ b/Yesod/Static.hs @@ -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 diff --git a/test/tests.hs b/test/tests.hs new file mode 100644 --- /dev/null +++ b/test/tests.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Test.Hspec +import YesodStaticTest (specs) + +main :: IO () +main = hspecX $ descriptions specs diff --git a/tests.hs b/tests.hs deleted file mode 100644 --- a/tests.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Test.Hspec -import YesodStaticTest (specs) - -main :: IO () -main = hspecX $ descriptions specs diff --git a/yesod-static.cabal b/yesod-static.cabal --- a/yesod-static.cabal +++ b/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 0.3.2.1 +version: 0.10.1 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -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