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")]