Rakka/Resource/Object.hs

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