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