Rakka/Resource/Object.hs

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