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