web-cookiejar (empty) → 0.1.0.0

raw patch · 7 files changed

+520/−0 lines, 7 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed

Dependencies added: QuickCheck, attoparsec, base, bytestring, hspec, http-client, temporary, time, web-cookiejar

Files

• ChangeLog.md +9/−0
• LICENSE +30/−0
• Setup.hs +4/−0
• src/Web/Cookie/Jar.hs +223/−0
• test/Cookie/JarSpec.hs +173/−0
• test/Spec.hs +22/−0
• web-cookiejar.cabal +59/−0

@@ -0,0 +1,9 @@+# Revision history for web-cookiejar++`web-cookiejar` uses [PVP Versioning][1].++## 0.1.0.0 -- 2025-04-07++* Initial version.++[1]: https://pvp.haskell.org

@@ -0,0 +1,30 @@+Copyright (c) 2023, Tim Emiola++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tim Emiola nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,4 @@+import Distribution.Simple+++main = defaultMain

@@ -0,0 +1,223 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{- | '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.++The roundtrip is incomplete because some of the fields in @Cookie@ are not saved+in the Netscape/Mozilla cookie jar; see `cookieBuilder`.+-}+module Web.Cookie.Jar+  ( -- * read/write Cookie Jar files+    writeJar+  , writeJar'+  , writeNetscapeJar+  , readJar++    -- * Cookie jar format++    -- ** parsing+  , cookieJarParser+  , cookieParser+  , parseCookieJar++    -- ** printing+  , netscapeJarBuilder+  , jarBuilder+  , jarBuilder'+  , cookieBuilder++    -- * re-exports+  , parseOnly+  )+where++import Control.Applicative ((<|>))+import Control.Monad (void)+import Data.Attoparsec.ByteString.Char8+  ( Parser+  , char+  , decimal+  , endOfLine+  , isEndOfLine+  , many'+  , parseOnly+  , skipSpace+  , skipWhile+  , takeWhile1+  , try+  )+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Builder+  ( Builder+  , byteString+  , char7+  , integerDec+  , toLazyByteString+  )+import qualified Data.ByteString.Lazy as L+import Data.Char (ord)+import Data.Time.Clock.POSIX+  ( posixSecondsToUTCTime+  , utcTimeToPOSIXSeconds+  )+import Network.HTTP.Client+  ( Cookie (..)+  , CookieJar+  , createCookieJar+  , destroyCookieJar+  )+++-- | Parse a @ByteString@ containing a cookie jar in the Netscape/Mozilla format+parseCookieJar :: ByteString -> Either String CookieJar+parseCookieJar = parseOnly cookieJarParser+++-- | @Parser@ for a cookie jar in the Netscape/Mozilla format+cookieJarParser :: Parser CookieJar+cookieJarParser = createCookieJar <$> many' cookieParser+++{- | Parser for one cookie/line in a cookie jar in the Netscape/Mozilla format+This will also consume any comment lines preceding the cookie line.++This parser recognizes the magic prefix @#HttpOnly_# and sets the appropriate+field in the @Cookie@ datatype+-}+cookieParser :: Parser Cookie+cookieParser =+  let+    httpOnlyLine = try $ "#HttpOnly_" *> cookieParser' True+    commentLine = "#" *> skipWhile notEndOfLine *> endOfLine *> cookieParser+    cookieLine = cookieParser' False+   in+    skipSpace *> (httpOnlyLine <|> commentLine <|> cookieLine)+++-- | Basic parser for a line containing a cookie in the Netscape/Mozilla format+cookieParser' :: Bool -> Parser Cookie+cookieParser' cookie_http_only = do+  let+    epoch = posixSecondsToUTCTime 0+    -- component parsers+    tab = void $ char '\t'+    parseString = takeWhile1 (/= '\t')+    parseBool = True <$ "TRUE" <|> False <$ "FALSE"+    parseTime = posixSecondsToUTCTime . fromInteger <$> decimal+    parseValue = takeWhile1 notEndOfLine+  cookie_domain <- parseString+  tab+  cookie_host_only <- parseBool+  tab+  cookie_path <- parseString+  tab+  cookie_secure_only <- parseBool+  tab+  cookie_expiry_time <- parseTime+  tab+  cookie_name <- parseString+  tab+  cookie_value <- parseValue+  endOfLine <|> pure ()+  pure $+    Cookie+      { cookie_domain+      , cookie_path+      , cookie_secure_only+      , cookie_expiry_time+      , cookie_name+      , cookie_value+      , cookie_host_only+      , cookie_http_only+      , -- fields not represented by the cookie jar format+        cookie_creation_time = epoch+      , cookie_last_access_time = epoch+      , cookie_persistent = True+      }+++notEndOfLine :: Char -> Bool+notEndOfLine = not . isEndOfLine . fromIntegral . ord+++-- | Like 'jarBuilder' but outputs the Netscape header before the cookie lines+netscapeJarBuilder :: CookieJar -> Builder+netscapeJarBuilder = jarBuilder' netscapeHeader+++netscapeHeader :: Builder+netscapeHeader = "# Netscape HTTP Cookie File\n"+++-- | Print a cookie jar in the Netscape/Mozilla format, with no header+jarBuilder :: CookieJar -> Builder+jarBuilder = foldMap ((<> "\n") . cookieBuilder) . destroyCookieJar+++-- | Like 'jarBuilder' but outputs a header before the cookie lines+jarBuilder' :: Builder -> CookieJar -> Builder+jarBuilder' header = (header <>) . jarBuilder+++-- | Writes a cookie jar to the given path in the Netscape/Mozilla format, with no header+writeJar :: FilePath -> CookieJar -> IO ()+writeJar fp = L.writeFile fp . toLazyByteString . jarBuilder+++-- | Like 'writeJar', but outputs a header before the cookie lines+writeJar' :: Builder -> FilePath -> CookieJar -> IO ()+writeJar' header fp =+  L.writeFile fp+    . toLazyByteString+    . jarBuilder'+      header+++-- | Like 'writeJar', but outputs the Netscape header before the cookie lines+writeNetscapeJar :: FilePath -> CookieJar -> IO ()+writeNetscapeJar = writeJar' netscapeHeader+++-- | Read a Cookie Jar from a file.+readJar :: FilePath -> IO (Either String CookieJar)+readJar = fmap parseCookieJar . B.readFile+++{- | Builder for one cookie; generates a single line in the Cookie Jar file format++the values of the following fields are not output, as the file format does+support them.++- 'cookie_creation_time'+- 'cookie_last_access_time'+- 'cookie_persistent'+-}+cookieBuilder :: Cookie -> Builder+cookieBuilder c =+  let+    httpOnly True = "#HttpOnly_"+    httpOnly False = mempty+    bool True = "TRUE"+    bool False = "FALSE"+    unixTime = integerDec . round . utcTimeToPOSIXSeconds+    tab = char7 '\t'+   in+    httpOnly (cookie_http_only c)+      <> byteString (cookie_domain c)+      <> tab+      <> bool (cookie_host_only c)+      <> tab+      <> byteString (cookie_path c)+      <> tab+      <> bool (cookie_secure_only c)+      <> tab+      <> unixTime (cookie_expiry_time c)+      <> tab+      <> byteString (cookie_name c)+      <> tab+      <> byteString (cookie_value c)

