Merge pull request #592 from haskell-servant/use-http-api-forms

Use http api forms

servant-client/servant-client.cabal

@@ -41,7 +41,7 @@ library
     , base64-bytestring     >= 1.0.0.1  && < 1.1
     , bytestring            >= 0.10     && < 0.11
     , exceptions            >= 0.8      && < 0.9
-    , http-api-data         >= 0.1      && < 0.3
+    , http-api-data         >= 0.3      && < 0.4
     , http-client           >= 0.4.18.1 && < 0.6
     , http-client-tls       >= 0.2.2    && < 0.4
     , http-media            >= 0.6.2    && < 0.7
@@ -78,6 +78,7 @@ test-suite spec
     , bytestring
     , deepseq
     , hspec == 2.*
+    , http-api-data
     , http-client
     , http-media
     , http-types

servant-client/test/Servant/ClientSpec.hs

@@ -39,7 +39,6 @@ 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
@@ -52,6 +51,7 @@ 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 +82,8 @@ data Person = Person {
 instance ToJSON Person
 instance FromJSON Person
 
-instance ToFormUrlEncoded Person where
+instance ToForm Person where
-    toFormUrlEncoded Person{..} =
+instance FromForm Person where
-        [("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)
 
 alice :: Person
 alice = Person "Alice" 42

servant-server/servant-server.cabal

@@ -52,7 +52,7 @@ library
       , base64-bytestring  >= 1.0  && < 1.1
       , bytestring         >= 0.10 && < 0.11
       , containers         >= 0.5  && < 0.6
-      , http-api-data      >= 0.1  && < 0.3
+      , http-api-data      >= 0.3  && < 0.4
       , http-types         >= 0.8  && < 0.10
       , network-uri        >= 2.6  && < 2.7
       , mtl                >= 2    && < 2.3

servant-server/src/Servant/Server/Internal.hs

@@ -42,12 +42,10 @@ import           Network.Wai                (Application, Request, Response,
                                              responseLBS, vault)
 import           Prelude                    ()
 import           Prelude.Compat
-import           Web.HttpApiData            (FromHttpApiData)
+import           Web.HttpApiData            (FromHttpApiData, parseHeaderMaybe,
-import           Web.HttpApiData.Internal   (parseHeaderMaybe,
                                              parseQueryParamMaybe,
                                              parseUrlPieceMaybe,
                                              parseUrlPieces)
-
 import           Servant.API                 ((:<|>) (..), (:>), BasicAuth, Capture,
                                               CaptureAll, Verb,
                                               ReflectMethod(reflectMethod),

servant/CHANGELOG.md

@@ -1,12 +1,13 @@
 next
 ----
 * Added Eq, Show, Read, Generic and Ord instances to IsSecure
+* BACKWARDS INCOMPATIBLE replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo`
+* BACKWARD INCOMPATIBLE: Moved `From/ToFormUrlEncoded` classes, which were renamed to `From/ToForm` to `http-api-data`
 
 0.8.1
 ----
 
 * 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
 ---

servant/servant.cabal

@@ -55,7 +55,7 @@ library
     , attoparsec            >= 0.12 && < 0.14
     , bytestring            >= 0.10 && < 0.11
     , case-insensitive      >= 1.2  && < 1.3
-    , http-api-data         >= 0.1  && < 0.3
+    , http-api-data         >= 0.3  && < 0.4
     , http-media            >= 0.4  && < 0.7
     , http-types            >= 0.8  && < 0.10
     , mtl                   >= 2.0  && < 2.3

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 (..))

servant/src/Servant/API/ContentTypes.hs

@@ -66,8 +66,6 @@ module Servant.API.ContentTypes
     , AllMime(..)
     , AllMimeRender(..)
     , AllMimeUnrender(..)
-    , FromFormUrlEncoded(..)
-    , ToFormUrlEncoded(..)
     , eitherDecodeLenient
     , canHandleAcceptH
     ) where
@@ -82,10 +80,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 +90,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,
+import           Web.FormUrlEncoded               (FromForm, ToForm,
-                                                   isUnreserved, unEscapeString)
+                                                   urlEncodeAsForm,
+                                                   urlDecodeAsForm)
 import           Prelude                          ()
 import           Prelude.Compat
 
@@ -290,12 +287,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
+         ToForm a => MimeRender FormUrlEncoded a where
-    mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded
+    mimeRender _ = urlEncodeAsForm
 
 -- | `TextL.encodeUtf8`
 instance MimeRender PlainText TextL.Text where
@@ -348,11 +345,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
+instance FromForm a => MimeUnrender FormUrlEncoded a where
-    mimeUnrender _ = decodeFormUrlEncoded >=> fromFormUrlEncoded
+    mimeUnrender _ = left TextS.unpack . urlDecodeAsForm
 
 -- | @left show . TextL.decodeUtf8'@
 instance MimeUnrender PlainText TextL.Text where
@@ -375,49 +372,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

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
 

stack-ghc-7.8.4.yaml

@@ -15,9 +15,10 @@ extra-deps:
 - hspec-core-2.2.3
 - hspec-discover-2.2.3
 - hspec-expectations-0.7.2
-- http-api-data-0.2.2
+- http-api-data-0.3
 - primitive-0.6.1.0
 - should-not-typecheck-2.1.0
 - time-locale-compat-0.1.1.1
+- uri-bytestring-0.2.2.0
 - wai-app-static-3.1.5
 resolver: lts-2.22

stack-ghc-8.0.1.yaml

@@ -6,5 +6,7 @@ packages:
 - servant-foreign/
 - servant-js/
 - servant-server/
-extra-deps: []
+extra-deps:
+- http-api-data-0.3
+- uri-bytestring-0.2.2.0
 flags: {}

stack.yaml

@@ -8,4 +8,5 @@ packages:
 - servant-server/
 - doc/tutorial
 extra-deps:
+- http-api-data-0.3
 resolver: lts-6.0