465e006 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Merge pull request #13 from anchor/form-urlencoded

465e006Julian Arni12 years ago

servant.cabal+1

compare with master

unifiedsplit

@@ -94,3 +94,4 @@ test-suite spec

94 , servant

95 , string-conversions

96 , text

97+ , url

src/Servant/API/ContentTypes.hs+64−1

@@ -12,11 +12,14 @@

12module Servant.API.ContentTypes where

14import Control.Arrow (left)

15+import Control.Monad

15import Data.Aeson (FromJSON, ToJSON, eitherDecode,

16import Data.Aeson (FromJSON, ToJSON, eitherDecode,

16 encode)

17 encode)

17import qualified Data.ByteString as BS

18import qualified Data.ByteString as BS

18import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)

19import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)

20+import qualified Data.ByteString.Lazy as B

19import Data.String.Conversions (cs)

21import Data.String.Conversions (cs)

22+import Data.Monoid

20import qualified Data.Text.Lazy as TextL

23import qualified Data.Text.Lazy as TextL

21import qualified Data.Text.Lazy.Encoding as TextL

24import qualified Data.Text.Lazy.Encoding as TextL

22import qualified Data.Text as TextS

25import qualified Data.Text as TextS

@@ -24,10 +27,13 @@ import qualified Data.Text.Encoding as TextS

24import Data.Typeable

27import Data.Typeable

25import GHC.Exts (Constraint)

28import GHC.Exts (Constraint)

26import qualified Network.HTTP.Media as M

29import qualified Network.HTTP.Media as M

30+import Network.URI (unEscapeString, escapeURIString,

31+ isUnreserved)

28-- * Provided content types

33-- * Provided content types

29data JSON deriving Typeable

34data JSON deriving Typeable

30data PlainText deriving Typeable

35data PlainText deriving Typeable

36+data FormUrlEncoded deriving Typeable

31data OctetStream deriving Typeable

37data OctetStream deriving Typeable

33-- * Accept class

39-- * Accept class

@@ -48,6 +54,10 @@ class Accept ctype where

48instance Accept JSON where

54instance Accept JSON where

49 contentType _ = "application" M.// "json"

55 contentType _ = "application" M.// "json"

57+-- | @application/x-www-form-urlencoded@

58+instance Accept FormUrlEncoded where

59+ contentType _ = "application" M.// "x-www-form-urlencoded"

60+

51-- | @text/plain;charset=utf-8@

61-- | @text/plain;charset=utf-8@

52instance Accept PlainText where

62instance Accept PlainText where

53 contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")

63 contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")

@@ -179,6 +189,10 @@ type family IsNonEmpty (ls::[*]) :: Constraint where

179instance ToJSON a => MimeRender JSON a where

189instance ToJSON a => MimeRender JSON a where

180 toByteString _ = encode

190 toByteString _ = encode

181

191

192+-- | `encodeFormUrlEncoded . toFormUrlEncoded`

193+instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where

194+ toByteString _ = encodeFormUrlEncoded . toFormUrlEncoded

195+

182-- | `TextL.encodeUtf8`

196-- | `TextL.encodeUtf8`

183instance MimeRender PlainText TextL.Text where

197instance MimeRender PlainText TextL.Text where

184 toByteString _ = TextL.encodeUtf8

198 toByteString _ = TextL.encodeUtf8

@@ -191,7 +205,7 @@ instance MimeRender PlainText TextS.Text where

191instance MimeRender OctetStream ByteString where

205instance MimeRender OctetStream ByteString where

192 toByteString _ = id

206 toByteString _ = id

193

207

194−-- | `toStrict`

208+-- | `fromStrict`

195instance MimeRender OctetStream BS.ByteString where

209instance MimeRender OctetStream BS.ByteString where

196 toByteString _ = fromStrict

210 toByteString _ = fromStrict

197

211

@@ -203,6 +217,10 @@ instance MimeRender OctetStream BS.ByteString where

203instance FromJSON a => MimeUnrender JSON a where

217instance FromJSON a => MimeUnrender JSON a where

204 fromByteString _ = eitherDecode

218 fromByteString _ = eitherDecode

205

219

220+-- | `decodeFormUrlEncoded >=> fromFormUrlEncoded`

221+instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where

222+ fromByteString _ = decodeFormUrlEncoded >=> fromFormUrlEncoded

223+

206-- | `left show . TextL.decodeUtf8'`

224-- | `left show . TextL.decodeUtf8'`

207instance MimeUnrender PlainText TextL.Text where

225instance MimeUnrender PlainText TextL.Text where

208 fromByteString _ = left show . TextL.decodeUtf8'

226 fromByteString _ = left show . TextL.decodeUtf8'

@@ -218,3 +236,48 @@ instance MimeUnrender OctetStream ByteString where

