Handle missing table sql errors with 404

src/App.hs

@@ -1,10 +1,11 @@
 {-# LANGUAGE FlexibleContexts #-}
-module App (app) where
+module App (app, sqlErrHandler, isSqlError) where
 
 import Control.Monad (join)
 import Control.Arrow ((***))
 import Control.Applicative
 import Control.Monad.IO.Class (liftIO, MonadIO)
+-- import Control.Exception.Base
 
 import Data.Text hiding (map)
 import Data.Maybe (fromMaybe)
@@ -26,6 +27,7 @@ import Data.Aeson
 import Data.Coerce
 import Data.Monoid
 import qualified Hasql as H
+import qualified Hasql.Backend as HB
 import qualified Hasql.Postgres as H
 
 import PgQuery
@@ -158,6 +160,17 @@ app req =
     allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
 
 
+isSqlError :: HB.Error -> Maybe HB.Error
+isSqlError (HB.ErroneousResult x) = Just $ HB.ErroneousResult x
+isSqlError _ = Nothing
+
+sqlErrHandler :: HB.Error -> IO Response
+sqlErrHandler (HB.ErroneousResult err) = do
+  return $ if "42P01" `isInfixOf` err
+    then responseLBS status404 [] ""
+    else responseLBS status400 [] (cs err)
+sqlErrHandler _ = error "just for debugging"
+
 rangeStatus :: Int -> Int -> Int -> Status
 rangeStatus from to total
   | from > total            = status416

src/Main.hs

@@ -9,6 +9,7 @@ import Middleware
 import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Reader (runReaderT, ask)
+import Control.Exception
 import Data.String.Conversions (cs)
 import Network.Wai.Middleware.Cors (cors)
 import Network.Wai.Handler.Warp hiding (Connection)
@@ -44,13 +45,14 @@ main = do
       middle =
         (if configSecure conf then redirectInsecure else id)
         . gzip def . cors corsPolicy . clientErrors
-        . staticPolicy (only [("favicon.ico", "static/favicon.ico")]) in
+        . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
 
-    H.session pgSettings sessSettings $ do
+  H.session pgSettings sessSettings $ do
-      session' <- flip runReaderT <$> ask
+    session' <- flip runReaderT <$> ask
-      let runApp req respond = respond =<< session' (app req) in
+    let runApp req respond =
+          respond =<< catchJust isSqlError (session' $ app req) sqlErrHandler
 
-        liftIO $ runSettings appSettings $ middle runApp
+    liftIO $ runSettings appSettings $ middle runApp
  --     . authenticated (cs $ configAnonRole conf) $ app
 
   where

test/SpecHelper.hs

@@ -12,6 +12,7 @@ import Data.String.Conversions (cs)
 import Control.Monad.Reader (runReaderT, ask)
 -- import Control.Monad (void)
 import Control.Applicative ( (<$>) )
+import Control.Exception
 
 import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
                                   hRange, hAuthorization)
@@ -22,7 +23,7 @@ import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 -- import Network.Wai.Middleware.Cors (cors)
 
-import App (app)
+import App (app, sqlErrHandler, isSqlError)
 -- import Config (corsPolicy, AppConfig(..))
 -- import Auth (addUser)
 
@@ -44,7 +45,8 @@ withApp perform =
   perform $ \req resp ->
     H.session pgSettings testSettings $ do
       session' <- flip runReaderT <$> ask
-      liftIO $ resp =<< session' (app req)
+      liftIO $ resp =<< catchJust isSqlError (session' $ app req)
+        sqlErrHandler
 
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]