* correctly serving 404s with status code 404 :|
This commit is contained in:
		
							parent
							
								
									515660fa7d
								
							
						
					
					
						commit
						da38878212
					
				
					 3 changed files with 11 additions and 11 deletions
				
			
		
							
								
								
									
										12
									
								
								src/Main.hs
									
										
									
									
									
								
							
							
						
						
									
										12
									
								
								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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue