@@ -1,12 +1,12 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFunctor #-}
5−{-# LANGUAGE DeriveFoldable #-}
6−{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE OverloadedStrings #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFoldable #-}
5+{-# LANGUAGE DeriveFunctor #-}
6+{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
1010{-# LANGUAGE TypeSynonymInstances #-}
1111-- |
1212-- Convert Haskell values to and from HTTP API data
@@ -14,52 +14,56 @@
1414module Web.Internal.HttpApiData where
1515
1616#if __GLASGOW_HASKELL__ < 710
17−import Control.Applicative
18−import Data.Foldable (Foldable)
19−import Data.Traversable (Traversable(traverse))
17+import Control.Applicative
18+import Data.Foldable (Foldable)
19+import Data.Traversable (Traversable (traverse))
2020#endif
2121
22−import Control.Arrow ((&&&), left)
23−import Control.Monad ((<=<))
22+import Control.Arrow (left, (&&&))
23+import Control.Monad ((<=<))
2424
25−import Data.Monoid
26−import Data.ByteString (ByteString)
27−import qualified Data.ByteString as BS
25+import Data.ByteString (ByteString)
26+import qualified Data.ByteString as BS
27+import Data.Monoid
2828
29−import Data.Int
30−import Data.Word
29+import Data.Int
30+import Data.Word
3131
32−import Data.Text (Text)
33−import Data.Text.Encoding (encodeUtf8, decodeUtf8')
34−import Data.Text.Read (signed, decimal, rational, Reader)
35−import qualified Data.Text as T
36−import qualified Data.Text.Lazy as L
32+import Data.Text (Text)
33+import qualified Data.Text as T
34+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
35+import qualified Data.Text.Lazy as L
36+import Data.Text.Read (Reader, decimal, rational,
37+ signed)
3738
38−import Data.Time.Locale.Compat
39−import Data.Time
40−import Data.Version
39+import Data.Time
40+import Data.Time.Locale.Compat
41+import Data.Version
4142
4243#if MIN_VERSION_base(4,8,0)
43−import Data.Void
44−import Numeric.Natural
44+import Data.Void
45+import Numeric.Natural
4546#endif
4647
47−import Text.Read (readMaybe)
48−import Text.ParserCombinators.ReadP (readP_to_S)
48+import Text.ParserCombinators.ReadP (readP_to_S)
49+import Text.Read (readMaybe)
4950
5051#if USE_TEXT_SHOW
51−import TextShow (TextShow, showt)
52+import TextShow (TextShow, showt)
5253#endif
5354
54−import qualified Data.UUID.Types as UUID
55+import qualified Data.UUID.Types as UUID
5556
56−import Data.Typeable (Typeable)
57−import Data.Data (Data)
58−import qualified Data.ByteString.Builder as BS
59−import qualified Network.HTTP.Types as H
57+import qualified Data.ByteString.Builder as BS
58+import Data.Data (Data)
59+import Data.Typeable (Typeable)
60+import qualified Network.HTTP.Types as H
6061
61−import qualified Data.Attoparsec.Text as Atto
62−import qualified Data.Attoparsec.Time as Atto
62+import qualified Data.Attoparsec.Text as Atto
63+import qualified Data.Attoparsec.Time as Atto
64+
65+import Web.Cookie (SetCookie, parseSetCookie,
66+ renderSetCookie)
6367
6468
6569-- $setup
@@ -530,6 +534,14 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
530534 toUrlPiece (Left x) = "left " <> toUrlPiece x
531535 toUrlPiece (Right x) = "right " <> toUrlPiece x
532536
537+-- |
538+-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
539+-- >>> toUrlPiece c
540+-- "\"SESSID=r2t5uvjq435r4q7ib3vtdjq120\""
541+instance ToHttpApiData SetCookie where
542+ toUrlPiece = showt . BS.toLazyByteString . renderSetCookie
543+ toEncodedUrlPiece = renderSetCookie
544+
533545-- |
534546-- >>> parseUrlPiece "_" :: Either Text ()
535547-- Right ()
@@ -664,6 +676,12 @@ instance FromHttpApiData a => FromHttpApiData (LenientData a) where
664676 parseHeader = Right . LenientData . parseHeader
665677 parseQueryParam = Right . LenientData . parseQueryParam
666678
679+-- |
680+-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
681+-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing})
682+instance FromHttpApiData SetCookie where
683+ parseUrlPiece = parseHeader . encodeUtf8
684+ parseHeader = Right . parseSetCookie
667685-------------------------------------------------------------------------------
668686-- Attoparsec helpers
669687-------------------------------------------------------------------------------