Rakka/Resource/Object.hs

   1 -- -*- Coding: utf-8 -*-
   2 module Rakka.Resource.Object
   3     ( resObject
   4     )
   5     where
   6
   7 import           Data.ByteString.Char8 as C8
   8 import           Data.Maybe
   9 import           Network.HTTP.Lucu
  10 import           Network.HTTP.Lucu.Utils
  11 import           Rakka.Environment
  12 import           Rakka.Page
  13 import           Rakka.Storage
  14 import           Rakka.SystemConfig
  15
  16
  17 resObject :: Environment -> ResourceDef
  18 resObject env
  19     = ResourceDef {
  20         resUsesNativeThread = False
  21       , resIsGreedy         = True
  22       , resGet              = Just $ getPathInfo >>= handleGet env . toPageName
  23       , resHead             = Nothing
  24       , resPost             = Nothing
  25       , resPut              = Nothing
  26       , resDelete           = Nothing
  27       }
  28     where
  29       toPageName :: [String] -> PageName
  30       toPageName = decodePageName . joinWith "/"
  31
  32
  33 handleGet :: Environment -> PageName -> Resource ()
  34 handleGet env name
  35     = do pageM <- getPage (envStorage env) name Nothing
  36          case pageM of
  37            Nothing
  38                -> foundNoEntity Nothing
  39
  40            Just redir@(Redirection _ _ _ _ _)
  41                -> handleRedirect env redir
  42
  43            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
  44                -> handleGetEntity entity
  45
  46
  47 {-
  48   HTTP/1.1 302 Found
  49   Location: http://example.org/object/Destination
  50 -}
  51 handleRedirect :: Environment -> Page -> Resource ()
  52 handleRedirect env redir
  53     = do BaseURI baseURI <- getSysConf (envSysConf env)
  54          redirect Found (mkObjectURI baseURI $ redirName redir)
  55
  56
  57 {-
  58   HTTP/1.1 200 OK
  59   Content-Type: image/png
  60
  61   ...
  62 -}
  63 handleGetEntity :: Page -> Resource ()
  64 handleGetEntity page
  65     = do case entityRevision page of
  66            0   -> foundTimeStamp (entityLastMod page) -- 0 はデフォルトページ
  67            rev -> foundEntity (strongETag $ show rev) (entityLastMod page)
  68
  69          setContentType (entityType page)
  70          setHeader (C8.pack "Content-Disposition")
  71                        (C8.pack $ "attachment; filename=" ++ quoteStr (entityFileName' page))
  72          outputLBS (entityContent page)