X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FObject.hs;h=a18a268cb3504dc55badca12134cdf5883d02ed7;hb=602cb8599101da778f6cbb043451cfa458dff89c;hp=73f299bb955e39d628c7877c25175f0629d381c1;hpb=8a7556db44cd91ac0bb52279472bcc2abaa3f18e;p=Rakka.git diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs index 73f299b..a18a268 100644 --- a/Rakka/Resource/Object.hs +++ b/Rakka/Resource/Object.hs @@ -3,13 +3,14 @@ module Rakka.Resource.Object ) where +import Data.ByteString.Char8 as C8 +import Data.Maybe import Network.HTTP.Lucu import Network.HTTP.Lucu.Utils import Rakka.Environment import Rakka.Page import Rakka.Storage import Rakka.SystemConfig -import System.FilePath import System.Time @@ -31,7 +32,7 @@ resObject env handleGet :: Environment -> PageName -> Resource () handleGet env name - = do pageM <- getPage (envStorage env) name + = do pageM <- getPage (envStorage env) name Nothing case pageM of Nothing -> foundNoEntity Nothing @@ -39,7 +40,7 @@ handleGet env name Just redir@(Redirection _ _ _ _) -> handleRedirect env redir - Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _) + Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _) -> handleGetEntity env entity @@ -49,7 +50,7 @@ handleGet env name -} handleRedirect :: Environment -> Page -> Resource () handleRedirect env redir - = do BaseURI baseURI <- getSysConf (envSysConf env) (BaseURI undefined) + = do BaseURI baseURI <- getSysConf (envSysConf env) redirect Found (mkObjectURI baseURI $ redirName redir) @@ -64,8 +65,10 @@ handleGetEntity env page = do let lastMod = toClockTime $ pageLastMod page case pageRevision page of - Nothing -> foundTimeStamp lastMod - Just rev -> foundEntity (strongETag $ show rev) lastMod + 0 -> foundTimeStamp lastMod -- 0 はデフォルトページ + rev -> foundEntity (strongETag $ show rev) lastMod - setContentType (pageType page) - outputLBS (pageContent page) + setContentType (pageType page) + setHeader (C8.pack "Content-Disposition") + (C8.pack $ "attachment; filename=" ++ quoteStr (pageFileName' page)) + outputLBS (pageContent page)