218-- | `Right . toStrict`

236-- | `Right . toStrict`

219instance MimeUnrender OctetStream BS.ByteString where

237instance MimeUnrender OctetStream BS.ByteString where

220 fromByteString _ = Right . toStrict

238 fromByteString _ = Right . toStrict

239+

240+

241+--------------------------------------------------------------------------

242+-- * FormUrlEncoded

243+

244+-- | A type that can be converted to @application/x-www-form-urlencoded@

245+class ToFormUrlEncoded a where

246+ toFormUrlEncoded :: a -> [(TextS.Text, TextS.Text)]

247+

248+instance ToFormUrlEncoded [(TextS.Text, TextS.Text)] where

249+ toFormUrlEncoded = id

250+

251+-- | A type that can be converted from @application/x-www-form-urlencoded@,

252+-- with the possibility of failure.

253+class FromFormUrlEncoded a where

254+ fromFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> Either String a

255+

256+instance FromFormUrlEncoded [(TextS.Text, TextS.Text)] where

257+ fromFormUrlEncoded = return

258+

259+encodeFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> ByteString

260+encodeFormUrlEncoded xs =

261+ let escape :: TextS.Text -> ByteString

262+ escape = cs . escapeURIString isUnreserved . cs

263+ encodePair :: (TextS.Text, TextS.Text) -> ByteString

264+ encodePair (k, "") = escape k

265+ encodePair (k, v) = escape k <> "=" <> escape v

266+ in B.intercalate "&" $ map encodePair xs

267+

268+decodeFormUrlEncoded :: ByteString -> Either String [(TextS.Text, TextS.Text)]

269+decodeFormUrlEncoded "" = return []

270+decodeFormUrlEncoded q = do

271+ let xs :: [TextS.Text]

272+ xs = TextS.splitOn "&" . cs $ q

273+ parsePair :: TextS.Text -> Either String (TextS.Text, TextS.Text)

274+ parsePair p =

275+ case TextS.splitOn "=" p of

276+ [k,v] -> return ( unescape k

277+ , unescape v

278+ )

279+ [k] -> return ( unescape k, "" )

280+ _ -> Left $ "not a valid pair: " <> cs p

281+ unescape :: TextS.Text -> TextS.Text

282+ unescape = cs . unEscapeString . cs . TextS.intercalate "%20" . TextS.splitOn "+"

283+ mapM parsePair xs

test/Servant/API/ContentTypesSpec.hs+17−1

@@ -6,11 +6,12 @@

6module Servant.API.ContentTypesSpec where

8import Control.Applicative

9+import Control.Arrow

9import Data.Aeson

10import Data.Aeson

10import Data.Function (on)

11import Data.Function (on)

11import Data.Proxy

12import Data.Proxy

13−import Data.ByteString.Char8

14+import Data.ByteString.Char8 (ByteString, append, pack)

14import qualified Data.ByteString.Lazy as BSL

15import qualified Data.ByteString.Lazy as BSL

15import Data.List (maximumBy)

16import Data.List (maximumBy)

16import Data.Maybe (fromJust, isJust, isNothing)

17import Data.Maybe (fromJust, isJust, isNothing)

@@ -19,6 +20,7 @@ import Data.String.Conversions (cs)

19import qualified Data.Text as TextS

20import qualified Data.Text as TextS

20import qualified Data.Text.Lazy as TextL

21import qualified Data.Text.Lazy as TextL

21import GHC.Generics

22import GHC.Generics

23+import Network.URL (importParams, exportParams)

22import Test.Hspec

24import Test.Hspec

23import Test.QuickCheck

25import Test.QuickCheck

24import Test.QuickCheck.Instances ()

26import Test.QuickCheck.Instances ()

@@ -38,6 +40,20 @@ spec = describe "Servant.API.ContentTypes" $ do

38 let p = Proxy :: Proxy JSON

40 let p = Proxy :: Proxy JSON

39 property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData)

41 property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData)

43+ describe "The FormUrlEncoded Content-Type type" $ do

44+

45+ it "has fromByteString reverse toByteString" $ do

46+ let p = Proxy :: Proxy FormUrlEncoded

47+ property $ \x -> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)])

48+

49+ it "has fromByteString reverse exportParams (Network.URL)" $ do

50+ let p = Proxy :: Proxy FormUrlEncoded

51+ property $ \x -> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])

52+

53+ it "has importParams (Network.URL) reverse toByteString" $ do

54+ let p = Proxy :: Proxy FormUrlEncoded

55+ property $ \x -> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)])

56+

41 describe "The PlainText Content-Type type" $ do

57 describe "The PlainText Content-Type type" $ do

43 it "has fromByteString reverse toByteString (lazy Text)" $ do

59 it "has fromByteString reverse toByteString (lazy Text)" $ do