web-cookiejar 0.1.2.0 → 0.1.3.0
raw patch · 5 files changed
+342/−9 lines, 5 filesdep +cookiedep +http-typesdep +mtldep ~basedep ~bytestringdep ~http-client
Dependencies added: cookie, http-types, mtl, string-conv, wai, warp, warp-tls
Dependency ranges changed: base, bytestring, http-client, time
Files
- ChangeLog.md +5/−0
- server-test/Cookie/WaiSpec.hs +258/−0
- server-test/Spec.hs +22/−0
- src/Web/Cookie/Jar.hs +25/−8
- web-cookiejar.cabal +32/−1
ChangeLog.md view
@@ -3,6 +3,11 @@ `web-cookiejar` uses [PVP Versioning][1]. +## 0.1.3.0 -- 2025-06-25++* Add usingCookiesFromFile' which reorders args of usingCookiesFromFile for ease+ of use+ ## 0.1.2.0 -- 2025-06-24 * Export constructor for BadJarFile; correcting a mistake in 0.1.1.0
+ server-test/Cookie/WaiSpec.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Cookie.JarSpec+Copyright : (c) 2023 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Cookie.WaiSpec (spec) where++import Control.Monad (join)+import Control.Monad.Cont (cont, runCont)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Builder (byteString, intDec, toLazyByteString)+import qualified Data.ByteString.Lazy as L+import Data.String (fromString)+import Data.String.Conv (toS)+import Data.Time (Day (..), UTCTime (..), secondsToDiffTime)+import Data.Time.Clock.POSIX+ ( posixSecondsToUTCTime+ )+import Data.Word (Word16)+import Network.HTTP.Client+ ( Cookie (..)+ , CookieJar+ , Manager+ , Response (..)+ , createCookieJar+ , defaultManagerSettings+ , destroyCookieJar+ , httpLbs+ , newManager+ , parseRequest+ )+import Network.HTTP.Types.Header (ResponseHeaders, hSetCookie)+import Network.HTTP.Types.Status (Status (statusCode), status200)+import Network.Wai (Application)+import qualified Network.Wai as Wai+import Network.Wai.Handler.Warp (Port, testWithApplication)+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.QuickCheck+ ( Arbitrary (arbitrary)+ , Gen+ , Property+ , chooseInteger+ , listOf1+ , suchThat+ )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run)+import Web.Cookie (SetCookie (..), defaultSetCookie, renderSetCookieBS)+import Web.Cookie.Jar+++spec :: Spec+spec = describe "Module Web.Cookie.Jar" $ do+ context "usingCookiesFromFile" $ around useTmpAndCookieApp $ do+ context "when applied to a request that returns a cookie" $ do+ it "should store it in the cookie jar" prop_fetchUsingCookiesUpdatesJar+++useTmp :: (FilePath -> IO a) -> IO a+useTmp = withSystemTempDirectory "web-cookiejar"+++useTmpAndCookieApp :: ((FilePath, Port, Manager) -> IO a) -> IO a+useTmpAndCookieApp = runCont $ do+ manager <- cont (mkManager >>=)+ cookieDir <- cont useTmp+ port <- cont withCookieApp+ pure (cookieDir, port, manager)+++prop_fetchUsingCookiesUpdatesJar :: (FilePath, Port, Manager) -> Property+prop_fetchUsingCookiesUpdatesJar (root, port, manager) = monadicIO $ do+ core <- pick genCore+ (jarBase, _jar) <- pick genJarWithPath+ let jarPath = root ++ "/" ++ jarBase+ testUrl = asLocalHostUrl port core++ (stored, ok) <- run $ do+ ok <- (== 200) <$> fetch jarPath manager testUrl+ jar <- readJarX jarPath+ let stored = isIn core jar+ pure (stored, ok)+ assert $ stored && ok+++fetch :: FilePath -> Manager -> ByteString -> IO Int+fetch cookiePath manager url = do+ let doReq = usingCookiesFromFile' cookiePath $ flip httpLbs manager+ rq <- parseRequest $ toS url+ statusCode . responseStatus <$> doReq rq+++genJarWithPath :: Gen (FilePath, CookieJar)+genJarWithPath = do+ let mkPath i = "cookie-jar-" ++ i ++ ".txt"+ index <- mkPath . show <$> genWord16+ (,) index <$> genCookieJar+++genCookieJar :: Gen CookieJar+genCookieJar = createCookieJar <$> listOf1 genCookie+++genCookie :: Gen Cookie+genCookie = do+ (creation, expiry) <- genCreationAndExpiry+ Cookie+ <$> genWithSuffix "name_"+ <*> genWithSuffix "value_"+ <*> pure expiry+ <*> genWithSuffix "domain_"+ <*> genWithSuffix "path_"+ <*> pure creation+ <*> pure creation+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+++genCreationAndExpiry :: Gen (UTCTime, UTCTime)+genCreationAndExpiry = do+ creation <- genUTCTime+ expiry <- genUTCTime `suchThat` (> creation)+ pure (creation, expiry)+++genWord16 :: Gen Word16+genWord16 = arbitrary+++genUTCTime :: Gen UTCTime+genUTCTime = posixSecondsToUTCTime . fromInteger <$> chooseInteger (1, 365 * 86400 * 20)+++genWithSuffix :: ByteString -> Gen ByteString+genWithSuffix bs = (bs <>) . fromString . show <$> genWord16+++withCookieApp :: (Port -> IO a) -> IO a+withCookieApp = testWithApplication (pure cookieApp)+++cookieApp :: Application+cookieApp rq respond =+ let headers = maybe [] applyCookieCmd $ mbCookieCmd rq+ in respond $ Wai.responseLBS status200 headers "ok"+++applyCookieCmd :: CookieCmd -> ResponseHeaders+applyCookieCmd cmd =+ let theCookie = case cmd of+ Clear x ->+ defaultSetCookie+ { setCookieName = x+ , setCookieMaxAge = Just $ secondsToDiffTime 0+ , setCookieExpires = Just expireTime+ }+ Change x y -> defaultSetCookie {setCookieName = x, setCookieValue = y}+ in [(hSetCookie, renderSetCookieBS theCookie)]+++{--+look for cookieName param+look for cookieValue param++if no cookieName exists: Nothing+if cookieName exists but not CookieCmd: (Just $ Clear cookieName)+if both exist (Just $ Change cookieName cookieValue)+-}+mbCookieCmd :: Wai.Request -> Maybe CookieCmd+mbCookieCmd req =+ let valueOfMb p = join (lookup p (Wai.queryString req))+ nameItem = valueOfMb nameParam+ valueItem = valueOfMb valueParam+ in case (nameItem, valueItem) of+ (Nothing, _) -> Nothing+ (Just x, Nothing) -> Just (Clear x)+ (Just x, Just y) -> Just (Change x y)+++-- | Arbitrary cookie expiry time set back in history after unix time 0+expireTime :: UTCTime+expireTime = UTCTime (ModifiedJulianDay 50000) 0+++genPathNameValue :: Gen (ByteString, ByteString, ByteString)+genPathNameValue = do+ base <- genWithSuffix "base"+ path <- genWithSuffix $ "test/path/" <> base <> "/"+ name <- genWithSuffix "name_"+ value <- genWithSuffix "value_"+ pure (path, name, value)+++genCore :: Gen Core+genCore =+ let mk (cPath, cName, cValue) = Core {cPath, cName, cValue}+ in mk <$> genPathNameValue+++asLocalHostUrl :: Port -> Core -> ByteString+asLocalHostUrl port Core {cPath, cName, cValue} =+ let builder =+ "http://localhost"+ <> ":"+ <> intDec port+ <> "/"+ <> byteString cPath+ <> "?"+ <> byteString nameParam+ <> "="+ <> byteString cName+ <> "&"+ <> byteString valueParam+ <> "="+ <> byteString cValue+ in L.toStrict $ toLazyByteString builder+++isIn :: Core -> CookieJar -> Bool+isIn core jar =+ let matches Core {cPath, cName, cValue} c =+ BS.isPrefixOf (cookie_path c) ("/" <> cPath)+ && cName == cookie_name c+ && cValue == cookie_value c+ in any (matches core) (destroyCookieJar jar)+++nameParam, valueParam :: ByteString+nameParam = "cookieName"+valueParam = "cookieValue"+++mkManager :: IO Manager+mkManager = newManager defaultManagerSettings+++data Core = Core+ { cPath :: !ByteString+ , cName :: !ByteString+ , cValue :: !ByteString+ }+ deriving (Eq, Show)+++data CookieCmd+ = Change+ !ByteString+ !ByteString+ | Clear+ !ByteString+ deriving (Eq, Show)
+ server-test/Spec.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import qualified Cookie.WaiSpec as Wai+import System.IO+ ( BufferMode (..)+ , hSetBuffering+ , stderr+ , stdout+ )+import Test.Hspec+++main :: IO ()+main = do+ hSetBuffering stdout NoBuffering+ hSetBuffering stderr NoBuffering+ hspec $ do+ Wai.spec
src/Web/Cookie/Jar.hs view
@@ -3,12 +3,22 @@ {- | 'Parser' for a Netscape/Mozilla cookie jar -Provides parsing functions that parse the Netscape/Mozilla cookie jar file-format, along wiht @'Builder's@ that provide an incomplete roundtrip with the-parser.+Provides: -The roundtrip is incomplete because some of the fields in @Cookie@ are not saved-in the Netscape/Mozilla cookie jar; see `cookieBuilder`.+* parsing functions that parse the Netscape/Mozilla cookie jar file format++* @'Builder's@ that provide an incomplete roundtrip with the+ parser.++ * __incomplete__ because some of the fields in @Cookie@ are not+ saved in the Netscape/Mozilla cookie jar; see `cookieBuilder`.++* combinators to ease use with "Network.Http.Client", like 'usingCookiesFromFile'', e.g,++ > httpWithCookies :: Manager -> FilePath -> Request -> IO (Response a)+ > httpWithCookies manager cookieJarPath req = do+ > let httpLbs' = usingCookiesFromFile' cookiePath $ flip httpLbs manager+ > httpLbs' req -} module Web.Cookie.Jar ( -- * read and write files@@ -19,10 +29,11 @@ , readJarX , BadJarFile (..) - -- * update HTTP messages+ -- * use with http-client , addCookiesFromFile , saveCookies , usingCookiesFromFile+ , usingCookiesFromFile' -- * Cookie jar format @@ -95,6 +106,11 @@ saveCookies jarPath resp req' +-- | 'usingCookiesFromFile' with arguments re-ordered+usingCookiesFromFile' :: FilePath -> (Request -> IO (Response b)) -> Request -> IO (Response b)+usingCookiesFromFile' p = flip (usingCookiesFromFile p)++ {- | Add any appropriate Cookies from a cookie file to a @Request@ - if the file is absent, no update occurs@@ -124,8 +140,9 @@ The output is saved to the cookie file using 'writeJar' throws an exception if:- - cannot write due to permissions or parent directory not existing- - the file exists, but cannot be parsed into Cookies++ - cannot write due to permissions or parent directory not existing+ - the file exists, but cannot be parsed into Cookies -} saveCookies :: FilePath -> Response a -> Request -> IO (Response a) saveCookies dataPath resp req = do
web-cookiejar.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: web-cookiejar-version: 0.1.2.0+version: 0.1.3.0 synopsis: Parsing/printing of persistent web cookies description: A library that provides parsing and printing functions that read and write web@@ -58,3 +58,34 @@ , time , web-cookiejar +Flag enable-server-test+ description: Build server-test+ default: False++test-suite server-test + if flag(enable-server-test)+ buildable: True+ else+ buildable: False+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: server-test+ other-modules: Cookie.WaiSpec+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs+ build-depends:+ , base+ , bytestring+ , cookie >=0.4 && < 0.8+ , hspec >=2.7.0 && <2.12.0+ , http-client+ , http-types >=0.12.1 && <0.13+ , mtl >=2.2 && <2.3 || >=2.3.1 && <2.4+ , QuickCheck >= 2.13 && < 2.18+ , string-conv >=0.1 && <0.3+ , temporary >= 1.2 && < 1.4+ , time+ , wai >=3.2 && < 3.6+ , warp-tls >=3.4 && < 3.8+ , warp >=3.4 && < 3.8+ , web-cookiejar