From da388782122779e865fc5454e5182d95c7f8fa26 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Sun, 18 Mar 2012 23:49:50 +0100 Subject: * correctly serving 404s with status code 404 :| --- src/Blog.hs | 4 ++-- src/Locales.hs | 6 +++--- src/Main.hs | 12 ++++++------ 3 files changed, 11 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/Blog.hs b/src/Blog.hs index d6b806985ed6..f481e578fd68 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -237,9 +237,9 @@ editPage (Entry{..}) = adminTemplate "Index" $ -- Error pages showError :: BlogError -> BlogLang -> Html -showError NotFound l = blogTemplate l (T.append ": " $ notFound l) $ +showError NotFound l = blogTemplate l (T.append ": " $ notFoundTitle l) $ H.div ! A.class_ "innerBox" $ do - H.div ! A.class_ "innerBoxTop" $ toHtml $ notFound l + H.div ! A.class_ "innerBoxTop" $ toHtml $ notFoundTitle l H.div ! A.class_ "innerBoxMiddle" $ do H.p ! A.class_ "notFoundFace" $ toHtml (":'(" :: Text) H.p ! A.class_ "notFoundText" $ toHtml $ notFoundText l diff --git a/src/Locales.hs b/src/Locales.hs index c1dc02453c12..7d36b2d2b138 100644 --- a/src/Locales.hs +++ b/src/Locales.hs @@ -116,9 +116,9 @@ cSend DE = "Absenden" cSend EN = "Submit" -- errors -notFound :: BlogLang -> Text -notFound DE = "Nicht gefunden" -notFound EN = "Not found" +notFoundTitle :: BlogLang -> Text +notFoundTitle DE = "Nicht gefunden" +notFoundTitle EN = "Not found" notFoundText :: BlogLang -> Text notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden." diff --git a/src/Main.hs b/src/Main.hs index f12c74349414..ce423f932d9f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -74,7 +74,7 @@ tazBlog acid = , dir "admin" $ ok $ toResponse $ adminLogin , dir "dologin" $ processLogin acid , serveDirectory DisableBrowsing [] "../res" - , ok $ toResponse $ showError NotFound DE + , notFound $ toResponse $ showError NotFound DE ] blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response @@ -85,7 +85,7 @@ blogHandler acid lang = \(eId :: Integer) -> addComment acid lang $ EntryId eId , do nullDir showIndex acid lang - , ok $ toResponse $ showError NotFound lang + , notFound $ toResponse $ showError NotFound lang ] formatOldLink :: Int -> Int -> String -> ServerPart Response @@ -96,11 +96,11 @@ formatOldLink y m id_ = showEntry :: AcidState Blog -> BlogLang -> EntryId -> ServerPart Response showEntry acid lang eId = do entry <- query' acid (GetEntry eId) - ok $ tryEntry entry lang + tryEntry entry lang -tryEntry :: Maybe Entry -> BlogLang -> Response -tryEntry Nothing lang = toResponse $ showError NotFound lang -tryEntry (Just entry) _ = toResponse $ blogTemplate eLang eTitle $ renderEntry entry +tryEntry :: Maybe Entry -> BlogLang -> ServerPart Response +tryEntry Nothing lang = notFound $ toResponse $ showError NotFound lang +tryEntry (Just entry) _ = ok $ toResponse $ blogTemplate eLang eTitle $ renderEntry entry where eTitle = T.append ": " (title entry) eLang = lang entry -- cgit 1.4.1