From 1f1a398674f02340113475d58a6203ad1f12aafd Mon Sep 17 00:00:00 2001
From: Alex Chapman <a.chapman@data61.csiro.au>
Date: Tue, 9 Jul 2019 09:47:51 +1000
Subject: [PATCH] Add an error parameter to the ThrowAll typeclass

This is so that an application can use its own custom error type and still call `throwAll`.
---
 .../src/Servant/Auth/Server/Internal/ThrowAll.hs   | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs b/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs
index 956af6b..141993f 100644
--- a/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs
+++ b/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs
@@ -14,35 +14,35 @@ import Network.Wai
 
 import qualified Data.ByteString.Char8 as BS
 
-class ThrowAll a where
+class ThrowAll e a where
   -- | 'throwAll' is a convenience function to throw errors across an entire
   -- sub-API
   --
   --
   -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
   -- >    == throwError err400 :<|> throwError err400 :<|> err400
-  throwAll :: ServerError -> a
+  throwAll :: e -> a
 
-instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
+instance (ThrowAll e a, ThrowAll e b) => ThrowAll e (a :<|> b) where
   throwAll e = throwAll e :<|> throwAll e
 
 -- Really this shouldn't be necessary - ((->) a) should be an instance of
 -- MonadError, no?
-instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
+instance {-# OVERLAPPING #-} ThrowAll e b => ThrowAll e (a -> b) where
   throwAll e = const $ throwAll e
 
-instance {-# OVERLAPPABLE #-} (MonadError ServerError m) => ThrowAll (m a) where
+instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll e (m a) where
   throwAll = throwError
 
 -- | for @servant <0.11@
-instance {-# OVERLAPPING #-} ThrowAll Application where
+instance {-# OVERLAPPING #-} ThrowAll ServerError Application where
   throwAll e _req respond
       = respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e))
                               (errHeaders e)
                               (errBody e)
 
 -- | for @servant >=0.11@
-instance {-# OVERLAPPING #-} MonadError ServerError m => ThrowAll (Tagged m Application) where
+instance {-# OVERLAPPING #-} MonadError ServerError m => ThrowAll ServerError (Tagged m Application) where
   throwAll e = Tagged $ \_req respond ->
       respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e))
                               (errHeaders e)