@@ -10,16 +10,19 @@
1010#if !MIN_VERSION_base(4,8,0)
1111{-# LANGUAGE OverlappingInstances #-}
1212#endif
13+
1314module Servant.Server.Internal where
1415
16+#if !MIN_VERSION_base(4,8,0)
1517import Control.Applicative ((<$>))
18+import Data.Monoid (Monoid, mappend, mempty)
19+#endif
1620import Control.Monad.Trans.Either (EitherT, runEitherT)
1721import qualified Data.ByteString as B
1822import qualified Data.ByteString.Lazy as BL
1923import Data.IORef (newIORef, readIORef, writeIORef)
2024import Data.List (unfoldr)
2125import Data.Maybe (catMaybes, fromMaybe)
22−import Data.Monoid (Monoid, mappend, mempty)
2326import Data.String (fromString)
2427import Data.String.Conversions (cs, (<>))
2528import Data.Text (Text)
@@ -281,7 +284,7 @@ instance HasServer Delete where
281284-- If successfully returning a value, we use the type-level list, combined
282285-- with the request's @Accept@ header, to encode the value for you
283286-- (returning a status code of 200). If there was no @Accept@ header or it
284−-- was @*/*@, we return encode using the first @Content-Type@ type on the
287+-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
285288-- list.
286289instance
287290#if MIN_VERSION_base(4,8,0)
@@ -296,7 +299,7 @@ instance
296299 e <- runEitherT action
297300 respond $ case e of
298301 Right output -> do
299− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
302+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
300303 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
301304 Nothing -> failWith UnsupportedMediaType
302305 Just (contentT, body) -> succeedWith $
@@ -341,7 +344,7 @@ instance
341344 e <- runEitherT action
342345 respond $ case e of
343346 Right output -> do
344− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
347+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
345348 headers = getHeaders output
346349 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
347350 Nothing -> failWith UnsupportedMediaType
@@ -396,7 +399,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
396399-- If successfully returning a value, we use the type-level list, combined
397400-- with the request's @Accept@ header, to encode the value for you
398401-- (returning a status code of 201). If there was no @Accept@ header or it
399−-- was @*/*@, we return encode using the first @Content-Type@ type on the
402+-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
400403-- list.
401404instance
402405#if MIN_VERSION_base(4,8,0)
@@ -412,7 +415,7 @@ instance
412415 e <- runEitherT action
413416 respond $ case e of
414417 Right output -> do
415− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
418+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
416419 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
417420 Nothing -> failWith UnsupportedMediaType
418421 Just (contentT, body) -> succeedWith $
@@ -456,7 +459,7 @@ instance
456459 e <- runEitherT action
457460 respond $ case e of
458461 Right output -> do
459− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
462+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
460463 headers = getHeaders output
461464 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
462465 Nothing -> failWith UnsupportedMediaType
@@ -479,7 +482,7 @@ instance
479482-- If successfully returning a value, we use the type-level list, combined
480483-- with the request's @Accept@ header, to encode the value for you
481484-- (returning a status code of 200). If there was no @Accept@ header or it
482−-- was @*/*@, we return encode using the first @Content-Type@ type on the
485+-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
483486-- list.
484487instance
485488#if MIN_VERSION_base(4,8,0)
@@ -494,7 +497,7 @@ instance
494497 e <- runEitherT action
495498 respond $ case e of
496499 Right output -> do
497− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
500+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
498501 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
499502 Nothing -> failWith UnsupportedMediaType
500503 Just (contentT, body) -> succeedWith $
@@ -538,7 +541,7 @@ instance
538541 e <- runEitherT action
539542 respond $ case e of
540543 Right output -> do
541− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
544+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
542545 headers = getHeaders output
543546 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
544547 Nothing -> failWith UnsupportedMediaType
@@ -574,7 +577,7 @@ instance
574577 e <- runEitherT action
575578 respond $ case e of
576579 Right output -> do
577− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
580+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
578581 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
579582 Nothing -> failWith UnsupportedMediaType
580583 Just (contentT, body) -> succeedWith $
@@ -618,7 +621,7 @@ instance
618621 e <- runEitherT action
619622 respond $ case e of
620623 Right outpatch -> do
621− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
624+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
622625 headers = getHeaders outpatch
623626 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
624627 Nothing -> failWith UnsupportedMediaType
@@ -929,3 +932,6 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
929932 _ -> respond $ failWith NotFound
930933
931934 where proxyPath = Proxy :: Proxy path
935+
936+ct_wildcard :: B.ByteString
937+ct_wildcard = "*" <> "/" <> "*" -- Because CPP