git.iko.soy/typeable/servant
on master help sign in
Merge pull request #592 from haskell-servant/use-http-api-forms

Use http api forms

commita274d8a1244b274117a8de7cb960e961aaa8344c authorJulian Arni <jkarni@gmail.com> dateTue 13 Sep 2016, 10:30 (10 years ago) parent7f208c7501212e
12 files changed+27−97
compare with master
unifiedsplit
servant-client/servant-client.cabal+2−1 servant-client/test/Servant/ClientSpec.hs+3−14 servant-server/servant-server.cabal+1−1 servant-server/src/Servant/Server/Internal.hs+1−3 servant/CHANGELOG.md+2−1 servant/servant.cabal+1−1 servant/src/Servant/API.hs+2−2 servant/src/Servant/API/ContentTypes.hs+9−55 servant/test/Servant/API/ContentTypesSpec.hs−17 stack-ghc-7.8.4.yaml+2−1 stack-ghc-8.0.1.yaml+3−1 stack.yaml+1
servant-client/servant-client.cabal+2−1
@@ -41,7 +41,7 @@ library
4141 , base64-bytestring >= 1.0.0.1 && < 1.1
4242 , bytestring >= 0.10 && < 0.11
4343 , exceptions >= 0.8 && < 0.9
44− , http-api-data >= 0.1 && < 0.3
44+ , http-api-data >= 0.3 && < 0.4
4545 , http-client >= 0.4.18.1 && < 0.6
4646 , http-client-tls >= 0.2.2 && < 0.4
4747 , http-media >= 0.6.2 && < 0.7
@@ -78,6 +78,7 @@ test-suite spec
7878 , bytestring
7979 , deepseq
8080 , hspec == 2.*
81+ , http-api-data
8182 , http-client
8283 , http-media
8384 , http-types
servant-client/test/Servant/ClientSpec.hs+3−14
@@ -39,7 +39,6 @@ import Data.Char (chr, isPrint)
3939import Data.Foldable (forM_)
4040import Data.Monoid hiding (getLast)
4141import Data.Proxy
42−import qualified Data.Text as T
4342import GHC.Generics (Generic)
4443import qualified Network.HTTP.Client as C
4544import Network.HTTP.Media
@@ -52,6 +51,7 @@ import Test.Hspec
5251import Test.Hspec.QuickCheck
5352import Test.HUnit
5453import Test.QuickCheck
54+import Web.FormUrlEncoded (FromForm, ToForm)
5555
5656import Servant.API
5757import Servant.API.Internal.Test.ComprehensiveAPI
@@ -82,19 +82,8 @@ data Person = Person {
8282instance ToJSON Person
8383instance FromJSON Person
8484
85−instance ToFormUrlEncoded Person where
86− toFormUrlEncoded Person{..} =
87− [("name", T.pack name), ("age", T.pack (show age))]
88−
89−lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b
90−lookupEither x xs = do
91− maybe (Left $ "could not find key " <> show x) return $ lookup x xs
92−
93−instance FromFormUrlEncoded Person where
94− fromFormUrlEncoded xs = do
95− n <- lookupEither "name" xs
96− a <- lookupEither "age" xs
97− return $ Person (T.unpack n) (read $ T.unpack a)
85+instance ToForm Person where
86+instance FromForm Person where
9887
9988alice :: Person
10089alice = Person "Alice" 42
servant-server/servant-server.cabal+1−1
@@ -52,7 +52,7 @@ library
5252 , base64-bytestring >= 1.0 && < 1.1
5353 , bytestring >= 0.10 && < 0.11
5454 , containers >= 0.5 && < 0.6
55− , http-api-data >= 0.1 && < 0.3
55+ , http-api-data >= 0.3 && < 0.4
5656 , http-types >= 0.8 && < 0.10
5757 , network-uri >= 2.6 && < 2.7
5858 , mtl >= 2 && < 2.3
servant-server/src/Servant/Server/Internal.hs+1−3
@@ -42,12 +42,10 @@ import Network.Wai (Application, Request, Response,
4242 responseLBS, vault)
4343import Prelude ()
4444import Prelude.Compat
45−import Web.HttpApiData (FromHttpApiData)
46−import Web.HttpApiData.Internal (parseHeaderMaybe,
45+import Web.HttpApiData (FromHttpApiData, parseHeaderMaybe,
4746 parseQueryParamMaybe,
4847 parseUrlPieceMaybe,
4948 parseUrlPieces)
50−
5149import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,
5250 CaptureAll, Verb,
5351 ReflectMethod(reflectMethod),
servant/CHANGELOG.md+2−1
@@ -1,12 +1,13 @@
11next
22----
33* Added Eq, Show, Read, Generic and Ord instances to IsSecure
4+* BACKWARDS INCOMPATIBLE replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo`
5+* BACKWARD INCOMPATIBLE: Moved `From/ToFormUrlEncoded` classes, which were renamed to `From/ToForm` to `http-api-data`
46
570.8.1
68----
79
810* Add `CaptureAll` combinator. Captures all of the remaining segments in a URL.
9−* BACKWARDS INCOMPATIBLE replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo`
1011
11120.8
1213---
servant/servant.cabal+1−1
@@ -55,7 +55,7 @@ library
5555 , attoparsec >= 0.12 && < 0.14
5656 , bytestring >= 0.10 && < 0.11
5757 , case-insensitive >= 1.2 && < 1.3
58− , http-api-data >= 0.1 && < 0.3
58+ , http-api-data >= 0.3 && < 0.4
5959 , http-media >= 0.4 && < 0.7
6060 , http-types >= 0.8 && < 0.10
6161 , mtl >= 2.0 && < 2.3
servant/src/Servant/API.hs+2−2
@@ -62,10 +62,10 @@ import Servant.API.Alternative ((:<|>) (..))
6262import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
6363import Servant.API.Capture (Capture, CaptureAll)
6464import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
65− FromFormUrlEncoded (..), JSON,
65+ JSON,
6666 MimeRender (..), NoContent (NoContent),
6767 MimeUnrender (..), OctetStream,
68− PlainText, ToFormUrlEncoded (..))
68+ PlainText)
6969import Servant.API.Experimental.Auth (AuthProtect)
7070import Servant.API.Header (Header (..))
7171import Servant.API.HttpVersion (HttpVersion (..))
servant/src/Servant/API/ContentTypes.hs+9−55
@@ -66,8 +66,6 @@ module Servant.API.ContentTypes
6666 , AllMime(..)
6767 , AllMimeRender(..)
6868 , AllMimeUnrender(..)
69− , FromFormUrlEncoded(..)
70− , ToFormUrlEncoded(..)
7169 , eitherDecodeLenient
7270 , canHandleAcceptH
7371 ) where
@@ -82,10 +80,8 @@ import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
8280import qualified Data.ByteString as BS
8381import Data.ByteString.Lazy (ByteString, fromStrict,
8482 toStrict)
85−import qualified Data.ByteString.Lazy as B
8683import qualified Data.ByteString.Lazy.Char8 as BC
8784import Data.Maybe (isJust)
88−import Data.Monoid.Compat
8985import Data.String.Conversions (cs)
9086import qualified Data.Text as TextS
9187import qualified Data.Text.Encoding as TextS
@@ -94,8 +90,9 @@ import qualified Data.Text.Lazy.Encoding as TextL
9490import Data.Typeable
9591import GHC.Generics (Generic)
9692import qualified Network.HTTP.Media as M
97−import Network.URI (escapeURIString,
98− isUnreserved, unEscapeString)
93+import Web.FormUrlEncoded (FromForm, ToForm,
94+ urlEncodeAsForm,
95+ urlDecodeAsForm)
9996import Prelude ()
10097import Prelude.Compat
10198
@@ -290,12 +287,12 @@ instance OVERLAPPABLE_
290287 ToJSON a => MimeRender JSON a where
291288 mimeRender _ = encode
292289
293−-- | @encodeFormUrlEncoded . toFormUrlEncoded@
290+-- | @urlEncodeAsForm@
294291-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
295292-- holds if every element of x is non-null (i.e., not @("", "")@)
296293instance OVERLAPPABLE_
297− ToFormUrlEncoded a => MimeRender FormUrlEncoded a where
298− mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded
294+ ToForm a => MimeRender FormUrlEncoded a where
295+ mimeRender _ = urlEncodeAsForm
299296
300297-- | `TextL.encodeUtf8`
301298instance MimeRender PlainText TextL.Text where
@@ -348,11 +345,11 @@ eitherDecodeLenient input =
348345instance FromJSON a => MimeUnrender JSON a where
349346 mimeUnrender _ = eitherDecodeLenient
350347
351−-- | @decodeFormUrlEncoded >=> fromFormUrlEncoded@
348+-- | @urlDecodeAsForm@
352349-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
353350-- holds if every element of x is non-null (i.e., not @("", "")@)
354−instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where
355− mimeUnrender _ = decodeFormUrlEncoded >=> fromFormUrlEncoded
351+instance FromForm a => MimeUnrender FormUrlEncoded a where
352+ mimeUnrender _ = left TextS.unpack . urlDecodeAsForm
356353
357354-- | @left show . TextL.decodeUtf8'@
358355instance MimeUnrender PlainText TextL.Text where
@@ -375,49 +372,6 @@ instance MimeUnrender OctetStream BS.ByteString where
375372 mimeUnrender _ = Right . toStrict
376373
377374
378−--------------------------------------------------------------------------
379−-- * FormUrlEncoded
380−
381−-- | A type that can be converted to @application/x-www-form-urlencoded@
382−class ToFormUrlEncoded a where
383− toFormUrlEncoded :: a -> [(TextS.Text, TextS.Text)]
384−
385−instance ToFormUrlEncoded [(TextS.Text, TextS.Text)] where
386− toFormUrlEncoded = id
387−
388−-- | A type that can be converted from @application/x-www-form-urlencoded@,
389−-- with the possibility of failure.
390−class FromFormUrlEncoded a where
391− fromFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> Either String a
392−
393−instance FromFormUrlEncoded [(TextS.Text, TextS.Text)] where
394− fromFormUrlEncoded = return
395−
396−encodeFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> ByteString
397−encodeFormUrlEncoded xs =
398− let escape :: TextS.Text -> ByteString
399− escape = cs . escapeURIString isUnreserved . cs
400− encodePair :: (TextS.Text, TextS.Text) -> ByteString
401− encodePair (k, "") = escape k
402− encodePair (k, v) = escape k <> "=" <> escape v
403− in B.intercalate "&" $ map encodePair xs
404−
405−decodeFormUrlEncoded :: ByteString -> Either String [(TextS.Text, TextS.Text)]
406−decodeFormUrlEncoded "" = return []
407−decodeFormUrlEncoded q = do
408− let xs :: [TextS.Text]
409− xs = TextS.splitOn "&" . cs $ q
410− parsePair :: TextS.Text -> Either String (TextS.Text, TextS.Text)
411− parsePair p =
412− case TextS.splitOn "=" p of
413− [k,v] -> return ( unescape k
414− , unescape v
415− )
416− [k] -> return ( unescape k, "" )
417− _ -> Left $ "not a valid pair: " <> cs p
418− unescape :: TextS.Text -> TextS.Text
419− unescape = cs . unEscapeString . cs . TextS.intercalate "%20" . TextS.splitOn "+"
420− mapM parsePair xs
421375
422376-- $setup
423377-- >>> import Servant.API
servant/test/Servant/API/ContentTypesSpec.hs−17
@@ -11,7 +11,6 @@ module Servant.API.ContentTypesSpec where
1111import Prelude ()
1212import Prelude.Compat
1313
14−import Control.Arrow
1514import Data.Aeson
1615import Data.ByteString.Char8 (ByteString, append, pack)
1716import qualified Data.ByteString.Lazy as BSL
@@ -25,7 +24,6 @@ import Data.String.Conversions (cs)
2524import qualified Data.Text as TextS
2625import qualified Data.Text.Lazy as TextL
2726import GHC.Generics
28−import Network.URL (exportParams, importParams)
2927import Test.Hspec
3028import Test.QuickCheck
3129import "quickcheck-instances" Test.QuickCheck.Instances ()
@@ -68,21 +66,6 @@ spec = describe "Servant.API.ContentTypes" $ do
6866 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
6967 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
7068
71− describe "The FormUrlEncoded Content-Type type" $ do
72− let p = Proxy :: Proxy FormUrlEncoded
73−
74− it "has mimeUnrender reverse mimeRender" $ do
75− property $ \x -> mempty `notElem` x
76− ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
77−
78− it "has mimeUnrender reverse exportParams (Network.URL)" $ do
79− property $ \x -> mempty `notElem` x
80− ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
81−
82− it "has importParams (Network.URL) reverse mimeRender" $ do
83− property $ \x -> mempty `notElem` x
84− ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
85−
8669 describe "The PlainText Content-Type type" $ do
8770 let p = Proxy :: Proxy PlainText
8871
stack-ghc-7.8.4.yaml+2−1
@@ -15,9 +15,10 @@ extra-deps:
1515- hspec-core-2.2.3
1616- hspec-discover-2.2.3
1717- hspec-expectations-0.7.2
18−- http-api-data-0.2.2
18+- http-api-data-0.3
1919- primitive-0.6.1.0
2020- should-not-typecheck-2.1.0
2121- time-locale-compat-0.1.1.1
22+- uri-bytestring-0.2.2.0
2223- wai-app-static-3.1.5
2324resolver: lts-2.22
stack-ghc-8.0.1.yaml+3−1
@@ -6,5 +6,7 @@ packages:
66- servant-foreign/
77- servant-js/
88- servant-server/
9−extra-deps: []
9+extra-deps:
10+- http-api-data-0.3
11+- uri-bytestring-0.2.2.0
1012flags: {}
stack.yaml+1
@@ -8,4 +8,5 @@ packages:
88- servant-server/
99- doc/tutorial
1010extra-deps:
11+- http-api-data-0.3
1112resolver: lts-6.0