yesod-static 0.1.0.1 → 0.2.0
raw patch · 3 files changed
+157/−103 lines, 3 filesdep +containersdep +old-timedep −HUnitdep −QuickCheckdep −test-frameworkdep ~wai-app-static
Dependencies added: containers, old-time
Dependencies removed: HUnit, QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: wai-app-static
Files
- Yesod/Helpers/Static.hs +152/−76
- runtests.hs +0/−6
- yesod-static.cabal +5/−21
Yesod/Helpers/Static.hs view
@@ -27,11 +27,16 @@ module Yesod.Helpers.Static ( -- * Subsite Static (..)+ , Public (..) , StaticRoute (..)+ , PublicRoute (..) -- * Smart constructor , static+ , publicProduction+ , publicDevel -- * Template Haskell helpers , staticFiles+ , publicFiles {- -- * Embed files , getStaticHandler@@ -39,11 +44,12 @@ -- * Hashing , base64md5 #if TEST- , testSuite+ , getFileListPieces #endif ) where import System.Directory+import qualified System.Time import Control.Monad import Yesod.Handler@@ -53,7 +59,6 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax -import Data.Char import qualified Data.ByteString.Lazy as L import Data.Digest.Pure.MD5 import qualified Data.ByteString.Base64@@ -61,30 +66,62 @@ import qualified Data.Serialize import Data.Text (Text, pack) import Data.Monoid (mempty)+import qualified Data.Map as M+import Data.IORef (readIORef, newIORef, writeIORef) import Network.Wai.Application.Static- ( defaultMimeTypeByExt, StaticSettings (..), staticAppPieces- , defaultListing+ ( StaticSettings (..), CacheSettings (..)+ , defaultStaticSettings, defaultPublicSettings+ , staticAppPieces+ , pathFromPieces ) -#if TEST-import Test.Framework (testGroup, Test)-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)-#endif--import System.IO (withBinaryFile, IOMode (ReadMode))-+-- | generally static assets referenced in html files+-- assets get a checksum query parameter appended for perfect caching+-- * a far future expire date is set+-- * a given asset revision will only ever be downloaded once (if the browser maintains its cache)+-- if you don't want to see a checksum in the url- use Public newtype Static = Static StaticSettings+-- | same as Static, but there is no checksum query parameter appended+-- generally html files and the favicon, but could be any file where you don't want the checksum parameter+-- * the file checksum is used for an ETag.+-- * this form of caching is not as good as the static- the browser can avoid downloading the file, but it always need to send a request with the etag value to the server to see if its copy is up to date+newtype Public = Public StaticSettings -- | Default value of 'Static' for a given file folder. -- -- Does not have index files, uses default directory listings and default mime -- type list.-static :: FilePath -> Static-static fp = Static $ StaticSettings fp [] (Just defaultListing)- (return . defaultMimeTypeByExt)+static :: String -> FilePath -> IO Static+static root fp = do+ hashes <- mkHashMap fp+ return $ Static $ (defaultStaticSettings (Forever $ isStaticRequest hashes)) {+ ssFolder = fp+ , ssMkRedirect = \_ newPath -> S8.append (S8.pack (root ++ "/")) newPath+ }+ where+ isStaticRequest hashes reqf reqh = case M.lookup reqf hashes of+ Nothing -> False+ Just h -> h == reqh +-- | no directory listing+public :: String -> FilePath -> CacheSettings -> Public+public root fp cache = Public $ (defaultPublicSettings cache) {+ ssFolder = fp + , ssMkRedirect = \_ newPath -> S8.append (S8.pack (root ++ "/")) newPath+ }++publicProduction :: String -> FilePath -> IO Public+publicProduction root fp = do+ etags <- mkPublicProductionEtag fp+ return $ public root fp etags++publicDevel :: String -> FilePath -> IO Public+publicDevel root fp = do+ etags <- mkPublicDevelEtag fp+ return $ public root fp etags++ -- | 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,@@ -94,45 +131,32 @@ -- E.g. When generating image galleries. data StaticRoute = StaticRoute [Text] [(Text, Text)] deriving (Eq, Show, Read)+data PublicRoute = PublicRoute [Text] [(Text, Text)]+ deriving (Eq, Show, Read) type instance Route Static = StaticRoute+type instance Route Public = PublicRoute instance RenderRoute StaticRoute where renderRoute (StaticRoute x y) = (x, y)+instance RenderRoute PublicRoute where+ renderRoute (PublicRoute x y) = (x, y) instance Yesod master => YesodDispatch Static master where yesodDispatch (Static set) _ pieces _ _ = Just $ staticAppPieces set pieces -{- FIXME--- | Dispatch static route for a subsite------ Subsites with static routes can't (yet) define Static routes the same way "master" sites can.--- Instead of a subsite route:--- /static StaticR Static getStatic--- Use a normal route:--- /static/*Strings StaticR GET------ Then, define getStaticR something like:--- getStaticR = getStaticHandler ($(mkEmbedFiles "static") typeByExt) StaticR--- */ end CPP comment-getStaticHandler :: Static -> (StaticRoute -> Route sub) -> [String] -> GHandler sub y ChooseRep-getStaticHandler static toSubR pieces = do- toMasterR <- getRouteToMaster - toMasterHandler (toMasterR . toSubR) toSub route handler- where route = StaticRoute pieces []- toSub _ = static- staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep))- handler = fromMaybe notFound $ handleSite staticSite undefined route "GET"--}+instance Yesod master => YesodDispatch Public master where+ yesodDispatch (Public set) _ pieces _ _ =+ Just $ staticAppPieces set pieces notHidden :: FilePath -> Bool notHidden ('.':_) = False notHidden "tmp" = False notHidden _ = True -getFileList :: FilePath -> IO [[String]]-getFileList = flip go id+getFileListPieces :: FilePath -> IO [[String]]+getFileListPieces = flip go id where go :: String -> ([String] -> [String]) -> IO [[String]] go fp front = do@@ -150,67 +174,119 @@ -- > style_css = StaticRoute ["style.css"] [] -- > js_script_js = StaticRoute ["js/script.js"] [] staticFiles :: FilePath -> Q [Dec]-staticFiles fp = do- fs <- qRunIO $ getFileList fp- concat `fmap` mapM go fs+staticFiles dir = mkStaticFiles dir StaticSite++publicFiles :: FilePath -> Q [Dec]+publicFiles dir = mkStaticFiles dir PublicSite++mkHashMap :: FilePath -> IO (M.Map FilePath S8.ByteString)+mkHashMap dir = do+ fs <- getFileListPieces dir+ hashAlist fs >>= return . M.fromList where+ hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)]+ hashAlist fs = mapM hashPair fs+ where+ hashPair :: [String] -> IO (FilePath, S8.ByteString)+ hashPair pieces = do let file = pathFromPieces dir (map pack pieces)+ h <- base64md5File file+ return (file, S8.pack h)++mkPublicDevelEtag :: FilePath -> IO CacheSettings+mkPublicDevelEtag dir = do+ etags <- mkHashMap dir+ mtimeVar <- newIORef (M.empty :: M.Map FilePath System.Time.ClockTime)+ return $ ETag $ \f ->+ case M.lookup f etags of+ Nothing -> return Nothing+ Just checksum -> do+ newt <- getModificationTime f+ mtimes <- readIORef mtimeVar+ oldt <- case M.lookup f mtimes of+ Nothing -> writeIORef mtimeVar (M.insert f newt mtimes) >> return newt+ Just ot -> return ot+ return $ if newt /= oldt then Nothing else Just checksum+++mkPublicProductionEtag :: FilePath -> IO CacheSettings+mkPublicProductionEtag dir = do+ etags <- mkHashMap dir+ return $ ETag $ \f -> return . M.lookup f $ etags++data StaticSite = StaticSite | PublicSite+mkStaticFiles :: FilePath -> StaticSite -> Q [Dec]+mkStaticFiles fp StaticSite = mkStaticFiles' fp "StaticRoute" True+mkStaticFiles fp PublicSite = mkStaticFiles' fp "PublicRoute" False++mkStaticFiles' :: FilePath -> -- ^ static directory+ String -> -- ^ route constructor "StaticRoute"+ Bool -> -- ^ append checksum query parameter+ Q [Dec]+mkStaticFiles' fp routeConName makeHash = do+ fs <- qRunIO $ getFileListPieces fp+ concat `fmap` mapM mkRoute fs+ where replace' c | 'A' <= c && c <= 'Z' = c | 'a' <= c && c <= 'z' = c | '0' <= c && c <= '9' = c | otherwise = '_'- go f = do- let adjust [] = ""- adjust str@(x:xs) | isDigit x = '_' : x : xs- | isUpper x = toLower x : xs- | otherwise = str- let name = mkName $ intercalate "_" $ map (adjust . map replace') f+ mkRoute f = do+ let name = mkName $ intercalate "_" $ map (map replace') f f' <- [|map pack $(lift f)|]- let sr = ConE $ mkName "StaticRoute"- hash <- qRunIO . calcHash $ fp ++ '/' : intercalate "/" f-+ let route = mkName routeConName pack' <- [|pack|]- qs <- [|[(pack $(lift hash), mempty)]|]+ qs <- if makeHash+ then do hash <- qRunIO $ base64md5File $ pathFromPieces fp (map pack f)+ [|[(pack $(lift hash), mempty)]|]+ else return $ ListE [] return- [ SigD name $ ConT ''Route `AppT` ConT ''Static+ [ SigD name $ ConT route , FunD name- [ Clause [] (NormalB $ sr `AppE` f' `AppE` qs) []+ [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) [] ] ] -#if TEST--testSuite :: Test-testSuite = testGroup "Yesod.Helpers.Static"- [ testCase "get file list" caseGetFileList- ]--caseGetFileList :: Assertion-caseGetFileList = do- x <- getFileList "test"- x @?= [["foo"], ["bar", "baz"]]--#endif+base64md5File :: FilePath -> IO String+base64md5File file = do+ contents <- L.readFile file+ return $ base64md5 contents -- | 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 = map go+base64md5 = map tr . take 8 . S8.unpack . Data.ByteString.Base64.encode . Data.Serialize.encode . md5 where- go '+' = '-'- go '/' = '_'- go c = c+ tr '+' = '-'+ tr '/' = '_'+ tr c = c -calcHash :: FilePath -> IO String-calcHash fname =- withBinaryFile fname ReadMode hashHandle- where- hashHandle h = do s <- L.hGetContents h- return $! base64md5 s+{- FIXME+-- | Dispatch static route for a subsite+--+-- Subsites with static routes can't (yet) define Static routes the same way "master" sites can.+-- Instead of a subsite route:+-- /static StaticR Static getStatic+-- Use a normal route:+-- /static/*Strings StaticR GET+--+-- Then, define getStaticR something like:+-- getStaticR = getStaticHandler ($(mkEmbedFiles "static") typeByExt) StaticR+-- */ end CPP comment+getStaticHandler :: Static -> (StaticRoute -> Route sub) -> [String] -> GHandler sub y ChooseRep+getStaticHandler static toSubR pieces = do+ toMasterR <- getRouteToMaster + toMasterHandler (toMasterR . toSubR) toSub route handler+ where route = StaticRoute pieces []+ toSub _ = static+ staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep))+ handler = fromMaybe notFound $ handleSite staticSite undefined route "GET"+-}+
− runtests.hs
@@ -1,6 +0,0 @@-import Test.Framework (defaultMain)--import Yesod.Helpers.Static--main :: IO ()-main = defaultMain [testSuite]
yesod-static.cabal view
@@ -1,5 +1,5 @@ name: yesod-static-version: 0.1.0.1+version: 0.2.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -7,16 +7,14 @@ synopsis: Static file serving subsite for Yesod Web Framework. category: Web, Yesod stability: Stable-cabal-version: >= 1.6+cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/ -flag test- description: Build the executable to run unit tests- default: False- library build-depends: base >= 4 && < 5+ , containers >= 0.4+ , old-time >= 1.0 , yesod-core >= 0.8 && < 0.9 , base64-bytestring >= 0.1.0.1 && < 0.2 , pureMD5 >= 2.1.0.3 && < 2.2@@ -25,24 +23,10 @@ , template-haskell , directory >= 1.0 && < 1.2 , transformers >= 0.2 && < 0.3- , wai-app-static >= 0.1 && < 0.2+ , wai-app-static >= 0.2 && < 0.3 , text >= 0.5 && < 1.0 exposed-modules: Yesod.Helpers.Static ghc-options: -Wall--executable runtests- if flag(test)- Buildable: True- cpp-options: -DTEST- build-depends: test-framework,- test-framework-quickcheck2,- test-framework-hunit,- HUnit,- QuickCheck >= 2 && < 3- else- Buildable: False- ghc-options: -Wall- main-is: runtests.hs source-repository head type: git