+-- -*- Coding: utf-8 -*-
module Rakka.Resource.Object
( resObject
)
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
resObject :: Environment -> ResourceDef
resObject env
= ResourceDef {
resUsesNativeThread = False
- , resIsGreedy = False
- , resGet = Just $ do setContentType $ read "text/plain"
- output "FIXME: not implemented"
+ , resIsGreedy = True
+ , resGet = Just $ getPathInfo >>= handleGet env . toPageName
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
, resDelete = Nothing
}
+ where
+ toPageName :: [String] -> PageName
+ toPageName = decodePageName . joinWith "/"
+
+
+handleGet :: Environment -> PageName -> Resource ()
+handleGet env name
+ = do pageM <- getPage (envStorage env) name Nothing
+ case pageM of
+ Nothing
+ -> foundNoEntity Nothing
+
+ Just redir@(Redirection _ _ _ _ _)
+ -> handleRedirect env redir
+
+ Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+ -> handleGetEntity entity
+
+
+{-
+ HTTP/1.1 302 Found
+ Location: http://example.org/object/Destination
+-}
+handleRedirect :: Environment -> Page -> Resource ()
+handleRedirect env redir
+ = do BaseURI baseURI <- getSysConf (envSysConf env)
+ redirect Found (mkObjectURI baseURI $ redirName redir)
+
+
+{-
+ HTTP/1.1 200 OK
+ Content-Type: image/png
+
+ ...
+-}
+handleGetEntity :: Page -> Resource ()
+handleGetEntity page
+ = do case entityRevision page of
+ 0 -> foundTimeStamp (entityLastMod page) -- 0 はデフォルトページ
+ rev -> foundEntity (strongETag $ show rev) (entityLastMod page)
+ setContentType (entityType page)
+ setHeader (C8.pack "Content-Disposition")
+ (C8.pack $ "attachment; filename=" ++ quoteStr (entityFileName' page))
+ outputLBS (entityContent page)