From e83397a1db504ee4195ee3f951c27588108e335d Mon Sep 17 00:00:00 2001
From: Andres Loeh <andres@well-typed.com>
Date: Mon, 1 Jun 2015 15:30:09 +0200
Subject: [PATCH] Fix the auth combinator example.

This change adapt the auth combinator example to the new router code.
In general, the server interpretation of user-written combinators will
be affected by the new routing code.

The change here also introduces a change in functionality: previously,
wrong authentication triggered a "hard failure", whereas we now trigger
a "soft failure", which is recoverable. For the simple example, this
does not make a lot of difference.

In general, I think having a soft failure is the right option to take
here, although we want a more general story about the relative
priorities of different error codes.
---
 .../auth-combinator/auth-combinator.hs          | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/servant-examples/auth-combinator/auth-combinator.hs
index c6373fe1..d1a11439 100644
--- a/servant-examples/auth-combinator/auth-combinator.hs
+++ b/servant-examples/auth-combinator/auth-combinator.hs
@@ -28,14 +28,15 @@ data AuthProtected
 instance HasServer rest => HasServer (AuthProtected :> rest) where
   type ServerT (AuthProtected :> rest) m = ServerT rest m
 
-  route Proxy a request respond =
-    case lookup "Cookie" (requestHeaders request) of
-      Nothing -> respond . succeedWith $ responseLBS status401 [] "Missing auth header."
-      Just v  -> do
-        authGranted <- isGoodCookie v
-        if authGranted
-          then route (Proxy :: Proxy rest) a request respond
-          else respond . succeedWith $ responseLBS status403 [] "Invalid cookie."
+  route Proxy a = WithRequest $ \ request ->
+    route (Proxy :: Proxy rest) $ do
+      case lookup "Cookie" (requestHeaders request) of
+        Nothing -> return $ failWith $ HttpError status401 (Just "Missing auth header.")
+        Just v  -> do
+          authGranted <- isGoodCookie v
+          if authGranted
+            then a
+            else return $ failWith $ HttpError status403 (Just "Invalid cookie.")
 
 type PrivateAPI = Get '[JSON] [PrivateData]