@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Cookie.JarSpec+Copyright   : (c) 2023 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Cookie.JarSpec (spec) where++import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder, toLazyByteString)+import qualified Data.ByteString.Lazy as L+import Data.List (sortBy)+import Data.String (fromString)+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX+  ( posixSecondsToUTCTime+  )+import Data.Word (Word16)+import Network.HTTP.Client+  ( Cookie (..)+  , CookieJar+  , compareCookies+  , createCookieJar+  , destroyCookieJar+  , equalCookie+  )+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.QuickCheck+  ( Arbitrary (arbitrary)+  , Gen+  , Property+  , chooseInteger+  , forAll+  , listOf1+  , suchThat+  )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run)+import Web.Cookie.Jar+++spec :: Spec+spec = describe "Module Web.Cookie.Jar" $ do+  context "parsing with cookieParser" $ do+    context "and building with cookieBuilder" $ do+      it "should almost roundtrip" prop_almostRoundtripCookie++  context "parsing with cookieJarParser" $ do+    context "and building with jarBuilder" $ do+      it "should almost roundtrip" (prop_almostRoundtripCookieJar jarBuilder)++    context "and building netscapeJarBuilder" $ do+      it "should almost roundtrip" (prop_almostRoundtripCookieJar netscapeJarBuilder)++  context "when accessing persisted jars" $ around useTmp $ do+    context "writeJar then readJar" $ do+      it "should almost roundtrip" (prop_almostRoundtripSavedJars writeJar)+    context "writeNetscapeJar then readJar" $ do+      it "should almost roundtrip" (prop_almostRoundtripSavedJars writeNetscapeJar)+++useTmp :: (FilePath -> IO a) -> IO a+useTmp = withSystemTempDirectory "web-cookiejar"+++genJarWithPath :: Gen (FilePath, CookieJar)+genJarWithPath = do+  let mkPath i = "cookie-jar-" ++ i ++ ".txt"+  index <- mkPath . show <$> genWord16+  (,) index <$> genCookieJar+++prop_almostRoundtripSavedJars :: (FilePath -> CookieJar -> IO ()) -> FilePath -> Property+prop_almostRoundtripSavedJars writer root = monadicIO $ do+  (jarBase, jar) <- pick genJarWithPath+  let jarPath = root ++ "/" ++ jarBase++  -- this match is incomplete, that's ok, the test fails if it produces a Left+  Right jar' <- run $ do+    writer jarPath jar+    readJar jarPath+  assert $ almostEqJar jar jar'+++prop_almostRoundtripCookieJar :: (CookieJar -> Builder) -> Property+prop_almostRoundtripCookieJar toBuilder =+  forAll (cookieJarWithX toBuilder <$> genCookieJar) $ \(j, _txt, j') ->+    either (const False) (almostEqJar j) j'+++cookieJarWithX+  :: (CookieJar -> Builder) -> CookieJar -> (CookieJar, ByteString, Either String CookieJar)+cookieJarWithX toBuilder j =+  let txt = asByteString $ toBuilder j+   in (j, txt, parseCookieJar txt)+++genCookieJar :: Gen CookieJar+genCookieJar = createCookieJar <$> listOf1 genCookie+++almostEqJar :: CookieJar -> CookieJar -> Bool+almostEqJar jar1 jar2 =+  let+    cookiesOf = sortBy compareCookies . map fixup . destroyCookieJar+   in+    and $ zipWith equalCookie (cookiesOf jar1) (cookiesOf jar2)+++prop_almostRoundtripCookie :: Property+prop_almostRoundtripCookie =+  forAll (cookieWithLine <$> genCookie) $ \(c, line) ->+    either (const False) (almostEq c) $ parseOnly cookieParser line+++asByteString :: Builder -> ByteString+asByteString = L.toStrict . toLazyByteString+++cookieWithLine :: Cookie -> (Cookie, ByteString)+cookieWithLine c = (c, asByteString $ cookieBuilder c)+++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)+++almostEq :: Cookie -> Cookie -> Bool+almostEq c1 c2 = fixup c1 `equalCookie` fixup c2+++fixup :: Cookie -> Cookie+fixup c =+  let epoch = posixSecondsToUTCTime 0+   in c+        { cookie_persistent = True+        , cookie_last_access_time = epoch+        , cookie_creation_time = epoch+        }+++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

