From 6774f0275c946faf58f82911e74e9d958da372d7 Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Wed, 18 Mar 2015 16:43:27 +1100
Subject: [PATCH] Add tests for ResponseHeaders

---
 servant.cabal                        |  2 ++
 src/Servant/API/ContentTypes.hs      |  6 ++++++
 test/Servant/API/ContentTypesSpec.hs | 18 ++++++++++++++++++
 3 files changed, 26 insertions(+)

diff --git a/servant.cabal b/servant.cabal
index 3657f524..7373694b 100644
--- a/servant.cabal
+++ b/servant.cabal
@@ -90,7 +90,9 @@ test-suite spec
     , aeson
     , attoparsec
     , bytestring
+    , http-types
     , hspec == 2.*
+    , HUnit
     , QuickCheck
     , quickcheck-instances
     , parsec
diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs
index e12f991a..e41a3e44 100644
--- a/src/Servant/API/ContentTypes.hs
+++ b/src/Servant/API/ContentTypes.hs
@@ -332,6 +332,12 @@ instance MimeUnrender OctetStream BS.ByteString where
 class KnownSymbols a where
     symbolVals :: Proxy a -> [String]
 
+instance KnownSymbols '[] where
+    symbolVals _ = []
+
+instance (KnownSymbol x, KnownSymbols xs) => KnownSymbols (x ': xs) where
+    symbolVals _ = symbolVal (Proxy :: Proxy x) : symbolVals (Proxy :: Proxy xs)
+
 instance (KnownSymbols hs, MimeUnrender ct a)
          => MimeUnrender (ResponseHeaders hs ct) ([H.Header], a) where
     fromByteString _ hs body = do
diff --git a/test/Servant/API/ContentTypesSpec.hs b/test/Servant/API/ContentTypesSpec.hs
index 02bcfb0c..32e2f3ba 100644
--- a/test/Servant/API/ContentTypesSpec.hs
+++ b/test/Servant/API/ContentTypesSpec.hs
@@ -23,8 +23,10 @@ import           Data.String.Conversions    (cs)
 import qualified Data.Text                  as TextS
 import qualified Data.Text.Lazy             as TextL
 import           GHC.Generics
+import qualified Network.HTTP.Types         as H
 import           Network.URL                (exportParams, importParams)
 import           Test.Hspec
+import           Test.HUnit
 import           Test.QuickCheck
 import           Test.QuickCheck.Instances  ()
 
@@ -165,6 +167,22 @@ spec = describe "Servant.API.ContentTypes" $ do
             property $ \x -> toMaybe (eitherDecodeLenient x)
                 `shouldBe` toMaybe (parseOnly jstring $ cs x)
 
+    describe "ResponseHeaders" $ do
+
+        it "decoding succeeds and only returns the specified header" $ do
+            let res = fromByteString (Proxy :: Proxy (ResponseHeaders '["TestHeader"] JSON))
+                                     [("Foo", "NOOOOO"), ("TestHeader", "YAY")]
+                                     "1"
+            res `shouldBe` Right ([("TestHeader", "YAY") :: H.Header], (1 :: Int))
+
+        it "decoding fails if a required header is not present" $ do
+            let res = fromByteString (Proxy :: Proxy (ResponseHeaders '["TestHeader"] JSON))
+                                     [("Foo", "NOOOOO")]
+                                     "1" :: Either String ([H.Header], Int)
+            case res of
+                Right _ -> assertFailure "Expected an error"
+                Left _ -> return ()
+
 
 data SomeData = SomeData { record1 :: String, record2 :: Int }
     deriving (Generic, Eq, Show)