Rakka/Resource/Object.hs

   1 module Rakka.Resource.Object
   2     ( resObject
   3     )
   4     where
   5
   6 import           Network.HTTP.Lucu
   7 import           Network.HTTP.Lucu.Utils
   8 import           Rakka.Environment
   9 import           Rakka.Page
  10 import           Rakka.Storage
  11 import           Rakka.SystemConfig
  12 import           System.FilePath
  13 import           System.Time
  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
  35          case pageM of
  36            Nothing
  37                -> foundNoEntity Nothing
  38
  39            Just redir@(Redirection _ _ _ _)
  40                -> handleRedirect env redir
  41
  42            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _)
  43                -> handleGetEntity env entity
  44
  45
  46 {-
  47   HTTP/1.1 302 Found
  48   Location: http://example.org/object/Destination
  49 -}
  50 handleRedirect :: Environment -> Page -> Resource ()
  51 handleRedirect env redir
  52     = do BaseURI baseURI <- getSysConf (envSysConf env) (BaseURI undefined)
  53          redirect Found (mkObjectURI baseURI $ redirName redir)
  54
  55
  56 {-
  57   HTTP/1.1 200 OK
  58   Content-Type: image/png
  59
  60   ...
  61 -}
  62 handleGetEntity :: Environment -> Page -> Resource ()
  63 handleGetEntity env page
  64     = do let lastMod = toClockTime $ pageLastMod page
  65
  66          case pageRevision page of
  67            Nothing  -> foundTimeStamp lastMod
  68            Just rev -> foundEntity (strongETag $ show rev) lastMod
  69
  70          setContentType (pageType    page)
  71          outputLBS      (pageContent page)