diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs new file mode 100644 index 00000000..40345a10 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | A subsite which serves static content which is embedded at compile time. +-- +-- At compile time, you supply a list of files, directories, processing functions (like javascript +-- minification), and even custom content generators. You can also specify the specific relative +-- locations within the static subsite where these resources should appear. The 'mkEmbeddedStatic' +-- function then computes the resources and embeds them directly into the executable at +-- compile time, so that the original files do not need to be distributed along with +-- the executable. The content is also compressed and hashed at compile time, so that +-- during runtime the compressed content can be sent directly on the wire with the appropriate +-- HTTP header. The precomputed hash is used for an ETag so the client does not redownload +-- the content multiple times. There is also a development mode which does not embed the +-- contents but recomputes it on every request. A simple example using an embedded static +-- subsite is +-- . +-- +-- To add this to a scaffolded project, replace the code in @Settings/StaticFiles.hs@ +-- with a call to 'mkEmbeddedStatic' with the list of all your generators, use the type +-- 'EmbeddedStatic' in your site datatype for @getStatic@, update the route for @/static@ to +-- use the type 'EmbeddedStatic', use 'embedStaticContent' for 'addStaticContent' in +-- @Foundation.hs@, use the routes generated by 'mkEmbeddedStatic' and exported by +-- @Settings/StaticFiles.hs@ to link to your static content, and finally update +-- @Application.hs@ use the variable binding created by 'mkEmbeddedStatic' which +-- contains the created 'EmbeddedStatic'. +-- +-- It is recommended that you serve static resources from a separate domain to save time +-- on transmitting cookies. You can use 'urlRenderOverride' to do so, by redirecting +-- routes to this subsite to a different domain (but the same path) and then pointing the +-- alternative domain to this server. In addition, you might consider using a reverse +-- proxy like varnish or squid to cache the static content, but the embedded content in +-- this subsite is cached and served directly from memory so is already quite fast. +module Yesod.EmbeddedStatic ( + -- * Subsite + EmbeddedStatic + , embeddedResourceR + , mkEmbeddedStatic + , embedStaticContent + + -- * Generators + , module Yesod.EmbeddedStatic.Generators +) where + +import Control.Applicative ((<$>)) +import Data.IORef +import Data.Maybe (catMaybes) +import Language.Haskell.TH +import Network.HTTP.Types.Status (status404) +import Network.Wai (responseLBS, pathInfo) +import Network.Wai.Application.Static (staticApp) +import System.IO.Unsafe (unsafePerformIO) +import Yesod.Core + ( HandlerT + , Yesod(..) + , YesodSubDispatch(..) + ) +import Yesod.Core.Types + ( YesodSubRunnerEnv(..) + , YesodRunnerEnv(..) + ) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Map as M +import qualified WaiAppStatic.Storage.Embedded as Static + +import Yesod.EmbeddedStatic.Types +import Yesod.EmbeddedStatic.Internal +import Yesod.EmbeddedStatic.Generators + +-- Haddock doesn't support associated types in instances yet so we can't +-- export EmbeddedResourceR directly. + +-- | Construct a route to an embedded resource. +embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic +embeddedResourceR = EmbeddedResourceR + +instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) where + yesodSubDispatch YesodSubRunnerEnv {..} req = resp + where + master = yreSite ysreParentEnv + site = ysreGetSub master + resp = case pathInfo req of + ("res":_) -> stApp site req + ("widget":_) -> staticApp (widgetSettings site) req + _ -> return $ responseLBS status404 [] "Not Found" + +-- | Create the haskell variable for the link to the entry +mkRoute :: ComputedEntry -> Q [Dec] +mkRoute (ComputedEntry { cHaskellName = Nothing }) = return [] +mkRoute (c@ComputedEntry { cHaskellName = Just name }) = do + routeType <- [t| Route EmbeddedStatic |] + link <- [| $(cLink c) |] + return [ SigD name routeType + , ValD (VarP name) (NormalB link) [] + ] + +-- | Creates an 'EmbeddedStatic' by running, at compile time, a list of generators. +-- Each generator produces a list of entries to embed into the executable. +-- +-- This template haskell splice creates a variable binding holding the resulting +-- 'EmbeddedStatic' and in addition creates variable bindings for all the routes +-- produced by the generators. For example, if a directory called static has +-- the following contents: +-- +-- * js/jquery.js +-- +-- * css/bootstrap.css +-- +-- * img/logo.png +-- +-- then a call to +-- +-- > #ifdef DEVELOPMENT +-- > #define DEV_BOOL True +-- > #else +-- > #define DEV_BOOL False +-- > #endif +-- > mkEmbeddedStatic DEV_BOOL "myStatic" [embedDir "static"] +-- +-- will produce variables +-- +-- > myStatic :: EmbeddedStatic +-- > js_jquery_js :: Route EmbeddedStatic +-- > css_bootstrap_css :: Route EmbeddedStatic +-- > img_logo_png :: Route EmbeddedStatic +mkEmbeddedStatic :: Bool -- ^ development? + -> String -- ^ variable name for the created 'EmbeddedStatic' + -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators") + -> Q [Dec] +mkEmbeddedStatic dev esName gen = do + entries <- concat <$> sequence gen + computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries + + let settings = Static.mkSettings $ return $ map cStEntry computed + devExtra = listE $ catMaybes $ map ebDevelExtraFiles entries + ioRef = [| unsafePerformIO $ newIORef M.empty |] + + -- build the embedded static + esType <- [t| EmbeddedStatic |] + esCreate <- if dev + then [| EmbeddedStatic (develApp $settings $devExtra) $ioRef |] + else [| EmbeddedStatic (staticApp $! $settings) $ioRef |] + let es = [ SigD (mkName esName) esType + , ValD (VarP $ mkName esName) (NormalB esCreate) [] + ] + + routes <- mapM mkRoute computed + + return $ es ++ concat routes + +-- | Use this for 'addStaticContent' to have the widget static content be served by +-- the embedded static subsite. For example, +-- +-- > import Yesod +-- > import Yesod.EmbeddedStatic +-- > import Text.Jasmine (minifym) +-- > +-- > data MySite = { ..., getStatic :: EmbeddedStatic, ... } +-- > +-- > mkYesod "MySite" [parseRoutes| +-- > ... +-- > /static StaticR EmbeddedStatic getStatic +-- > ... +-- > |] +-- > +-- > instance Yesod MySite where +-- > ... +-- > addStaticContent = embedStaticContent getStatic StaticR mini +-- > where mini = if development then Right else minifym +-- > ... +embedStaticContent :: Yesod site + => (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site + -> (Route EmbeddedStatic -> Route site) -- ^ how to convert an embedded static route + -> (BL.ByteString -> Either a BL.ByteString) -- ^ javascript minifier + -> AddStaticContent site +embedStaticContent = staticContentHelper diff --git a/yesod-static/Yesod/EmbeddedStatic/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs new file mode 100644 index 00000000..c6388865 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Generators.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, ScopedTypeVariables #-} +-- | A generator is executed at compile time to load a list of entries +-- to embed into the subsite. This module contains several basic generators, +-- but the design of generators and entries is such that it is straightforward +-- to make custom generators for your own specific purposes, see <#g:4 this section>. +module Yesod.EmbeddedStatic.Generators ( + -- * Generators + Location + + -- * Util + , pathToName + + -- * Custom Generators + + -- $example +) where + +import Data.Char (isDigit, isLower) +import Language.Haskell.TH + +import Yesod.EmbeddedStatic.Types + +-- | Clean up a path to make it a valid haskell name by replacing all non-letters +-- and non-numbers by underscores. In addition, if the path starts with a capital +-- letter or number add an initial underscore. +pathToName :: FilePath -> Name +pathToName f = routeName + where + replace c + | 'A' <= c && c <= 'Z' = c + | 'a' <= c && c <= 'z' = c + | '0' <= c && c <= '9' = c + | otherwise = '_' + name = map replace f + routeName = mkName $ + case () of + () + | null name -> error "null-named file" + | isDigit (head name) -> '_' : name + | isLower (head name) -> name + | otherwise -> '_' : name + + +-- $example +-- Here is an example of creating your own custom generator. +-- Because of template haskell stage restrictions, you must define generators in a +-- different module from where you use them. The following generator will embed a +-- JSON document that contains the compile time. +-- +-- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +-- >module CompileTime where +-- > +-- >import Data.Aeson +-- >import Data.Time +-- >import Yesod.EmbeddedStatic.Generators +-- >import Yesod.EmbeddedStatic.Types +-- >import qualified Data.ByteString.Lazy as BL +-- > +-- >getTime :: IO BL.ByteString +-- >getTime = do +-- > t <- getCurrentTime +-- > return $ encode $ +-- > object [ "compile_time" .= show t ] +-- > +-- >timeGenerator :: Location -> Generator +-- >timeGenerator loc = +-- > return $ [Entry +-- > { ebHaskellName = Just $ pathToName loc +-- > , ebLocation = loc +-- > , ebMimeType = "application/json" +-- > , ebProductionContent = getTime +-- > , ebDevelReload = [| getTime |] +-- > , ebDevelExtraFiles = Nothing +-- > }] +-- +-- Notice how the @getTime@ action is given as both 'ebProductionContent' and +-- 'ebDevelReload'. The result is that during development, the @getTime@ action +-- will be re-executed on every request so the time returned will be different +-- for each reload. When compiling for production, the @getTime@ action will +-- be executed once at compile time to produce the content to embed and never +-- called at runtime. +-- +-- Here is a small example yesod program using this generator. Try toggling +-- the development argument to @mkEmbeddedStatic@. +-- +-- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-} +-- >module Main where +-- > +-- >import Yesod +-- >import Yesod.EmbeddedStatic +-- >import CompileTime (timeGenerator) +-- > +-- >mkEmbeddedStatic True "eStatic" [timeGenerator "compile-time.json"] +-- > +-- >-- The above will generate variables +-- >-- eStatic :: EmbeddedStatic +-- >-- compile_time_json :: Route EmbeddedStatic +-- > +-- >data MyApp = MyApp { getStatic :: EmbeddedStatic } +-- > +-- >mkYesod "MyApp" [parseRoutes| +-- >/ HomeR GET +-- >/static StaticR EmbeddedStatic getStatic +-- >|] +-- > +-- >instance Yesod MyApp +-- > +-- >getHomeR :: Handler Html +-- >getHomeR = defaultLayout $ [whamlet| +-- >

