Cleanup
This commit is contained in:
parent
d37ee331f6
commit
b6dbd27eb0
@ -76,6 +76,7 @@ dependencies:
|
|||||||
- LDAP
|
- LDAP
|
||||||
- parsec
|
- parsec
|
||||||
- uuid
|
- uuid
|
||||||
|
- exceptions
|
||||||
|
|
||||||
# The library contains all of our application code. The executable
|
# The library contains all of our application code. The executable
|
||||||
# defined below is just a thin wrapper.
|
# defined below is just a thin wrapper.
|
||||||
|
|||||||
@ -22,6 +22,10 @@ import Data.Proxy
|
|||||||
|
|
||||||
import qualified Data.UUID.Cryptographic as UUID
|
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
|
class KnownSymbol namespace => CryptoRoute ciphertext namespace where
|
||||||
cryptoIDRoute :: CryptoID namespace ciphertext -> Handler (Route UniWorX)
|
cryptoIDRoute :: CryptoID namespace ciphertext -> Handler (Route UniWorX)
|
||||||
@ -45,12 +49,19 @@ instance (CryptoRoute ciphertext namespace, Dispatch ciphertext ns) => Dispatch
|
|||||||
where
|
where
|
||||||
headID :: CryptoID namespace ciphertext
|
headID :: CryptoID namespace ciphertext
|
||||||
headID = CryptoID{..}
|
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
|
dispatchTail = dispatchID (Proxy :: Proxy ns) ciphertext
|
||||||
|
|
||||||
|
|
||||||
getCryptoUUIDDispatchR :: UUID -> Handler ()
|
getCryptoUUIDDispatchR :: UUID -> Handler ()
|
||||||
getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
|
getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
|
||||||
where
|
where
|
||||||
p :: Proxy '["Submission"]
|
p :: Proxy '[ "Submission"
|
||||||
|
]
|
||||||
p = Proxy
|
p = Proxy
|
||||||
|
|||||||
Reference in New Issue
Block a user