{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE TemplateHaskell, CPP #-}{-# LANGUAGE RecordWildCards #-}-- | Static file serving for WAI.moduleNetwork.Wai.Application.Static(-- * WAI applicationstaticApp-- ** Default Settings,defaultWebAppSettings,webAppSettingsWithLookup,defaultFileServerSettings,embeddedSettings-- ** Settings,StaticSettings,ssLookupFile,ssMkRedirect,ssGetMimeType,ssListing,ssIndices,ssMaxAge,ssRedirectToIndex)whereimportPreludehiding(FilePath)importqualifiedNetwork.WaiasWimportqualifiedNetwork.HTTP.TypesasHimportData.ByteString(ByteString)importqualifiedData.ByteString.Char8asS8importqualifiedData.ByteString.LazyasLimportData.ByteString.Lazy.Char8()importControl.Monad.IO.Class(liftIO)importBlaze.ByteString.Builder(toByteString)importData.FileEmbed(embedFile)importData.Text(Text)importqualifiedData.TextasTimportData.Either(rights)importNetwork.HTTP.Date(parseHTTPDate,epochTimeToHTTPDate,formatHTTPDate)importData.Monoid(First(First,getFirst),mconcat)importWaiAppStatic.TypesimportUtilimportWaiAppStatic.Storage.FilesystemimportWaiAppStatic.Storage.EmbeddedimportNetwork.Mime(MimeType)dataStaticResponse=-- | Just the etag hash or Nothing for no etag hashRedirectPieces(MaybeByteString)|NotFound|FileResponseFileH.ResponseHeaders|NotModified-- TODO: add file size|SendContentMimeTypeL.ByteString|WaiResponseW.ResponsesafeInit::[a]->[a]safeInit[]=[]safeInitxs=initxsfilterButLast::(a->Bool)->[a]->[a]filterButLast_[]=[]filterButLast_[x]=[x]filterButLastf(x:xs)|fx=x:filterButLastfxs|otherwise=filterButLastfxs-- | Serve an appropriate response for a folder request.serveFolder::StaticSettings->Pieces->W.Request->Folder->IOStaticResponseserveFolderss@StaticSettings{..}piecesreqfolder@Folder{..}=-- first check if there is an index file in this foldercasegetFirst$mconcat$map(findIndex$rightsfolderContents)ssIndicesofJustindex->doletpieces'=setLastpiecesindexinifssRedirectToIndexthenreturn$Redirectpieces'Nothing-- start the checking process over, with a new setelsecheckPiecessspieces'reqNothing->casessListingofJustlisting->do-- directory listings turned on, display itbuilder<-listingpiecesfolderreturn$WaiResponse$W.ResponseBuilderH.status200[("Content-Type","text/html; charset=utf-8")]builderNothing->return$WaiResponse$W.responseLBSH.status403[("Content-Type","text/plain")]"Directory listings disabled"wheresetLast::Pieces->Piece->PiecessetLast[]x=[x]setLast[t]x|fromPiecet==""=[x]setLast(a:b)x=a:setLastbxfindIndex::[File]->Piece->FirstPiecefindIndexfilesindex|index`elem`mapfileNamefiles=First$Justindex|otherwise=FirstNothingcheckPieces::StaticSettings->Pieces-- ^ parsed request->W.Request->IOStaticResponse-- If we have any empty pieces in the middle of the requested path, generate a-- redirect to get rid of them.checkPieces_pieces_|any(T.null.fromPiece)$safeInitpieces=return$Redirect(filterButLast(not.T.null.fromPiece)pieces)NothingcheckPiecesss@StaticSettings{..}piecesreq=dores<-ssLookupFilepiecescaseresofLRNotFound->returnNotFoundLRFilefile->serveFilessreqfileLRFolderfolder->serveFoldersspiecesreqfolderserveFile::StaticSettings->W.Request->File->IOStaticResponseserveFileStaticSettings{..}reqfile-- First check etag values, if turned on|ssUseHash=domHash<-fileGetHashfilecase(mHash,lookup"if-none-match"$W.requestHeadersreq)of-- if-none-match matches the actual hash, return a 304(Justhash,JustlastHash)|hash==lastHash->returnNotModified-- Didn't match, but we have a hash value. Send the file contents-- with an ETag header.---- Note: It would be arguably better to next check-- if-modified-since and return a 304 if that indicates a match as-- well. However, the circumstances under which such a situation-- could arise would be very anomolous, and should likely warrant a-- new file being sent anyway.(Justhash,_)->respond[("ETag",hash)]-- No hash value available, fall back to last modified support.(Nothing,_)->lastMod-- etag turned off, so jump straight to last modified|otherwise=lastModwheremLastSent=lookup"if-modified-since"(W.requestHeadersreq)>>=parseHTTPDatelastMod=case(fmapepochTimeToHTTPDate$fileGetModifiedfile,mLastSent)of-- File modified time is equal to the if-modified-since header,-- return a 304.---- Question: should the comparison be, date <= lastSent?(Justmdate,JustlastSent)|mdate==lastSent->returnNotModified-- Did not match, but we have a new last-modified header(Justmdate,_)->respond[("last-modified",formatHTTPDatemdate)]-- No modification time available(Nothing,_)->respond[]-- Send a file response with the additional weak headers provided.respondheaders=return$FileResponsefile$cacheControlssMaxAgeheaders-- | Return a difference list of headers based on the specified MaxAge.---- This function will return both Cache-Control and Expires headers, as-- relevant.cacheControl::MaxAge->(H.ResponseHeaders->H.ResponseHeaders)cacheControlmaxage=headerCacheControl.headerExpireswhereccInt=casemaxageofNoMaxAge->NothingMaxAgeSecondsi->JustiMaxAgeForever->JustoneYearoneYear::IntoneYear=60*60*24*365headerCacheControl=caseccIntofNothing->idJusti->(:)("Cache-Control",S8.append"public, max-age="$S8.pack$showi)headerExpires=casemaxageofNoMaxAge->idMaxAgeSeconds_->id-- FIXMEMaxAgeForever->(:)("Expires","Thu, 31 Dec 2037 23:55:55 GMT")-- | Turn a @StaticSettings@ into a WAI application.staticApp::StaticSettings->W.ApplicationstaticAppsetreq=staticAppPiecesset(W.pathInforeq)reqstaticAppPieces::StaticSettings->[Text]->W.ApplicationstaticAppPieces__req|W.requestMethodreq/="GET"=return$W.responseLBSH.status405[("Content-Type","text/plain")]"Only GET is supported"staticAppPieces_[".hidden","folder.png"]_=return$W.responseLBSH.status200[("Content-Type","image/png")]$L.fromChunks[$(embedFile"images/folder.png")]staticAppPieces_[".hidden","haskell.png"]_=return$W.responseLBSH.status200[("Content-Type","image/png")]$L.fromChunks[$(embedFile"images/haskell.png")]staticAppPiecesssrawPiecesreq=liftIO$docasetoPiecesrawPiecesofJustpieces->checkPiecessspiecesreq>>=responseNothing->return$W.responseLBSH.status403[("Content-Type","text/plain")]"Forbidden"whereresponse::StaticResponse->IOW.Responseresponse(FileResponsefilech)=domimetype<-ssGetMimeTypessfileletfilesize=fileGetSizefileletheaders=("Content-Type",mimetype):("Content-Length",S8.pack$showfilesize):chreturn$fileToResponsefileH.status200headersresponseNotModified=return$W.responseLBSH.status304[("Content-Type","text/plain")]"Not Modified"response(SendContentmtlbs)=do-- TODO: set caching headersreturn$W.responseLBSH.status200[("Content-Type",mt)-- TODO: set Content-Length]lbsresponse(Redirectpieces'mHash)=doletloc=(ssMkRedirectss)pieces'$toByteString(H.encodePathSegments$mapfromPiecepieces')letqString=casemHashofJusthash->replace"etag"(Justhash)(W.queryStringreq)Nothing->remove"etag"(W.queryStringreq)return$W.responseLBSH.status301[("Content-Type","text/plain"),("Location",S8.appendloc$H.renderQueryTrueqString)]"Redirect"responseNotFound=return$W.responseLBSH.status404[("Content-Type","text/plain")]"File not found"response(WaiResponser)=returnr