diff --git a/servant-server.cabal b/servant-server.cabal index b4b2b3ab..8061a0ba 100644 --- a/servant-server.cabal +++ b/servant-server.cabal @@ -31,7 +31,6 @@ library exposed-modules: Servant Servant.Server - Servant.Server.ContentTypes Servant.Server.Internal Servant.Utils.StaticFiles build-depends: @@ -40,7 +39,6 @@ library , attoparsec >= 0.12 && < 0.13 , bytestring >= 0.10 && < 0.11 , either >= 4.3 && < 4.4 - , http-media >= 0.4 && < 0.5 , http-types >= 0.8 && < 0.9 , network-uri >= 2.6 && < 2.7 , safe >= 0.3 && < 0.4 diff --git a/src/Servant.hs b/src/Servant.hs index 0a92f8dd..38671f34 100644 --- a/src/Servant.hs +++ b/src/Servant.hs @@ -8,7 +8,6 @@ module Servant ( -- | Using your types in request paths and query string parameters module Servant.Common.Text, -- | Utilities on top of the servant core - module Servant.QQ, module Servant.Utils.Links, module Servant.Utils.StaticFiles, -- | Useful re-exports @@ -19,6 +18,5 @@ import Data.Proxy import Servant.API import Servant.Common.Text import Servant.Server -import Servant.QQ import Servant.Utils.Links import Servant.Utils.StaticFiles diff --git a/src/Servant/Server.hs b/src/Servant/Server.hs index 2495022e..4f8c94a8 100644 --- a/src/Servant/Server.hs +++ b/src/Servant/Server.hs @@ -16,7 +16,6 @@ import Data.Proxy (Proxy) import Network.Wai (Application) import Servant.Server.Internal -import Servant.Server.ContentTypes () -- * Implementing Servers diff --git a/src/Servant/Server/ContentTypes.hs b/src/Servant/Server/ContentTypes.hs deleted file mode 100644 index 8557dc3c..00000000 --- a/src/Servant/Server/ContentTypes.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -module Servant.Server.ContentTypes where - -import Control.Monad (join) -import Control.Arrow (left) -import Data.Aeson (ToJSON(..), FromJSON(..), encode, eitherDecode) -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString as BS -import Data.Proxy (Proxy(..)) -import Data.String.Conversions (cs) -import qualified Data.Text.Lazy.Encoding as Text -import qualified Data.Text.Lazy as Text -import GHC.Exts (Constraint) -import qualified Network.HTTP.Media as M - - -import Servant.API ( XML, HTML, JSON, JavaScript, CSS, PlainText - , OctetStream, MimeRender(..), MimeUnrender(..) ) - - --------------------------------------------------------------------------- --- * MimeRender Instances - --- | @encode@ -instance ToJSON a => MimeRender JSON a where - toByteString _ = encode - --- | @encodeUtf8@ -instance MimeRender PlainText Text.Text where - toByteString _ = Text.encodeUtf8 - --------------------------------------------------------------------------- --- * MimeUnrender Instances - --- | @decode@ -instance FromJSON a => MimeUnrender JSON a where - fromByteString _ = eitherDecode - --- | @Text.decodeUtf8'@ -instance MimeUnrender PlainText Text.Text where - fromByteString _ = left show . Text.decodeUtf8' - diff --git a/test/Servant/Server/ContentTypesSpec.hs b/test/Servant/Server/ContentTypesSpec.hs deleted file mode 100644 index a857738b..00000000 --- a/test/Servant/Server/ContentTypesSpec.hs +++ /dev/null @@ -1,131 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Servant.Server.ContentTypesSpec where - -import Control.Applicative -import Data.Aeson (encode) -import Data.ByteString.Char8 -import Data.Function (on) -import Data.Maybe (isJust, fromJust) -import Data.List (maximumBy) -import Data.Proxy (Proxy(..)) -import qualified Data.Text.Lazy as T -import Data.String (IsString(..)) -import Data.String.Conversions (cs) -import Network.HTTP.Types (hAccept) -import Network.Wai (pathInfo, requestHeaders) -import Network.Wai.Test ( runSession, request, defaultRequest - , assertContentType, assertStatus ) -import Test.Hspec -import Test.QuickCheck - -import Servant.API -import Servant.API.ContentTypes -import Servant.Server -import Servant.Server.ContentTypes () - - -spec :: Spec -spec = describe "Servant.Server.ContentTypes" $ do - handleAcceptHSpec - contentTypeSpec - -handleAcceptHSpec :: Spec -handleAcceptHSpec = describe "handleAcceptH" $ do - - it "should return Just if the 'Accept' header matches" $ do - handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int) - `shouldSatisfy` isJust - handleAcceptH (Proxy :: Proxy '[XML, JSON]) "application/json" (3 :: Int) - `shouldSatisfy` isJust - handleAcceptH (Proxy :: Proxy '[XML, JSON, HTML]) "text/html" (3 :: Int) - `shouldSatisfy` isJust - - it "should return the Content-Type as the first element of the tuple" $ do - handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (3 :: Int) - `shouldSatisfy` ((== "application/json;charset=utf-8") . fst . fromJust) - handleAcceptH (Proxy :: Proxy '[XML, JSON]) "application/json" (3 :: Int) - `shouldSatisfy` ((== "application/json;charset=utf-8") . fst . fromJust) - handleAcceptH (Proxy :: Proxy '[XML, JSON, HTML]) "text/html" (3 :: Int) - `shouldSatisfy` ((== "text/html;charset=utf-8") . fst . fromJust) - - it "should return the appropriately serialized representation" $ do - property $ \x -> handleAcceptH (Proxy :: Proxy '[JSON]) "*/*" (x :: Int) - == Just ("application/json;charset=utf-8", encode x) - - it "respects the Accept spec ordering" $ - property $ \a b c i -> fst (fromJust $ val a b c i) == (fst $ highest a b c) - where - highest a b c = maximumBy (compare `on` snd) [ ("text/html;charset=utf-8", a) - , ("application/json;charset=utf-8", b) - , ("application/xml;charset=utf-8", c) - ] - acceptH a b c = addToAccept (Proxy :: Proxy HTML) a $ - addToAccept (Proxy :: Proxy JSON) b $ - addToAccept (Proxy :: Proxy XML ) c "" - val a b c i = handleAcceptH (Proxy :: Proxy '[HTML, JSON, XML]) - (acceptH a b c) (i :: Int) - -type ContentTypeApi = "foo" :> Get '[JSON] Int - :<|> "bar" :> Get '[JSON, PlainText] T.Text - -contentTypeApi :: Proxy ContentTypeApi -contentTypeApi = Proxy - -contentTypeServer :: Server ContentTypeApi -contentTypeServer = return 5 :<|> return "hi" - -contentTypeSpec :: Spec -contentTypeSpec = do - describe "Accept Headers" $ do - - it "uses the highest quality possible in the header" $ - flip runSession (serve contentTypeApi contentTypeServer) $ do - let acceptH = "text/plain; q=0.9, application/json; q=0.8" - response <- Network.Wai.Test.request defaultRequest{ - requestHeaders = [(hAccept, acceptH)] , - pathInfo = ["bar"] - } - assertContentType "text/plain;charset=utf8" response - - it "returns the first content-type if the Accept header is missing" $ - flip runSession (serve contentTypeApi contentTypeServer) $ do - response <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["bar"] - } - assertContentType "application/json;charset=utf8" response - - it "returns 406 if it can't serve the requested content-type" $ - flip runSession (serve contentTypeApi contentTypeServer) $ do - let acceptH = "text/css" - response <- Network.Wai.Test.request defaultRequest{ - requestHeaders = [(hAccept, acceptH)] , - pathInfo = ["bar"] - } - assertStatus 406 response - - -instance Show a => MimeRender HTML a where - toByteString _ = cs . show - -instance Show a => MimeRender XML a where - toByteString _ = cs . show - -instance IsString AcceptHeader where - fromString = AcceptHeader . fromString - -addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader -addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h) - where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f) - cont "" = new - cont old = old `append` ", " `append` new - -newtype ZeroToOne = ZeroToOne Float - deriving (Eq, Show, Ord) - -instance Arbitrary ZeroToOne where - arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]