From b6dbd27eb0fe550c0d3689c5f041438348fa69b1 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Sat, 20 Jan 2018 09:42:26 +0100
Subject: [PATCH] Cleanup

---
 package.yaml                    |  1 +
 src/Handler/CryptoIDDispatch.hs | 15 +++++++++++++--
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/package.yaml b/package.yaml
index 99ef36dd0..767109324 100644
--- a/package.yaml
+++ b/package.yaml
@@ -76,6 +76,7 @@ dependencies:
 - LDAP
 - parsec
 - uuid
+- exceptions
 
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.
diff --git a/src/Handler/CryptoIDDispatch.hs b/src/Handler/CryptoIDDispatch.hs
index 68890b823..eb76377ac 100644
--- a/src/Handler/CryptoIDDispatch.hs
+++ b/src/Handler/CryptoIDDispatch.hs
@@ -22,6 +22,10 @@ import Data.Proxy
 
 import qualified Data.UUID.Cryptographic as UUID
 
+import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
+
+import qualified Control.Monad.Catch as E (Handler(..))
+
 
 class KnownSymbol namespace => CryptoRoute ciphertext namespace where
   cryptoIDRoute :: CryptoID namespace ciphertext -> Handler (Route UniWorX)
@@ -45,12 +49,19 @@ instance (CryptoRoute ciphertext namespace, Dispatch ciphertext ns) => Dispatch
     where
       headID :: CryptoID namespace ciphertext
       headID = CryptoID{..}
-      dispatchHead = (Just <$> cryptoIDRoute headID) `catchAny` (\_ -> return Nothing)
+      dispatchHead = (Just <$> cryptoIDRoute headID) `catches` [ E.Handler handleHCError, E.Handler handleCryptoID ]
+        where
+          handleHCError :: HandlerContents -> Handler (Maybe a)
+          handleHCError (HCError NotFound) = return Nothing
+          handleHCError e = throwM e
+          handleCryptoID :: CryptoIDError -> Handler (Maybe a)
+          handleCryptoID _ = return Nothing
       dispatchTail = dispatchID (Proxy :: Proxy ns) ciphertext
   
 
 getCryptoUUIDDispatchR :: UUID -> Handler ()
 getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
   where
-    p :: Proxy '["Submission"]
+    p :: Proxy '[ "Submission"
+                ]
     p = Proxy