diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 83ae56f2..3c356066 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -77,6 +77,7 @@ test-suite spec , bytestring , deepseq , hspec == 2.* + , http-api-data , http-client , http-media , http-types diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index da7c763b..bf5abce5 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -30,28 +30,29 @@ module Servant.ClientSpec where import Control.Applicative ((<$>)) #endif import Control.Arrow (left) -import Control.Concurrent (forkIO, killThread, ThreadId) +import Control.Concurrent (ThreadId, forkIO, killThread) import Control.Exception (bracket) -import Control.Monad.Trans.Except (throwE, runExceptT) +import Control.Monad.Trans.Except (runExceptT, throwE) import Data.Aeson import qualified Data.ByteString.Lazy as BS import Data.Char (chr, isPrint) import Data.Foldable (forM_) import Data.Monoid hiding (getLast) import Data.Proxy -import qualified Data.Text as T import GHC.Generics (Generic) import qualified Network.HTTP.Client as C import Network.HTTP.Media import qualified Network.HTTP.Types as HTTP import Network.Socket -import Network.Wai (Request, requestHeaders, responseLBS) +import Network.Wai (Request, requestHeaders, + responseLBS) import Network.Wai.Handler.Warp import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit import Test.QuickCheck +import Web.FormUrlEncoded (FromForm, ToForm) import Servant.API import Servant.API.Internal.Test.ComprehensiveAPI @@ -82,19 +83,8 @@ data Person = Person { instance ToJSON Person instance FromJSON Person -instance ToFormUrlEncoded Person where - toFormUrlEncoded Person{..} = - [("name", T.pack name), ("age", T.pack (show age))] - -lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b -lookupEither x xs = do - maybe (Left $ "could not find key " <> show x) return $ lookup x xs - -instance FromFormUrlEncoded Person where - fromFormUrlEncoded xs = do - n <- lookupEither "name" xs - a <- lookupEither "age" xs - return $ Person (T.unpack n) (read $ T.unpack a) +instance ToForm Person where +instance FromForm Person where alice :: Person alice = Person "Alice" 42 diff --git a/servant/CHANGELOG.md b/servant/CHANGELOG.md index f35679d1..f460eddc 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. +* BACKWARD INCOMPATIBLE: Moved `From/ToFormUrlEncoded` classes, which were renamed to `From/ToForm` to `http-api-data` 0.8 --- diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index cbb0db09..2eb0d8dc 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -62,10 +62,10 @@ import Servant.API.Alternative ((:<|>) (..)) import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..)) import Servant.API.Capture (Capture, CaptureAll) import Servant.API.ContentTypes (Accept (..), FormUrlEncoded, - FromFormUrlEncoded (..), JSON, + JSON, MimeRender (..), NoContent (NoContent), MimeUnrender (..), OctetStream, - PlainText, ToFormUrlEncoded (..)) + PlainText) import Servant.API.Experimental.Auth (AuthProtect) import Servant.API.Header (Header (..)) import Servant.API.HttpVersion (HttpVersion (..)) diff --git a/servant/src/Servant/API/ContentTypes.hs b/servant/src/Servant/API/ContentTypes.hs index f10e2ba1..6969f7ee 100644 --- a/servant/src/Servant/API/ContentTypes.hs +++ b/servant/src/Servant/API/ContentTypes.hs @@ -66,15 +66,14 @@ module Servant.API.ContentTypes , AllMime(..) , AllMimeRender(..) , AllMimeUnrender(..) - , FromFormUrlEncoded(..) - , ToFormUrlEncoded(..) , eitherDecodeLenient , canHandleAcceptH ) where import Control.Arrow (left) import Control.Monad.Compat -import Data.Aeson (FromJSON(..), ToJSON(..), encode) +import Data.Aeson (FromJSON (..), ToJSON (..), + encode) import Data.Aeson.Parser (value) import Data.Aeson.Types (parseEither) import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly, @@ -82,10 +81,8 @@ import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly, import qualified Data.ByteString as BS import Data.ByteString.Lazy (ByteString, fromStrict, toStrict) -import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as BC import Data.Maybe (isJust) -import Data.Monoid.Compat import Data.String.Conversions (cs) import qualified Data.Text as TextS import qualified Data.Text.Encoding as TextS @@ -94,8 +91,9 @@ import qualified Data.Text.Lazy.Encoding as TextL import Data.Typeable import GHC.Generics (Generic) import qualified Network.HTTP.Media as M -import Network.URI (escapeURIString, - isUnreserved, unEscapeString) +import Web.FormUrlEncoded (FromForm, ToForm, + urlEncodeAsForm, + urlDecodeAsForm) import Prelude () import Prelude.Compat @@ -290,12 +288,12 @@ instance OVERLAPPABLE_ ToJSON a => MimeRender JSON a where mimeRender _ = encode --- | @encodeFormUrlEncoded . toFormUrlEncoded@ +-- | @urlEncodeAsForm" -- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only -- holds if every element of x is non-null (i.e., not @("", "")@) instance OVERLAPPABLE_ - ToFormUrlEncoded a => MimeRender FormUrlEncoded a where - mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded + ToForm a => MimeRender FormUrlEncoded a where + mimeRender _ = urlEncodeAsForm -- | `TextL.encodeUtf8` instance MimeRender PlainText TextL.Text where @@ -348,11 +346,11 @@ eitherDecodeLenient input = instance FromJSON a => MimeUnrender JSON a where mimeUnrender _ = eitherDecodeLenient --- | @decodeFormUrlEncoded >=> fromFormUrlEncoded@ +-- | @urlDecodeAsForm@ -- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only -- holds if every element of x is non-null (i.e., not @("", "")@) -instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where - mimeUnrender _ = decodeFormUrlEncoded >=> fromFormUrlEncoded +instance FromForm a => MimeUnrender FormUrlEncoded a where + mimeUnrender _ = left TextS.unpack . urlDecodeAsForm -- | @left show . TextL.decodeUtf8'@ instance MimeUnrender PlainText TextL.Text where @@ -375,49 +373,6 @@ instance MimeUnrender OctetStream BS.ByteString where mimeUnrender _ = Right . toStrict --------------------------------------------------------------------------- --- * FormUrlEncoded - --- | A type that can be converted to @application/x-www-form-urlencoded@ -class ToFormUrlEncoded a where - toFormUrlEncoded :: a -> [(TextS.Text, TextS.Text)] - -instance ToFormUrlEncoded [(TextS.Text, TextS.Text)] where - toFormUrlEncoded = id - --- | A type that can be converted from @application/x-www-form-urlencoded@, --- with the possibility of failure. -class FromFormUrlEncoded a where - fromFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> Either String a - -instance FromFormUrlEncoded [(TextS.Text, TextS.Text)] where - fromFormUrlEncoded = return - -encodeFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> ByteString -encodeFormUrlEncoded xs = - let escape :: TextS.Text -> ByteString - escape = cs . escapeURIString isUnreserved . cs - encodePair :: (TextS.Text, TextS.Text) -> ByteString - encodePair (k, "") = escape k - encodePair (k, v) = escape k <> "=" <> escape v - in B.intercalate "&" $ map encodePair xs - -decodeFormUrlEncoded :: ByteString -> Either String [(TextS.Text, TextS.Text)] -decodeFormUrlEncoded "" = return [] -decodeFormUrlEncoded q = do - let xs :: [TextS.Text] - xs = TextS.splitOn "&" . cs $ q - parsePair :: TextS.Text -> Either String (TextS.Text, TextS.Text) - parsePair p = - case TextS.splitOn "=" p of - [k,v] -> return ( unescape k - , unescape v - ) - [k] -> return ( unescape k, "" ) - _ -> Left $ "not a valid pair: " <> cs p - unescape :: TextS.Text -> TextS.Text - unescape = cs . unEscapeString . cs . TextS.intercalate "%20" . TextS.splitOn "+" - mapM parsePair xs -- $setup -- >>> import Servant.API diff --git a/servant/test/Servant/API/ContentTypesSpec.hs b/servant/test/Servant/API/ContentTypesSpec.hs index 1a155b5c..a0ae13d7 100644 --- a/servant/test/Servant/API/ContentTypesSpec.hs +++ b/servant/test/Servant/API/ContentTypesSpec.hs @@ -11,7 +11,6 @@ module Servant.API.ContentTypesSpec where import Prelude () import Prelude.Compat -import Control.Arrow import Data.Aeson import Data.ByteString.Char8 (ByteString, append, pack) import qualified Data.ByteString.Lazy as BSL @@ -25,7 +24,6 @@ import Data.String.Conversions (cs) import qualified Data.Text as TextS import qualified Data.Text.Lazy as TextL import GHC.Generics -import Network.URL (exportParams, importParams) import Test.Hspec import Test.QuickCheck import "quickcheck-instances" Test.QuickCheck.Instances () @@ -68,21 +66,6 @@ spec = describe "Servant.API.ContentTypes" $ do it "has mimeUnrender reverse mimeRender for valid top-level json " $ do property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData) - describe "The FormUrlEncoded Content-Type type" $ do - let p = Proxy :: Proxy FormUrlEncoded - - it "has mimeUnrender reverse mimeRender" $ do - property $ \x -> mempty `notElem` x - ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)]) - - it "has mimeUnrender reverse exportParams (Network.URL)" $ do - property $ \x -> mempty `notElem` x - ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)]) - - it "has importParams (Network.URL) reverse mimeRender" $ do - property $ \x -> mempty `notElem` x - ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)]) - describe "The PlainText Content-Type type" $ do let p = Proxy :: Proxy PlainText