From 757d92430252e246666f8c2f14bb029a401157ce Mon Sep 17 00:00:00 2001
From: Oswyn Brent <oswyn.brent@anchor.com.au>
Date: Wed, 24 Jun 2015 12:02:03 +1000
Subject: [PATCH] wip-either

---
 servant-server/src/Servant/Server/Internal.hs | 11 ++++++++---
 servant-server/test/Servant/ServerSpec.hs     | 12 ++++++------
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index 02c729f3..30b30af0 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -284,12 +284,17 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
       => HasServer (Header sym a :> sublayout) where
 
   type ServerT (Header sym a :> sublayout) m =
-    Maybe a -> ServerT sublayout m
+    Either String (Maybe a) -> ServerT sublayout m
 
   route Proxy subserver = WithRequest $ \ request ->
-    let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
+    let mheader = case lookup str (requestHeaders request) of
+            Nothing -> Right Nothing
+            Just x  -> case fromText $ decodeUtf8 x of
+                Nothing -> Left  $ "Failed to decode " <> headerVal <> " header"
+                Just v  -> Right $ Just v
     in  route (Proxy :: Proxy sublayout) (feedTo subserver mheader)
-    where str = fromString $ symbolVal (Proxy :: Proxy sym)
+    where headerVal = symbolVal (Proxy :: Proxy sym)
+          str       = fromString headerVal
 
 -- | When implementing the handler for a 'Post' endpoint,
 -- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs
index 00087d93..917710cc 100644
--- a/servant-server/test/Servant/ServerSpec.hs
+++ b/servant-server/test/Servant/ServerSpec.hs
@@ -452,13 +452,13 @@ headerApi = Proxy
 headerSpec :: Spec
 headerSpec = describe "Servant.API.Header" $ do
 
-    let expectsInt :: Maybe Int -> EitherT ServantErr IO ()
-        expectsInt (Just x) = when (x /= 5) $ error "Expected 5"
-        expectsInt Nothing  = error "Expected an int"
+    let expectsInt :: Either String (Maybe Int) -> EitherT ServantErr IO ()
+        expectsInt (Right (Just x)) = when (x /= 5) $ error "Expected 5"
+        expectsInt _                = error "Expected an int"
 
-    let expectsString :: Maybe String -> EitherT ServantErr IO ()
-        expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
-        expectsString Nothing  = error "Expected a string"
+    let expectsString :: Either String (Maybe String) -> EitherT ServantErr IO ()
+        expectsString (Right (Just x)) = when (x /= "more from you") $ error "Expected more from you"
+        expectsString _                = error "Expected a string"
 
     with (return (serve headerApi expectsInt)) $ do
         let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"5")]