eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #585 from axman6/axman6/get-headers-581

Browse source 
Replace use of ToByteString with HttpApiData for GetHeaders
This commit is contained in:
Julian Arni 2016-09-06 20:59:46 -03:00 committed by GitHub
commit 29af0bbdf9
9 changed files with 20 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-docs/servant-docs.cabal
View file

@ -36,7 +36,6 @@ library
, aeson
, aeson-pretty
, bytestring
, bytestring-conversion
, case-insensitive
, hashable
, http-media >= 0.6
@ -61,7 +60,6 @@ executable greet-docs
build-depends:
base
, aeson
, bytestring-conversion
, lens
, servant
, servant-docs

5
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -25,7 +25,6 @@ import Control.Arrow (second)
import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),
(&), (.~), (<>~), (^.), (|>))
import qualified Control.Monad.Omega as Omega
import Data.ByteString.Conversion (ToByteString, toByteString)
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BSC
import qualified Data.CaseInsensitive as CI
@ -461,12 +460,12 @@ class AllHeaderSamples ls where
instance AllHeaderSamples '[] where
allHeaderToSample _ = []
instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
instance (ToHttpApiData l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
=> AllHeaderSamples (Header h l ': ls) where
allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) :
allHeaderToSample (Proxy :: Proxy ls)
where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h)
mkHeader (Just x) = (headerName, cs $ toByteString x)
mkHeader (Just x) = (headerName, cs $ toHeader x)
mkHeader Nothing = (headerName, "<no header sample provided>")
-- | Synthesise a sample value of a type, encoded in the specified media types.

1
servant-mock/servant-mock.cabal
View file

@ -69,5 +69,4 @@ test-suite spec
servant-server,
servant-mock,
aeson,
bytestring-conversion,
wai

9
servant-mock/test/Servant/MockSpec.hs
View file

@ -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 = toUrlPiece . show
toQueryParam = toQueryParam . show
instance Arbitrary TestHeader where
arbitrary = return ArbitraryHeader

1
servant-server/servant-server.cabal
View file

@ -114,7 +114,6 @@ test-suite spec
, aeson
, base64-bytestring
, bytestring
, bytestring-conversion
, directory
, exceptions
, hspec == 2.*

1
servant-server/test/Servant/ServerSpec.hs
View file

@ -17,7 +17,6 @@ import Control.Monad (forM_, when, unless)
import Control.Monad.Trans.Except (throwE)
import Data.Aeson (FromJSON, ToJSON, decode', encode)
import qualified Data.ByteString.Base64 as Base64
import Data.ByteString.Conversion ()
import Data.Char (toUpper)
import Data.Monoid
import Data.Proxy (Proxy (Proxy))

1
servant/CHANGELOG.md
View file

@ -2,6 +2,7 @@
----
* Add `CaptureAll` combinator. Captures all of the remaining segments in a URL.
* BACKWARDS INCOMPATIBLE replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo`
0.8
---

1
servant/servant.cabal
View file

@ -54,7 +54,6 @@ library
, aeson >= 0.7 && < 1.1
, attoparsec >= 0.12 && < 0.14
, bytestring >= 0.10 && < 0.11
, bytestring-conversion >= 0.3 && < 0.4
, case-insensitive >= 1.2 && < 1.3
, http-api-data >= 0.1 && < 0.3
, http-media >= 0.4 && < 0.7

24
servant/src/Servant/API/ResponseHeaders.hs
View file

@ -31,8 +31,8 @@ module Servant.API.ResponseHeaders
) where
import Data.ByteString.Char8 as BS (pack, unlines, init)
import Data.ByteString.Conversion (ToByteString, toByteString',
FromByteString, fromByteString)
import Web.HttpApiData (ToHttpApiData, toHeader,
FromHttpApiData, parseHeader)
import qualified Data.CaseInsensitive as CI
import Data.Proxy
import GHC.TypeLits (KnownSymbol, symbolVal)
@ -68,17 +68,17 @@ class BuildHeadersTo hs where
instance OVERLAPPING_ BuildHeadersTo '[] where
buildHeadersTo _ = HNil
instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h )
instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
=> BuildHeadersTo ((Header h v) ': xs) where
buildHeadersTo headers =
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
in case matching of
[] -> MissingHeader `HCons` buildHeadersTo headers
xs -> case fromByteString (BS.init $ BS.unlines xs) of
Nothing -> UndecodableHeader (BS.init $ BS.unlines xs)
xs -> case parseHeader (BS.init $ BS.unlines xs) of
Left _err -> UndecodableHeader (BS.init $ BS.unlines xs)
`HCons` buildHeadersTo headers
Just h -> Header h `HCons` buildHeadersTo headers
Right h -> Header h `HCons` buildHeadersTo headers
-- * Getting
@ -88,18 +88,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 +111,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)