From a1b23018f97add4ccc56fbb50906f8fe0aa89ab5 Mon Sep 17 00:00:00 2001 From: Alex Mason Date: Fri, 2 Sep 2016 19:46:49 +1000 Subject: [PATCH] Replace use of ToByteString with HttpApiData for GetHeaders, fixes servant/#581 * Version bump because this changes the API for GetHeaders --- servant-mock/test/Servant/MockSpec.hs | 9 +++++---- servant/CHANGELOG.md | 1 + servant/servant.cabal | 2 +- servant/src/Servant/API/ResponseHeaders.hs | 15 ++++++++------- 4 files changed, 15 insertions(+), 12 deletions(-) diff --git a/servant-mock/test/Servant/MockSpec.hs b/servant-mock/test/Servant/MockSpec.hs index 7d7b32ac..dfbcc0b9 100644 --- a/servant-mock/test/Servant/MockSpec.hs +++ b/servant-mock/test/Servant/MockSpec.hs @@ -8,9 +8,7 @@ module Servant.MockSpec where import Data.Aeson as Aeson -import Data.ByteString.Conversion.To import Data.Proxy -import Data.String import GHC.Generics import Network.Wai import Servant.API @@ -40,8 +38,11 @@ data TestHeader | ArbitraryHeader deriving (Show) -instance ToByteString TestHeader where - builder = fromString . show +instance ToHttpApiData TestHeader where + toHeader = toHeader . show + toUrlPiece _ = error "ToHttpApiData.toUrlPiece not implemented for TestHeader" + toQueryParam _ = error "ToHttpApiData.toQueryParam not implemented for TestHeader" + instance Arbitrary TestHeader where arbitrary = return ArbitraryHeader diff --git a/servant/CHANGELOG.md b/servant/CHANGELOG.md index f35679d1..bff2ed3e 100644 --- a/servant/CHANGELOG.md +++ b/servant/CHANGELOG.md @@ -2,6 +2,7 @@ next ---- * Add `CaptureAll` combinator. Captures all of the remaining segments in a URL. +* replace use of `ToByteString` with `HttpApiData` for `GetHeaders` 0.8 --- diff --git a/servant/servant.cabal b/servant/servant.cabal index 3c89171f..0f308995 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -1,5 +1,5 @@ name: servant -version: 0.8 +version: 0.8.1 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them diff --git a/servant/src/Servant/API/ResponseHeaders.hs b/servant/src/Servant/API/ResponseHeaders.hs index cdb7341e..d70f78b5 100644 --- a/servant/src/Servant/API/ResponseHeaders.hs +++ b/servant/src/Servant/API/ResponseHeaders.hs @@ -31,8 +31,9 @@ module Servant.API.ResponseHeaders ) where import Data.ByteString.Char8 as BS (pack, unlines, init) -import Data.ByteString.Conversion (ToByteString, toByteString', +import Data.ByteString.Conversion (--ToByteString, toByteString', FromByteString, fromByteString) +import Web.HttpApiData (ToHttpApiData,toHeader) import qualified Data.CaseInsensitive as CI import Data.Proxy import GHC.TypeLits (KnownSymbol, symbolVal) @@ -88,18 +89,18 @@ class GetHeaders ls where instance OVERLAPPING_ GetHeaders (HList '[]) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) ) +instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) ) => GetHeaders (HList (Header h x ': xs)) where getHeaders hdrs = case hdrs of - Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest - UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest + Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest + UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest MissingHeader `HCons` rest -> getHeaders rest where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h) instance OVERLAPPING_ GetHeaders (Headers '[] a) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v ) +instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v ) => GetHeaders (Headers (Header h v ': rest) a) where getHeaders hs = getHeaders $ getHeadersHList hs @@ -111,11 +112,11 @@ class AddHeader h v orig new addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times -instance OVERLAPPING_ ( KnownSymbol h, ToByteString v ) +instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads) -instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v +instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v , new ~ (Headers '[Header h v] a) ) => AddHeader h v a new where addHeader a resp = Headers resp (HCons (Header a) HNil)