@@ -0,0 +1,22 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import qualified Cookie.JarSpec as Jar+import System.IO (+  BufferMode (..),+  hSetBuffering,+  stderr,+  stdout,+ )+import Test.Hspec+++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  hSetBuffering stderr NoBuffering+  hspec $ do+    Jar.spec

@@ -0,0 +1,59 @@+cabal-version:      3.0+name:               web-cookiejar+version:            0.1.0.0+synopsis:           Parsing/printing of persistent web cookies+description:+  A library that provides parsing and printing functions that read and write web+  cookies stored in the Netscape/Mozilla cookie jar file format; also the format+  used by curl.++  See the [README](https://github.com/adetokunbo/web-cookiejar?tab=readme-ov-file#web-cookiejar)+  for a simple usage example++license:            BSD-3-Clause+license-file:       LICENSE+author:             Tim Emiola+maintainer:         adetokunbo@emio.la+category:           Web+homepage:           https://github.com/adetokunbo/web-cookiejar#readme+bug-reports:+  https://github.com/adetokunbo/web-cookiejar/issues+tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1+build-type:         Simple+extra-source-files:+  ChangeLog.md++source-repository head+  type:     git+  location: https://github.com/adetokunbo/web-cookiejar.git++library+  exposed-modules:  Web.Cookie.Jar+  hs-source-dirs:   src+  build-depends:+    , attoparsec           >=0.14.4 && <0.15+    , base                 >=4.10 && <5+    , bytestring           >=0.10.8 && <0.11 || >=0.11.3 && <0.13+    , http-client          >=0.5 && <0.8+    , time                 >=1.8 && <1.15++  default-language: Haskell2010+  ghc-options:      -Wall -Wincomplete-uni-patterns -Wpartial-fields -fwarn-tabs++test-suite test+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  other-modules:    Cookie.JarSpec+  default-language: Haskell2010+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs+  build-depends:+    , base+    , bytestring+    , hspec                >=2.7.0 && <2.12.0+    , http-client+    , QuickCheck           >= 2.13 && < 2.16+    , temporary            >= 1.2 && < 1.4+    , time+    , web-cookiejar+