Rakka/Resource/Object.hs

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