X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FObject.hs;h=3a98b1e262810fdb403ac69c81fb7bb2fda9a7a6;hb=HEAD;hp=00ebc28e140a622e9d7560e66fb52afc7810adfa;hpb=b4a3d2cf3854b10d923cb4c546bf1fe32b021a68;p=Rakka.git diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs index 00ebc28..3a98b1e 100644 --- a/Rakka/Resource/Object.hs +++ b/Rakka/Resource/Object.hs @@ -1,47 +1,45 @@ --- -*- Coding: utf-8 -*- +{-# LANGUAGE + UnicodeSyntax + #-} module Rakka.Resource.Object ( resObject ) where - -import Data.ByteString.Char8 as C8 -import Data.Maybe +import qualified Codec.Binary.UTF8.String as UTF8 +import Control.Monad.Unicode +import qualified Data.Text as T import Network.HTTP.Lucu -import Network.HTTP.Lucu.Utils +import Prelude.Unicode import Rakka.Environment import Rakka.Page import Rakka.Storage import Rakka.SystemConfig +import System.FilePath.Posix - -resObject :: Environment -> ResourceDef +resObject ∷ Environment → ResourceDef resObject env = ResourceDef { resUsesNativeThread = False , resIsGreedy = True - , resGet = Just $ getPathInfo >>= handleGet env . toPageName + , resGet = Just $ getPathInfo ≫= handleGet env ∘ toPageName , resHead = Nothing , resPost = Nothing , resPut = Nothing , resDelete = Nothing } where - toPageName :: [String] -> PageName - toPageName = decodePageName . joinWith "/" - + toPageName ∷ [String] → PageName + toPageName = T.pack ∘ UTF8.decodeString . joinPath handleGet :: Environment -> PageName -> Resource () handleGet env name = do pageM <- getPage (envStorage env) name Nothing case pageM of - Nothing - -> foundNoEntity Nothing - - Just redir@(Redirection _ _ _ _ _) - -> handleRedirect env redir - - Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) - -> handleGetEntity entity + Nothing -> foundNoEntity Nothing + Just page -> if isEntity page then + handleGetEntity page + else + handleRedirect env page {- @@ -67,6 +65,4 @@ handleGetEntity page rev -> foundEntity (strongETag $ show rev) (entityLastMod page) setContentType (entityType page) - setHeader (C8.pack "Content-Disposition") - (C8.pack $ "attachment; filename=" ++ quoteStr (entityFileName' page)) outputLBS (entityContent page)