Remove FromFormUrlEncoded and ToFormUrlEncoded.
In favor of FromForm and ToForm from the new version of http-api-data.
This commit is contained in:
parent
f44b336bf1
commit
0870b3b2f5
6 changed files with 24 additions and 94 deletions
|
@ -78,6 +78,7 @@ test-suite spec
|
||||||
, bytestring
|
, bytestring
|
||||||
, deepseq
|
, deepseq
|
||||||
, hspec == 2.*
|
, hspec == 2.*
|
||||||
|
, http-api-data
|
||||||
, http-client
|
, http-client
|
||||||
, http-media
|
, http-media
|
||||||
, http-types
|
, http-types
|
||||||
|
|
|
@ -30,7 +30,7 @@ module Servant.ClientSpec where
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
#endif
|
#endif
|
||||||
import Control.Arrow (left)
|
import Control.Arrow (left)
|
||||||
import Control.Concurrent (forkIO, killThread, ThreadId)
|
import Control.Concurrent (ThreadId, forkIO, killThread)
|
||||||
import Control.Exception (bracket)
|
import Control.Exception (bracket)
|
||||||
import Control.Monad.Trans.Except (throwE )
|
import Control.Monad.Trans.Except (throwE )
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
|
@ -39,19 +39,20 @@ import Data.Char (chr, isPrint)
|
||||||
import Data.Foldable (forM_)
|
import Data.Foldable (forM_)
|
||||||
import Data.Monoid hiding (getLast)
|
import Data.Monoid hiding (getLast)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import qualified Data.Text as T
|
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import qualified Network.HTTP.Client as C
|
import qualified Network.HTTP.Client as C
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
import qualified Network.HTTP.Types as HTTP
|
import qualified Network.HTTP.Types as HTTP
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Network.Wai (Request, requestHeaders, responseLBS)
|
import Network.Wai (Request, requestHeaders,
|
||||||
|
responseLBS)
|
||||||
import Network.Wai.Handler.Warp
|
import Network.Wai.Handler.Warp
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Test.Hspec.QuickCheck
|
import Test.Hspec.QuickCheck
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
|
import Web.FormUrlEncoded (FromForm, ToForm)
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.API.Internal.Test.ComprehensiveAPI
|
||||||
|
@ -82,19 +83,8 @@ data Person = Person {
|
||||||
instance ToJSON Person
|
instance ToJSON Person
|
||||||
instance FromJSON 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 = Person "Alice" 42
|
alice = Person "Alice" 42
|
||||||
|
|
|
@ -1,12 +1,13 @@
|
||||||
next
|
next
|
||||||
----
|
----
|
||||||
* Added Eq, Show, Read, Generic and Ord instances to IsSecure
|
* 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
|
0.8.1
|
||||||
----
|
----
|
||||||
|
|
||||||
* Add `CaptureAll` combinator. Captures all of the remaining segments in a URL.
|
* 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
|
0.8
|
||||||
---
|
---
|
||||||
|
|
|
@ -62,10 +62,10 @@ import Servant.API.Alternative ((:<|>) (..))
|
||||||
import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
|
import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
|
||||||
import Servant.API.Capture (Capture, CaptureAll)
|
import Servant.API.Capture (Capture, CaptureAll)
|
||||||
import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
|
import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
|
||||||
FromFormUrlEncoded (..), JSON,
|
JSON,
|
||||||
MimeRender (..), NoContent (NoContent),
|
MimeRender (..), NoContent (NoContent),
|
||||||
MimeUnrender (..), OctetStream,
|
MimeUnrender (..), OctetStream,
|
||||||
PlainText, ToFormUrlEncoded (..))
|
PlainText)
|
||||||
import Servant.API.Experimental.Auth (AuthProtect)
|
import Servant.API.Experimental.Auth (AuthProtect)
|
||||||
import Servant.API.Header (Header (..))
|
import Servant.API.Header (Header (..))
|
||||||
import Servant.API.HttpVersion (HttpVersion (..))
|
import Servant.API.HttpVersion (HttpVersion (..))
|
||||||
|
|
|
@ -66,15 +66,14 @@ module Servant.API.ContentTypes
|
||||||
, AllMime(..)
|
, AllMime(..)
|
||||||
, AllMimeRender(..)
|
, AllMimeRender(..)
|
||||||
, AllMimeUnrender(..)
|
, AllMimeUnrender(..)
|
||||||
, FromFormUrlEncoded(..)
|
|
||||||
, ToFormUrlEncoded(..)
|
|
||||||
, eitherDecodeLenient
|
, eitherDecodeLenient
|
||||||
, canHandleAcceptH
|
, canHandleAcceptH
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Arrow (left)
|
import Control.Arrow (left)
|
||||||
import Control.Monad.Compat
|
import Control.Monad.Compat
|
||||||
import Data.Aeson (FromJSON(..), ToJSON(..), encode)
|
import Data.Aeson (FromJSON (..), ToJSON (..),
|
||||||
|
encode)
|
||||||
import Data.Aeson.Parser (value)
|
import Data.Aeson.Parser (value)
|
||||||
import Data.Aeson.Types (parseEither)
|
import Data.Aeson.Types (parseEither)
|
||||||
import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,
|
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 qualified Data.ByteString as BS
|
||||||
import Data.ByteString.Lazy (ByteString, fromStrict,
|
import Data.ByteString.Lazy (ByteString, fromStrict,
|
||||||
toStrict)
|
toStrict)
|
||||||
import qualified Data.ByteString.Lazy as B
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BC
|
import qualified Data.ByteString.Lazy.Char8 as BC
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import Data.Monoid.Compat
|
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
import qualified Data.Text as TextS
|
import qualified Data.Text as TextS
|
||||||
import qualified Data.Text.Encoding 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 Data.Typeable
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import qualified Network.HTTP.Media as M
|
import qualified Network.HTTP.Media as M
|
||||||
import Network.URI (escapeURIString,
|
import Web.FormUrlEncoded (FromForm, ToForm,
|
||||||
isUnreserved, unEscapeString)
|
urlEncodeAsForm,
|
||||||
|
urlDecodeAsForm)
|
||||||
import Prelude ()
|
import Prelude ()
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
||||||
|
@ -290,12 +288,12 @@ instance OVERLAPPABLE_
|
||||||
ToJSON a => MimeRender JSON a where
|
ToJSON a => MimeRender JSON a where
|
||||||
mimeRender _ = encode
|
mimeRender _ = encode
|
||||||
|
|
||||||
-- | @encodeFormUrlEncoded . toFormUrlEncoded@
|
-- | @urlEncodeAsForm"
|
||||||
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
|
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
|
||||||
-- holds if every element of x is non-null (i.e., not @("", "")@)
|
-- holds if every element of x is non-null (i.e., not @("", "")@)
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
ToFormUrlEncoded a => MimeRender FormUrlEncoded a where
|
ToForm a => MimeRender FormUrlEncoded a where
|
||||||
mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded
|
mimeRender _ = urlEncodeAsForm
|
||||||
|
|
||||||
-- | `TextL.encodeUtf8`
|
-- | `TextL.encodeUtf8`
|
||||||
instance MimeRender PlainText TextL.Text where
|
instance MimeRender PlainText TextL.Text where
|
||||||
|
@ -348,11 +346,11 @@ eitherDecodeLenient input =
|
||||||
instance FromJSON a => MimeUnrender JSON a where
|
instance FromJSON a => MimeUnrender JSON a where
|
||||||
mimeUnrender _ = eitherDecodeLenient
|
mimeUnrender _ = eitherDecodeLenient
|
||||||
|
|
||||||
-- | @decodeFormUrlEncoded >=> fromFormUrlEncoded@
|
-- | @urlDecodeAsForm@
|
||||||
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
|
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
|
||||||
-- holds if every element of x is non-null (i.e., not @("", "")@)
|
-- 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'@
|
-- | @left show . TextL.decodeUtf8'@
|
||||||
instance MimeUnrender PlainText TextL.Text where
|
instance MimeUnrender PlainText TextL.Text where
|
||||||
|
@ -375,49 +373,6 @@ instance MimeUnrender OctetStream BS.ByteString where
|
||||||
mimeUnrender _ = Right . toStrict
|
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
|
-- $setup
|
||||||
-- >>> import Servant.API
|
-- >>> import Servant.API
|
||||||
|
|
|
@ -11,7 +11,6 @@ module Servant.API.ContentTypesSpec where
|
||||||
import Prelude ()
|
import Prelude ()
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
||||||
import Control.Arrow
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.ByteString.Char8 (ByteString, append, pack)
|
import Data.ByteString.Char8 (ByteString, append, pack)
|
||||||
import qualified Data.ByteString.Lazy as BSL
|
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 as TextS
|
||||||
import qualified Data.Text.Lazy as TextL
|
import qualified Data.Text.Lazy as TextL
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Network.URL (exportParams, importParams)
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import "quickcheck-instances" Test.QuickCheck.Instances ()
|
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
|
it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
|
||||||
property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
|
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
|
describe "The PlainText Content-Type type" $ do
|
||||||
let p = Proxy :: Proxy PlainText
|
let p = Proxy :: Proxy PlainText
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue