{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, MagicHash #-}moduleWaiAppStatic.Storage.Embedded.TH(Etag,EmbeddableEntry(..),mkSettings)whereimportBlaze.ByteString.Builder.ByteString(insertByteString)importCodec.Compression.GZip(compress)importControl.ApplicativeimportData.ByteString.Unsafe(unsafePackAddressLen)importData.Either(lefts,rights)importGHC.Exts(Int(..))importLanguage.Haskell.THimportNetwork.Mime(MimeType,defaultMimeLookup)importSystem.IO.Unsafe(unsafeDupablePerformIO)importWaiAppStatic.TypesimportWaiAppStatic.Storage.Filesystem(defaultWebAppSettings)importqualifiedData.ByteStringasBimportqualifiedData.ByteString.LazyasBL#if !MIN_VERSION_template_haskell(2, 8, 0)importqualifiedData.ByteString.Char8asB8importqualifiedData.ByteString.Lazy.Char8asBL8#endifimportqualifiedData.HashMap.StrictasMimportqualifiedData.TextasTimportqualifiedData.Text.EncodingasTimportqualifiedNetwork.WaiasW-- | An Etag is used to return 304 Not Modified responses so the client does not need-- to download resources a second time. Usually the etag is built from a hash of-- the content. To disable Etags, you can pass the empty string. This will cause the-- content to be redownloaded on every request.typeEtag=T.Text-- | Used at compile time to hold data about an entry to embed into the compiled executable.dataEmbeddableEntry=EmbeddableEntry{eLocation::T.Text-- ^ The location where this resource should be served from. The-- location can contain forward slashes (/) to simulate directories,-- but must not end with a forward slash.,eMimeType::MimeType-- ^ The mime type.,eContent::Either(Etag,BL.ByteString)ExpQ-- ^ The content itself. The content can be given as a tag and bytestring,-- in which case the content will be embedded directly into the execuatble.-- Alternatively, the content can be given as a template haskell expression-- returning @IO ('Etag', 'BL.ByteString')@ in which case this action will-- be executed on every request to reload the content (this is useful-- for a debugging mode).}-- | This structure is used at runtime to hold the entry.dataEmbeddedEntry=EmbeddedEntry{embLocation::!T.Text,embMime::!MimeType,embEtag::!B.ByteString,embCompressed::!Bool,embContent::!B.ByteString}-- | This structure is used at runtime to hold the reload entries.dataReloadEntry=ReloadEntry{reloadLocation::!T.Text,reloadMime::!MimeType,reloadContent::IO(T.Text,BL.ByteString)}-- The use of unsafePackAddressLen is safe here because the length-- is correct and we will only be reading from the bytestring, never-- modifying it.---- The only IO within unsafePackAddressLen is within newForeignPtr_ where-- a new IORef is created as newIORef (NoFinalizers, []) to hold the finalizer-- for the pointer. Since the pointer for the content will never have a finalizer-- added, we do not care if this finalizer IORef gets created more than once since-- the IORef will always be holding (NoFinalizers, []). Therefore-- unsafeDupablePerformIO is safe.bytestringE::B.ByteString->ExpQ#if MIN_VERSION_template_haskell(2, 8, 0)bytestringEb=[|unsafeDupablePerformIO(unsafePackAddressLen(I#$lenE)$ctE)|]wherelenE=litE$intPrimL$toInteger$B.lengthbctE=litE$stringPrimL$B.unpackb#elsebytestringEb=[|B8.pack$s|]wheres=litE$stringL$B8.unpackb#endifbytestringLazyE::BL.ByteString->ExpQ#if MIN_VERSION_template_haskell(2, 8, 0)bytestringLazyEb=[|unsafeDupablePerformIO(unsafePackAddressLen(I#$lenE)$ctE)|]wherelenE=litE$intPrimL$toInteger$BL.lengthbctE=litE$stringPrimL$BL.unpackb#elsebytestringLazyEb=[|B8.pack$s|]wheres=litE$stringL$BL8.unpackb#endif-- | A template haskell expression which creates either an EmbeddedEntry or ReloadEntry.mkEntry::EmbeddableEntry->ExpQmkEntry(EmbeddableEntrylocmime(Left(etag,ct)))=[|Left$EmbeddedEntry(T.pack$locE)$(bytestringEmime)$(bytestringE$T.encodeUtf8etag)(1==I#$compressedE)$(bytestringLazyEct')|]wherelocE=litE$stringL$T.unpackloc(compressed,ct')=tryCompressmimectcompressedE=litE$intPrimL$ifcompressedthen1else0mkEntry(EmbeddableEntrylocmime(Rightexpr))=[|Right$ReloadEntry(T.pack$locE)$(bytestringEmime)$expr|]wherelocE=litE$stringL$T.unpackloc-- | Converts an embedded entry to a fileembeddedToFile::EmbeddedEntry->FileembeddedToFileentry=File{fileGetSize=fromIntegral$B.length$embContententry,fileToResponse=\sh->leth'=ifembCompressedentrythenh++[("Content-Encoding","gzip")]elsehinW.ResponseBuildersh'$insertByteString$embContententry-- Usually the fileName should just be the filename not the entire path,-- but we need the whole path to make the lookup within lookupMime-- possible. lookupMime is provided only with the File and from that-- we must find the mime type. Putting the path here is OK since-- within staticApp the fileName is used for directory listings which-- we have disabled.,fileName=unsafeToPiece$embLocationentry,fileGetHash=return$ifB.null(embEtagentry)thenNothingelseJust$embEtagentry,fileGetModified=Nothing}-- | Converts a reload entry to a filereloadToFile::ReloadEntry->IOFilereloadToFileentry=do(etag,ct)<-reloadContententryletetag'=T.encodeUtf8etagreturn$File{fileGetSize=fromIntegral$BL.lengthct,fileToResponse=\sh->W.responseLBSshct-- Similar to above the entire path needs to be in the fileName.,fileName=unsafeToPiece$reloadLocationentry,fileGetHash=return$ifT.nulletagthenNothingelseJustetag',fileGetModified=Nothing}-- | Build a static settings based on a filemap.filemapToSettings::M.HashMapT.Text(MimeType,IOFile)->StaticSettingsfilemapToSettingsmfiles=(defaultWebAppSettings""){ssLookupFile=lookupFile,ssGetMimeType=lookupMime}wherepiecesToFilep=T.intercalate"/"$mapfromPieceplookupFile[]=returnLRNotFoundlookupFilep=caseM.lookup(piecesToFilep)mfilesofNothing->returnLRNotFoundJust(_,act)->LRFile<$>actlookupMime(File{fileName=p})=caseM.lookup(fromPiecep)mfilesofJust(mime,_)->returnmimeNothing->return$defaultMimeLookup$fromPiecep-- | Create a 'StaticSettings' from a list of entries. Executed at run time.entriesToSt::[EitherEmbeddedEntryReloadEntry]->StaticSettingsentriesToStentries=hmap`seq`filemapToSettingshmapwhereembFiles=[(embLocatione,(embMimee,return$embeddedToFilee))|e<-leftsentries]reloadFiles=[(reloadLocationr,(reloadMimer,reloadToFiler))|r<-rightsentries]hmap=M.fromList$embFiles++reloadFiles-- | Create a 'StaticSettings' at compile time that embeds resources directly into the compiled-- executable. The embedded resources are precompressed (depending on mime type)-- so that during runtime the resource can be served very quickly.---- Because of GHC Template Haskell stage restrictions, you must define-- the entries in a different module than where you create the 'StaticSettings'.-- For example,---- > {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}-- > module A (mkEmbedded) where-- > -- > import WaiAppStatic.Storage.Embedded-- > import Crypto.Hash.MD5 (hashlazy)-- > import qualified Data.ByteString.Lazy as BL-- > import qualified Data.ByteString.Base64 as B64-- > import qualified Data.Text as T-- > import qualified Data.Text.Encoding as T-- > -- > hash :: BL.ByteString -> T.Text-- > hash = T.take 8 . T.decodeUtf8 . B64.encode . hashlazy-- > -- > mkEmbedded :: IO [EmbeddableEntry]-- > mkEmbedded = do-- > file <- BL.readFile "test.css"-- > let emb = EmbeddableEntry {-- > eLocation = "somedir/test.css"-- > , eMimeType = "text/css"-- > , eContent = Left (hash file, file)-- > }-- > -- > let reload = EmbeddableEntry {-- > eLocation = "anotherdir/test2.txt"-- > , eMimeType = "text/plain"-- > , eContent = Right [| BL.readFile "test2.txt" >>= \c -> return (hash c, c) |]-- > }-- > -- > return [emb, reload]---- The above @mkEmbedded@ will be executed at compile time. It loads the contents of test.css and-- computes the hash of test.css for the etag. The content will be available at the URL somedir/test.css.-- Internally, 'embedApp' below will attempt to compress the content at compile time. The compression will-- only happen if the compressed content is shorter than the original and the mime type is either text or-- javascript. If the content is compressed, at runtime the precomputed compressed content will be served-- with the appropriate HTTP header. If 'embedApp' decides not to compress the content, it will be-- served directly.---- Secondly, @mkEmbedded@ creates a reloadable entry. This will be available at the URL anotherdir/test2.txt.-- Whenver a request comes in for anotherdir/test2.txt, the action inside the quasiquote in eContent will-- be executed. This will re-read the test2.txt file and recompute its hash.---- Finally, here is a module which uses the above action to create a 'W.Application'.---- > {-# LANGUAGE TemplateHaskell #-}-- > module B where-- > -- > import A-- > import Network.Wai (Application)-- > import Network.Wai.Application.Static (staticApp)-- > import WaiAppStatic.Storage.Embedded-- > import Network.Wai.Handler.Warp (run)-- > -- > myApp :: Application-- > myApp = staticApp $(mkSettings mkEmbedded)-- > -- > main :: IO ()-- > main = run 3000 myAppmkSettings::IO[EmbeddableEntry]->ExpQmkSettingsaction=doentries<-runIOaction[|entriesToSt$(listE$mapmkEntryentries)|]shouldCompress::MimeType->BoolshouldCompressm="text/"`B.isPrefixOf`m||m`elem`extrawhereextra=["application/json","application/javascript","application/ecmascript"]-- | Only compress if the mime type is correct and the compressed text is actually shorter.tryCompress::MimeType->BL.ByteString->(Bool,BL.ByteString)tryCompressmimect|shouldCompressmime=(c,ct')|otherwise=(False,ct)wherecompressed=compressctc=BL.lengthcompressed<BL.lengthctct'=ifcthencompressedelsect