eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

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

Browse source 
Use http api forms
This commit is contained in:
Julian Arni 2016-09-13 10:30:34 -03:00 committed by GitHub
commit a274d8a124
12 changed files with 27 additions and 97 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
servant-client/servant-client.cabal
View file

@ -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

17
servant-client/test/Servant/ClientSpec.hs
View file

@ -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
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

2
servant-server/servant-server.cabal
View file

@ -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

4
servant-server/src/Servant/Server/Internal.hs
View file

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

3
servant/CHANGELOG.md
View file

@ -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
---

2
servant/servant.cabal
View file

@ -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

4
servant/src/Servant/API.hs
View file

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

64
servant/src/Servant/API/ContentTypes.hs
View file

@ -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,
isUnreserved, unEscapeString)
import Web.FormUrlEncoded (FromForm, ToForm,
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
mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded
ToForm a => MimeRender FormUrlEncoded a where
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
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 +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

17
servant/test/Servant/API/ContentTypesSpec.hs
View file

@ -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

3
stack-ghc-7.8.4.yaml
View file

@ -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

4
stack-ghc-8.0.1.yaml
View file

@ -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: {}

1
stack.yaml
View file

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