diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +0.9 +--- + +* Added Eq, Show, Read, Generic and Ord instances to IsSecure +* BACKWARDS INCOMPATIBLE: replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo` +* BACKWARDS INCOMPATIBLE: Moved `From/ToFormUrlEncoded` classes, which were renamed to `From/ToForm` to `http-api-data` + 0.8.1 ---- diff --git a/servant.cabal b/servant.cabal --- a/servant.cabal +++ b/servant.cabal @@ -1,5 +1,5 @@ name: servant -version: 0.8.1 +version: 0.9 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them @@ -54,9 +54,8 @@ , aeson >= 0.7 && < 1.1 , attoparsec >= 0.12 && < 0.14 , bytestring >= 0.10 && < 0.11 - , bytestring-conversion >= 0.3 && < 0.4 , 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 diff --git a/src/Servant/API.hs b/src/Servant/API.hs --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -62,10 +62,10 @@ 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 (..)) diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs --- a/src/Servant/API/ContentTypes.hs +++ b/src/Servant/API/ContentTypes.hs @@ -66,8 +66,6 @@ , AllMime(..) , AllMimeRender(..) , AllMimeUnrender(..) - , FromFormUrlEncoded(..) - , ToFormUrlEncoded(..) , eitherDecodeLenient , canHandleAcceptH ) where @@ -82,10 +80,8 @@ 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 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 @@ 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 @@ 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 @@ 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 diff --git a/src/Servant/API/IsSecure.hs b/src/Servant/API/IsSecure.hs --- a/src/Servant/API/IsSecure.hs +++ b/src/Servant/API/IsSecure.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Servant.API.IsSecure ( -- $issecure IsSecure(..) ) where import Data.Typeable +import GHC.Generics (Generic) -- | Was this request made over an SSL connection? -- @@ -19,7 +21,7 @@ -- is secure (HTTPS) | NotSecure -- ^ the connection to the server -- is not secure (HTTP) - deriving Typeable + deriving (Eq, Show, Read, Generic, Ord, Typeable) -- $issecure -- diff --git a/src/Servant/API/ResponseHeaders.hs b/src/Servant/API/ResponseHeaders.hs --- a/src/Servant/API/ResponseHeaders.hs +++ b/src/Servant/API/ResponseHeaders.hs @@ -31,8 +31,8 @@ ) where import Data.ByteString.Char8 as BS (pack, unlines, init) -import Data.ByteString.Conversion (ToByteString, toByteString', - FromByteString, fromByteString) +import Web.HttpApiData (ToHttpApiData, toHeader, + FromHttpApiData, parseHeader) import qualified Data.CaseInsensitive as CI import Data.Proxy import GHC.TypeLits (KnownSymbol, symbolVal) @@ -68,17 +68,17 @@ instance OVERLAPPING_ BuildHeadersTo '[] where buildHeadersTo _ = HNil -instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h ) +instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h ) => BuildHeadersTo ((Header h v) ': xs) where buildHeadersTo headers = let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h) matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers in case matching of [] -> MissingHeader `HCons` buildHeadersTo headers - xs -> case fromByteString (BS.init $ BS.unlines xs) of - Nothing -> UndecodableHeader (BS.init $ BS.unlines xs) + xs -> case parseHeader (BS.init $ BS.unlines xs) of + Left _err -> UndecodableHeader (BS.init $ BS.unlines xs) `HCons` buildHeadersTo headers - Just h -> Header h `HCons` buildHeadersTo headers + Right h -> Header h `HCons` buildHeadersTo headers -- * Getting @@ -88,18 +88,18 @@ instance OVERLAPPING_ GetHeaders (HList '[]) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) ) +instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) ) => GetHeaders (HList (Header h x ': xs)) where getHeaders hdrs = case hdrs of - Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest - UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest + Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest + UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest MissingHeader `HCons` rest -> getHeaders rest where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h) instance OVERLAPPING_ GetHeaders (Headers '[] a) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v ) +instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v ) => GetHeaders (Headers (Header h v ': rest) a) where getHeaders hs = getHeaders $ getHeadersHList hs @@ -111,11 +111,11 @@ addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times -instance OVERLAPPING_ ( KnownSymbol h, ToByteString v ) +instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads) -instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v +instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v , new ~ (Headers '[Header h v] a) ) => AddHeader h v a new where addHeader a resp = Headers resp (HCons (Header a) HNil) diff --git a/test/Servant/API/ContentTypesSpec.hs b/test/Servant/API/ContentTypesSpec.hs --- a/test/Servant/API/ContentTypesSpec.hs +++ b/test/Servant/API/ContentTypesSpec.hs @@ -11,7 +11,6 @@ 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 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 () @@ -67,21 +65,6 @@ 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