Hello +-- >

Check the +-- > compile time +-- >|] +-- > +-- >main :: IO () +-- >main = warp 3000 $ MyApp eStatic diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs new file mode 100644 index 00000000..8f8ad8ff --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Internal.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +module Yesod.EmbeddedStatic.Internal ( + EmbeddedStatic(..) + , Route(..) + , ComputedEntry(..) + , devEmbed + , prodEmbed + , develApp + , AddStaticContent + , staticContentHelper + , widgetSettings +) where + +import Control.Applicative ((<$>)) +import Data.IORef +import Language.Haskell.TH +import Network.HTTP.Types (Status(..), status404, status200, status304) +import Network.Mime (MimeType) +import Network.Wai +import Network.Wai.Application.Static (defaultWebAppSettings, staticApp) +import WaiAppStatic.Types +import Yesod.Core + ( HandlerT + , ParseRoute(..) + , RenderRoute(..) + , Yesod(..) + , getYesod + , liftIO + ) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Map as M +import qualified WaiAppStatic.Storage.Embedded as Static + +import Yesod.Static (base64md5) +import Yesod.EmbeddedStatic.Types + +-- | The subsite for the embedded static file server. +data EmbeddedStatic = EmbeddedStatic { + stApp :: !Application + , widgetFiles :: !(IORef (M.Map T.Text File)) +} + +instance RenderRoute EmbeddedStatic where + data Route EmbeddedStatic = EmbeddedResourceR [T.Text] [(T.Text,T.Text)] + | EmbeddedWidgetR T.Text + deriving (Eq, Show, Read) + renderRoute (EmbeddedResourceR x y) = ("res":x, y) + renderRoute (EmbeddedWidgetR h) = (["widget",h], []) +instance ParseRoute EmbeddedStatic where + parseRoute (("res":x), y) = Just $ EmbeddedResourceR x y + parseRoute (["widget",h], _) = Just $ EmbeddedWidgetR h + parseRoute _ = Nothing + +-- | At compile time, one of these is created for every 'Entry' created by +-- the generators. The cLink is a template haskell expression of type @Route EmbeddedStatic@. +data ComputedEntry = ComputedEntry { + cHaskellName :: Maybe Name -- ^ Optional haskell name to create a variable for the route + , cStEntry :: Static.EmbeddableEntry -- ^ The entry to be embedded into the executable + , cLink :: ExpQ -- ^ The route for this entry +} + +mkStr :: String -> ExpQ +mkStr = litE . stringL + +-- | Create a 'ComputedEntry' for development mode, reloading the content on every request. +devEmbed :: Entry -> IO ComputedEntry +devEmbed e = return computed + where + st = Static.EmbeddableEntry { + Static.eLocation = "res/" `T.append` T.pack (ebLocation e) + , Static.eMimeType = ebMimeType e + , Static.eContent = Right [| $(ebDevelReload e) >>= \c -> + return (T.pack (base64md5 c), c) |] + } + link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) [] |] + computed = ComputedEntry (ebHaskellName e) st link + +-- | Create a 'ComputedEntry' for production mode, hashing and embedding the content into the executable. +prodEmbed :: Entry -> IO ComputedEntry +prodEmbed e = do + ct <- ebProductionContent e + let hash = base64md5 ct + link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) + [(T.pack "etag", T.pack $(mkStr hash))] |] + st = Static.EmbeddableEntry { + Static.eLocation = "res/" `T.append` T.pack (ebLocation e) + , Static.eMimeType = ebMimeType e + , Static.eContent = Left (T.pack hash, ct) + } + return $ ComputedEntry (ebHaskellName e) st link + +tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application +tryExtraDevelFiles [] _ = return $ responseLBS status404 [] "" +tryExtraDevelFiles (f:fs) r = do + mct <- liftIO $ f $ drop 1 $ pathInfo r -- drop the initial "res" + case mct of + Nothing -> tryExtraDevelFiles fs r + Just (mime, ct) -> do + let hash = T.encodeUtf8 $ T.pack $ base64md5 ct + let headers = [ ("Content-Type", mime) + , ("ETag", hash) + ] + case lookup "If-None-Match" (requestHeaders r) of + Just h | hash == h -> return $ responseLBS status304 headers "" + _ -> return $ responseLBS status200 headers ct + +-- | Helper to create the development application at runtime +develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application +develApp settings extra req = do + resp <- staticApp settings {ssMaxAge = NoMaxAge} req + if statusCode (responseStatus resp) == 404 + then tryExtraDevelFiles extra req + else return resp + +-- | The type of 'addStaticContent' +type AddStaticContent site = T.Text -> T.Text -> BL.ByteString + -> HandlerT site IO (Maybe (Either T.Text (Route site, [(T.Text, T.Text)]))) + +-- | Helper for embedStaticContent and embedLicensedStaticContent. +staticContentHelper :: Yesod site + => (site -> EmbeddedStatic) + -> (Route EmbeddedStatic -> Route site) + -> (BL.ByteString -> Either a BL.ByteString) + -> AddStaticContent site +staticContentHelper getStatic staticR minify ext _ ct = do + wIORef <- widgetFiles . getStatic <$> getYesod + let hash = T.pack $ base64md5 ct + hash' = Just $ T.encodeUtf8 hash + filename = T.concat [hash, ".", ext] + content = case ext of + "js" -> either (const ct) id $ minify ct + _ -> ct + file = File + { fileGetSize = fromIntegral $ BL.length content + , fileToResponse = \s h -> responseLBS s h content + , fileName = unsafeToPiece filename + , fileGetHash = return hash' + , fileGetModified = Nothing + } + liftIO $ atomicModifyIORef' wIORef $ \m -> + (M.insertWith (\old _ -> old) filename file m, ()) + + return $ Just $ Right (staticR $ EmbeddedWidgetR filename, []) + +-- | Create a wai-app-static settings based on the IORef inside the EmbeddedStaic site. +widgetSettings :: EmbeddedStatic -> StaticSettings +widgetSettings es = (defaultWebAppSettings "") { ssLookupFile = lookupFile } + where + lookupFile [_,p] = do -- The first part of the path is "widget" + m <- readIORef $ widgetFiles es + return $ maybe LRNotFound LRFile $ M.lookup (fromPiece p) m + lookupFile _ = return LRNotFound diff --git a/yesod-static/Yesod/EmbeddedStatic/Types.hs b/yesod-static/Yesod/EmbeddedStatic/Types.hs new file mode 100644 index 00000000..8d757237 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Types.hs @@ -0,0 +1,45 @@ +module Yesod.EmbeddedStatic.Types( + Location + , Entry(..) + , Generator +) where + +import Language.Haskell.TH +import Network.Mime (MimeType) +import qualified Data.ByteString.Lazy as BL + +-- | A location is a relative path within the static subsite at which resource(s) are made available. +-- The location can include slashes to simulate directories but must not start or end with a slash. +type Location = String + +-- | A single resource embedded into the executable at compile time. +data Entry = Entry { + ebHaskellName :: Maybe Name + -- ^ An optional haskell name. If the name is present, a variable + -- of type @Route 'Yesod.EmbeddedStatic.EmbeddedStatic'@ with the + -- given name will be created which points to this resource. + , ebLocation :: Location -- ^ The location to serve the resource from. + , ebMimeType :: MimeType -- ^ The mime type of the resource. + , ebProductionContent :: IO BL.ByteString + -- ^ If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is False, + -- then at compile time this action will be executed to load the content. + -- During development, this action will not be executed. + , ebDevelReload :: ExpQ + -- ^ This must be a template haskell expression of type @IO 'BL.ByteString'@. + -- If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is True, + -- this action is executed on every request to compute the content. Most of the + -- time, 'ebProductionContent' and 'ebDevelReload' should be the same action but + -- occasionally you might want additional processing inside the 'ebProductionContent' + -- function like javascript/css minification to only happen when building for production. + , ebDevelExtraFiles :: Maybe ExpQ + -- ^ Occasionally, during development an entry needs extra files/resources available + -- that are not present during production (for example, image files that are embedded + -- into the CSS at production but left unembedded during development). If present, + -- @ebDevelExtraFiles@ must be a template haskell expression of type + -- @['T.Text'] -> IO (Maybe ('MimeType', 'BL.ByteString'))@. That is, a function + -- taking as input the list of path pieces and optionally returning a mime type + -- and content. +} + +-- | An embedded generator is executed at compile time to produce the entries to embed. +type Generator = Q [Entry] diff --git a/yesod-static/test/EmbedDevelTest.hs b/yesod-static/test/EmbedDevelTest.hs new file mode 100644 index 00000000..f1436614 --- /dev/null +++ b/yesod-static/test/EmbedDevelTest.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-} +module EmbedDevelTest where + +-- Tests the development mode of the embedded static subsite by +-- using a custom generator testGen. + +import Data.Maybe (isNothing) +import EmbedTestGenerator +import EmbedProductionTest (findEtag) +import Network.Wai.Test (SResponse(simpleHeaders)) +import Test.HUnit (assertBool) +import Test.Hspec (Spec) +import Yesod.Core +import Yesod.EmbeddedStatic +import Yesod.Test + +mkEmbeddedStatic True "eDev" [testGen] + +data MyApp = MyApp { getStatic :: EmbeddedStatic } + +mkYesod "MyApp" [parseRoutes| +/static StaticR EmbeddedStatic getStatic +|] + +instance Yesod MyApp + +noCacheControl :: YesodExample site () +noCacheControl = withResponse $ \r -> do + liftIO $ assertBool "Cache-Control exists" $ + isNothing $ lookup "Cache-Control" $ simpleHeaders r + liftIO $ assertBool "Expires exists" $ + isNothing $ lookup "Expires" $ simpleHeaders r + +embedDevSpecs :: Spec +embedDevSpecs = yesodSpec (MyApp eDev) $ do + ydescribe "Embedded Development Entries" $ do + yit "e1 loads" $ do + get $ StaticR e1 + statusIs 200 + assertHeader "Content-Type" "text/plain" + noCacheControl + bodyEquals "e1 devel" + + tag <- findEtag + request $ do + setMethod "GET" + setUrl $ StaticR e1 + addRequestHeader ("If-None-Match", tag) + statusIs 304 + + yit "e2 with simulated directory" $ do + get $ StaticR e2 + statusIs 200 + assertHeader "Content-Type" "abcdef" + noCacheControl + bodyEquals "e2 devel" + + yit "e3 without haskell name" $ do + get $ StaticR $ embeddedResourceR ["xxxx", "e3"] [] + statusIs 200 + assertHeader "Content-Type" "yyy" + noCacheControl + bodyEquals "e3 devel" + + yit "e4 loads" $ do + get $ StaticR e4 + statusIs 200 + assertHeader "Content-Type" "text/plain" + noCacheControl + bodyEquals "e4 devel" + + yit "e4 extra development dev1" $ do + get $ StaticR $ embeddedResourceR ["dev1"] [] + statusIs 200 + assertHeader "Content-Type" "mime" + noCacheControl + bodyEquals "dev1 content" + + tag <- findEtag + request $ do + setMethod "GET" + setUrl $ StaticR $ embeddedResourceR ["dev1"] [] + addRequestHeader ("If-None-Match", tag) + statusIs 304 + + yit "e4 extra development with path" $ do + get $ StaticR $ embeddedResourceR ["dir", "dev2"] [] + statusIs 200 + assertHeader "Content-Type" "mime2" + noCacheControl + bodyEquals "dev2 content" + + yit "extra development file 404" $ do + get $ StaticR $ embeddedResourceR ["xxxxxxxxxx"] [] + statusIs 404 diff --git a/yesod-static/test/EmbedProductionTest.hs b/yesod-static/test/EmbedProductionTest.hs new file mode 100644 index 00000000..8fd407a3 --- /dev/null +++ b/yesod-static/test/EmbedProductionTest.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-} +module EmbedProductionTest where + +-- Tests the production mode of the embedded static subsite by +-- using a custom generator testGen. Also tests that the widget +-- content is embedded properly. + +import Data.Maybe (isJust) +import EmbedTestGenerator +import Network.Wai.Test (SResponse(simpleHeaders)) +import Test.HUnit (assertFailure, assertBool) +import Test.Hspec (Spec) +import Yesod.Core +import Yesod.EmbeddedStatic +import Yesod.Test +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Encoding as T + +mkEmbeddedStatic False "eProduction" [testGen] + +data MyApp = MyApp { getStatic :: EmbeddedStatic } + +mkYesod "MyApp" [parseRoutes| +/ HomeR GET +/static StaticR EmbeddedStatic getStatic +|] + +getHomeR :: Handler Html +getHomeR = defaultLayout $ do + toWidget [julius|console.log("Hello World");|] + [whamlet|

