http-client 0.6.4.1 → 0.7.0
raw patch · 6 files changed
+113/−20 lines, 6 files
Files
- ChangeLog.md +4/−0
- Network/HTTP/Client.hs +5/−1
- Network/HTTP/Client/Cookies.hs +2/−2
- Network/HTTP/Client/Types.hs +62/−15
- http-client.cabal +2/−1
- test-nonet/Network/HTTP/Client/CookieSpec.hs +38/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for http-client +## 0.7.0++* Remove Eq instances for Cookie, CookieJar, Response, Ord instance for Cookie [#435](https://github.com/snoyberg/http-client/pull/435)+ ## 0.6.4.1 * Win32 2.8 support [#430](https://github.com/snoyberg/http-client/pull/430)
Network/HTTP/Client.hs view
@@ -192,7 +192,12 @@ , HttpException (..) , HttpExceptionContent (..) , Cookie (..)+ , equalCookie+ , equivCookie+ , compareCookies , CookieJar+ , equalCookieJar+ , equivCookieJar , Proxy (..) , withConnection -- * Cookies@@ -211,7 +216,6 @@ import Data.IORef (newIORef, writeIORef, readIORef, modifyIORef) import qualified Data.ByteString.Lazy as L import Data.Foldable (Foldable)-import Data.Monoid import Data.Traversable (Traversable) import Network.HTTP.Types (statusCode) import GHC.Generics (Generic)
Network/HTTP/Client/Cookies.hs view
@@ -100,7 +100,7 @@ where (mc, lc) = removeExistingCookieFromCookieJarHelper cookie (expose cookie_jar') removeExistingCookieFromCookieJarHelper _ [] = (Nothing, []) removeExistingCookieFromCookieJarHelper c (c' : cs)- | c == c' = (Just c', cs)+ | c `equivCookie` c' = (Just c', cs) | otherwise = (cookie', c' : cookie_jar'') where (cookie', cookie_jar'') = removeExistingCookieFromCookieJarHelper c cs @@ -148,7 +148,7 @@ | not (cookie_http_only cookie) = True | otherwise = is_http_api matching_cookies = filter matching_cookie $ expose cookie_jar- output_cookies = map (\ c -> (cookie_name c, cookie_value c)) $ L.sort matching_cookies+ output_cookies = map (\ c -> (cookie_name c, cookie_value c)) $ L.sortBy compareCookies matching_cookies output_line = toByteString $ renderCookies $ output_cookies folding_function cookie_jar'' cookie = case removeExistingCookieFromCookieJar cookie cookie_jar'' of (Just c, cookie_jar''') -> insertIntoCookieJar (c {cookie_last_access_time = now}) cookie_jar'''
Network/HTTP/Client/Types.hs view
@@ -13,7 +13,12 @@ , throwHttp , toHttpException , Cookie (..)+ , equalCookie+ , equivCookie+ , compareCookies , CookieJar (..)+ , equalCookieJar+ , equivCookieJar , Proxy (..) , RequestBody (..) , Popper@@ -263,26 +268,64 @@ newtype CookieJar = CJ { expose :: [Cookie] } deriving (Read, Show, T.Typeable) --- This corresponds to step 11 of the algorithm described in Section 5.3 \"Storage Model\"-instance Eq Cookie where- (==) a b = name_matches && domain_matches && path_matches- where name_matches = cookie_name a == cookie_name b- domain_matches = CI.foldCase (cookie_domain a) == CI.foldCase (cookie_domain b)- path_matches = cookie_path a == cookie_path b+-- | Instead of '(==)'.+--+-- Since there was some confusion in the history of this library about how the 'Eq' instance+-- should work, it was removed for clarity, and replaced by 'equal' and 'equiv'. 'equal'+-- gives you equality of all fields of the 'Cookie' record.+--+-- @since 0.7.0+equalCookie :: Cookie -> Cookie -> Bool+equalCookie a b = and+ [ cookie_name a == cookie_name b+ , cookie_value a == cookie_value b+ , cookie_expiry_time a == cookie_expiry_time b+ , cookie_domain a == cookie_domain b+ , cookie_path a == cookie_path b+ , cookie_creation_time a == cookie_creation_time b+ , cookie_last_access_time a == cookie_last_access_time b+ , cookie_persistent a == cookie_persistent b+ , cookie_host_only a == cookie_host_only b+ , cookie_secure_only a == cookie_secure_only b+ , cookie_http_only a == cookie_http_only b+ ] -instance Ord Cookie where- compare c1 c2+-- | Equality of name, domain, path only. This corresponds to step 11 of the algorithm+-- described in Section 5.3 \"Storage Model\". See also: 'equal'.+--+-- @since 0.7.0+equivCookie :: Cookie -> Cookie -> Bool+equivCookie a b = name_matches && domain_matches && path_matches+ where name_matches = cookie_name a == cookie_name b+ domain_matches = CI.foldCase (cookie_domain a) == CI.foldCase (cookie_domain b)+ path_matches = cookie_path a == cookie_path b++-- | Instead of @instance Ord Cookie@. See 'equalCookie', 'equivCookie'.+--+-- @since 0.7.0+compareCookies :: Cookie -> Cookie -> Ordering+compareCookies c1 c2 | S.length (cookie_path c1) > S.length (cookie_path c2) = LT | S.length (cookie_path c1) < S.length (cookie_path c2) = GT | cookie_creation_time c1 > cookie_creation_time c2 = GT | otherwise = LT -instance Eq CookieJar where- (==) cj1 cj2 = (DL.sort $ expose cj1) == (DL.sort $ expose cj2)+-- | See 'equalCookie'.+--+-- @since 0.7.0+equalCookieJar :: CookieJar -> CookieJar -> Bool+equalCookieJar (CJ cj1) (CJ cj2) = and $ zipWith equalCookie cj1 cj2 +-- | See 'equalCookieJar', 'equalCookie'.+--+-- @since 0.7.0+equivCookieJar :: CookieJar -> CookieJar -> Bool+equivCookieJar cj1 cj2 = and $+ zipWith equivCookie (DL.sortBy compareCookies $ expose cj1) (DL.sortBy compareCookies $ expose cj2)+ instance Semigroup CookieJar where- (CJ a) <> (CJ b) = CJ (DL.nub $ DL.sortBy compare' $ a <> b)- where compare' c1 c2 =+ (CJ a) <> (CJ b) = CJ (DL.nubBy equivCookie $ DL.sortBy mostRecentFirst $ a <> b)+ where mostRecentFirst c1 c2 = -- inverse so that recent cookies are kept by nub over older if cookie_creation_time c1 > cookie_creation_time c2 then LT@@ -630,14 +673,18 @@ -- -- Since 0.1.0 }- deriving (Show, Eq, T.Typeable, Functor, Data.Foldable.Foldable, Data.Traversable.Traversable)+ deriving (Show, T.Typeable, Functor, Data.Foldable.Foldable, Data.Traversable.Traversable) +-- Purposely not providing this instance. It used to use 'equivCookieJar'+-- semantics before 0.7.0, but should, if anything, use 'equalCookieJar'+-- semantics.+--+-- instance Exception Eq+ newtype ResponseClose = ResponseClose { runResponseClose :: IO () } deriving T.Typeable instance Show ResponseClose where show _ = "ResponseClose"-instance Eq ResponseClose where- _ == _ = True -- | Settings for a @Manager@. Please use the 'defaultManagerSettings' function and then modify -- individual settings. For more information, see <http://www.yesodweb.com/book/settings-types>.
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.6.4.1+version: 0.7.0 synopsis: An HTTP client engine description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client@@ -125,6 +125,7 @@ , hspec , monad-control , bytestring+ , cookie , text , http-types , blaze-builder
test-nonet/Network/HTTP/Client/CookieSpec.hs view
@@ -1,9 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Client.CookieSpec where +import Control.Monad (when)+import Data.Monoid import Data.Time.Clock import Network.HTTP.Client.Internal import Test.Hspec+import qualified Data.Time as DT+import qualified Web.Cookie as WC main :: IO () main = hspec spec@@ -14,7 +18,7 @@ now <- getCurrentTime let cookie1 = Cookie "test" "value" now "doMain.Org" "/" now now False False False False cookie2 = Cookie "test" "value" now "DOMAIn.ORg" "/" now now False False False False- cookie1 `shouldBe` cookie2+ cookie1 `shouldSatisfy` (equivCookie cookie2) it "domainMatches - case insensitive" $ do domainMatches "www.org" "www.org" `shouldBe` True@@ -24,3 +28,36 @@ it "domainMatches - case insensitive, partial" $ do domainMatches "www.org" "xxx.www.org" `shouldBe` False domainMatches "xxx.www.org" "WWW.ORG" `shouldBe` True++ describe "equalCookie vs. equivCookie" $ do+ let make :: IO Cookie+ make = do+ now <- DT.getCurrentTime+ req <- parseRequest "http://www.example.com/path"+ let Just cky = generateCookie (WC.parseSetCookie raw) req now True+ raw = "somename=somevalue.v=1.k=1.d=1590419679.t=u.l=s.u=8b2734ae-9dd1-11ea-bd7f-3bcf5b8d5d2a.r=795e71b5; " <>+ "Path=/access; Domain=example.com; HttpOnly; Secure"+ return cky++ modifications :: [(String, Cookie -> Cookie, Bool)]+ modifications+ = [ ("cookie_name", \cky -> cky { cookie_name = "othername" }, True)+ , ("cookie_value", \cky -> cky { cookie_value = "othervalue" }, False)+ , ("cookie_expiry_time", \cky -> cky { cookie_expiry_time = DT.addUTCTime 60 $ cookie_expiry_time cky }, False)+ , ("cookie_domain", \cky -> cky { cookie_domain = cookie_domain cky <> ".com" }, True)+ , ("cookie_path", \cky -> cky { cookie_path = cookie_path cky <> "/sub" }, True)+ , ("cookie_creation_time", \cky -> cky { cookie_creation_time = DT.addUTCTime 60 $ cookie_creation_time cky }, False)+ , ("cookie_last_access_time", \cky -> cky { cookie_last_access_time = DT.addUTCTime 60 $ cookie_last_access_time cky }, False)+ , ("cookie_persistent", \cky -> cky { cookie_persistent = not $ cookie_persistent cky }, False)+ , ("cookie_host_only", \cky -> cky { cookie_host_only = not $ cookie_host_only cky }, False)+ , ("cookie_secure_only", \cky -> cky { cookie_secure_only = not $ cookie_secure_only cky }, False)+ , ("cookie_http_only", \cky -> cky { cookie_http_only = not $ cookie_http_only cky }, False)+ ]++ check :: (String, Cookie -> Cookie, Bool) -> Spec+ check (msg, f, countsForEquiv) = it msg $ do+ cky <- make+ cky `equalCookie` f cky `shouldBe` False+ when countsForEquiv $ cky `equivCookie` f cky `shouldBe` False++ check `mapM_` modifications