Hello|] + +instance Yesod MyApp where + addStaticContent = embedStaticContent getStatic StaticR Right + +findEtag :: YesodExample site B.ByteString +findEtag = withResponse $ \r -> + case lookup "ETag" (simpleHeaders r) of + Nothing -> liftIO (assertFailure "No etag found") >> error "" + Just e -> return e + +hasCacheControl :: YesodExample site () +hasCacheControl = withResponse $ \r -> do + liftIO $ assertBool "Cache-Control missing" $ + isJust $ lookup "Cache-Control" $ simpleHeaders r + liftIO $ assertBool "Expires missing" $ + isJust $ lookup "Expires" $ simpleHeaders r + +embedProductionSpecs :: Spec +embedProductionSpecs = yesodSpec (MyApp eProduction) $ do + ydescribe "Embedded Production Entries" $ do + yit "e1 loads" $ do + get $ StaticR e1 + statusIs 200 + assertHeader "Content-Type" "text/plain" + hasCacheControl + bodyEquals "e1 production" + + tag <- findEtag + request $ do + setMethod "GET" + setUrl $ StaticR e1 + addRequestHeader ("If-None-Match", tag) + statusIs 304 + + yit "e1 with custom built path" $ do + get $ StaticR $ embeddedResourceR ["e1"] [] + statusIs 200 + assertHeader "Content-Type" "text/plain" + hasCacheControl + bodyEquals "e1 production" + + yit "e2 with simulated directory" $ do + get $ StaticR e2 + statusIs 200 + assertHeader "Content-Type" "abcdef" + hasCacheControl + bodyEquals "e2 production" + + yit "e2 with custom built directory path" $ do + get $ StaticR $ embeddedResourceR ["dir", "e2"] [] + statusIs 200 + assertHeader "Content-Type" "abcdef" + hasCacheControl + bodyEquals "e2 production" + + yit "e3 without haskell name" $ do + get $ StaticR $ embeddedResourceR ["xxxx", "e3"] [] + statusIs 200 + assertHeader "Content-Type" "yyy" + hasCacheControl + bodyEquals "e3 production" + + yit "e4 is embedded" $ do + get $ StaticR e4 + statusIs 200 + assertHeader "Content-Type" "text/plain" + hasCacheControl + bodyEquals "e4 production" + + yit "e4 extra development files are not embedded" $ do + get $ StaticR $ embeddedResourceR ["dev1"] [] + statusIs 404 + + ydescribe "Embedded Widget Content" $ + yit "Embedded Javascript" $ do + get HomeR + statusIs 200 + [script] <- htmlQuery "script" + let src = BL.takeWhile (/= 34) $ BL.drop 1 $ BL.dropWhile (/= 34) script -- 34 is " + + get $ T.decodeUtf8 $ BL.toStrict src + statusIs 200 + hasCacheControl + assertHeader "Content-Type" "application/javascript" + bodyEquals "console.log(\"Hello World\");" diff --git a/yesod-static/test/EmbedTestGenerator.hs b/yesod-static/test/EmbedTestGenerator.hs new file mode 100644 index 00000000..82268f4e --- /dev/null +++ b/yesod-static/test/EmbedTestGenerator.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +module EmbedTestGenerator (testGen) where + +import Network.Mime (MimeType) +import Yesod.EmbeddedStatic.Types +import Yesod.EmbeddedStatic.Generators (pathToName) + +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.ByteString.Lazy as BL + +e1, e2, e3, e4 :: Entry + +-- Basic entry +e1 = Entry + { ebHaskellName = Just $ pathToName "e1" + , ebLocation = "e1" + , ebMimeType = "text/plain" + , ebProductionContent = return $ TL.encodeUtf8 "e1 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e1 devel" |] + , ebDevelExtraFiles = Nothing + } + +-- Test simulated directory in location +e2 = Entry + { ebHaskellName = Just $ pathToName "e2" + , ebLocation = "dir/e2" + , ebMimeType = "abcdef" + , ebProductionContent = return $ TL.encodeUtf8 "e2 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e2 devel" |] + , ebDevelExtraFiles = Nothing + } + +-- Test empty haskell name +e3 = Entry + { ebHaskellName = Nothing + , ebLocation = "xxxx/e3" + , ebMimeType = "yyy" + , ebProductionContent = return $ TL.encodeUtf8 "e3 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e3 devel" |] + , ebDevelExtraFiles = Nothing + } + +devExtra :: [T.Text] -> IO (Maybe (MimeType, BL.ByteString)) +devExtra ["dev1"] = return $ Just ("mime", "dev1 content") +devExtra ["dir", "dev2"] = return $ Just ("mime2", "dev2 content") +devExtra _ = return Nothing + +-- Entry with devel extra files +e4 = Entry + { ebHaskellName = Just $ pathToName "e4" + , ebLocation = "e4" + , ebMimeType = "text/plain" + , ebProductionContent = return $ TL.encodeUtf8 "e4 production" + , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e4 devel" |] + , ebDevelExtraFiles = Just [| devExtra |] + } + +testGen :: Generator +testGen = return [e1, e2, e3, e4] diff --git a/yesod-static/test/tests.hs b/yesod-static/test/tests.hs index 00553511..e9a8625f 100644 --- a/yesod-static/test/tests.hs +++ b/yesod-static/test/tests.hs @@ -2,6 +2,11 @@ import Test.Hspec import YesodStaticTest (specs) +import EmbedProductionTest (embedProductionSpecs) +import EmbedDevelTest (embedDevSpecs) main :: IO () -main = hspec specs +main = hspec $ do + specs + embedProductionSpecs + embedDevSpecs diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index f0d4db22..e555d7d4 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -12,8 +12,7 @@ build-type: Simple homepage: http://www.yesodweb.com/ description: Static file serving subsite for Yesod Web Framework. extra-source-files: - test/YesodStaticTest.hs - test/tests.hs + test/*.hs test/fs/bar/baz test/fs/tmp/ignored test/fs/.ignored @@ -30,7 +29,7 @@ library , template-haskell , directory >= 1.0 , transformers >= 0.2.2 - , wai-app-static >= 1.3 && < 1.4 + , wai-app-static >= 1.3.2 && < 1.4 , wai >= 1.3 && < 1.5 , text >= 0.9 , file-embed >= 0.0.4.1 && < 0.5 @@ -43,7 +42,15 @@ library , system-fileio >= 0.3 , data-default , shakespeare-css >= 1.0.3 + , mime-types >= 0.1 + exposed-modules: Yesod.Static + Yesod.EmbeddedStatic + Yesod.EmbeddedStatic.Generators + Yesod.EmbeddedStatic.Types + + other-modules: Yesod.EmbeddedStatic.Internal + ghc-options: -Wall test-suite tests @@ -53,6 +60,10 @@ test-suite tests cpp-options: -DTEST_EXPORT build-depends: base , hspec >= 1.3 + , yesod-test >= 1.2 + , wai-test + , HUnit + -- copy from above , containers , old-time @@ -76,6 +87,7 @@ test-suite tests , system-fileio , data-default , shakespeare-css + , mime-types ghc-options: -Wall