@@ -1,867 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFoldable #-}
5−{-# LANGUAGE DeriveFunctor #-}
6−{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE KindSignatures #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
12−{-# LANGUAGE TypeSynonymInstances #-}
13−-- |
14−-- Convert Haskell values to and from HTTP API data
15−-- such as URL pieces, headers and query parameters.
16−module Web.Internal.HttpApiData where
17−
18−import Prelude ()
19−import Prelude.Compat
20−
21−import Control.Applicative (Const(Const))
22−import Control.Arrow (left, (&&&))
23−import Control.Monad ((<=<))
24−import qualified Data.Attoparsec.Text as Atto
25−import qualified Data.Attoparsec.Time as Atto
26−import Data.ByteString (ByteString)
27−import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Builder as BS
29−import qualified Data.ByteString.Lazy as LBS
30−import Data.Coerce (coerce)
31−import Data.Data (Data)
32−import qualified Data.Fixed as F
33−import Data.Functor.Identity (Identity(Identity))
34−import Data.Int (Int16, Int32, Int64, Int8)
35−import Data.Kind (Type)
36−import qualified Data.Map as Map
37−import Data.Monoid (All (..), Any (..), Dual (..),
38− First (..), Last (..),
39− Product (..), Sum (..))
40−import Data.Semigroup (Semigroup (..))
41−import qualified Data.Semigroup as Semi
42−import Data.Tagged (Tagged (..))
43−import Data.Text (Text)
44−import qualified Data.Text as T
45−import Data.Text.Encoding (decodeUtf8', decodeUtf8With,
46− encodeUtf8)
47−import Data.Text.Encoding.Error (lenientDecode)
48−import qualified Data.Text.Lazy as L
49−import Data.Text.Read (Reader, decimal, rational,
50− signed)
51−import Data.Time.Compat (Day, FormatTime, LocalTime,
52− NominalDiffTime, TimeOfDay,
53− UTCTime, ZonedTime, formatTime,
54− DayOfWeek (..),
55− nominalDiffTimeToSeconds,
56− secondsToNominalDiffTime)
57−import Data.Time.Format.Compat (defaultTimeLocale,
58− iso8601DateFormat)
59−import Data.Time.Calendar.Month.Compat (Month)
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
61− toYearQuarter)
62−import Data.Typeable (Typeable)
63−import qualified Data.UUID.Types as UUID
64−import Data.Version (Version, parseVersion,
65− showVersion)
66−import Data.Void (Void, absurd)
67−import Data.Word (Word16, Word32, Word64, Word8)
68−import qualified Network.HTTP.Types as H
69−import Numeric.Natural (Natural)
70−import Text.ParserCombinators.ReadP (readP_to_S)
71−import Text.Read (readMaybe)
72−import Web.Cookie (SetCookie, parseSetCookie,
73− renderSetCookie)
74−
75−#if USE_TEXT_SHOW
76−import TextShow (TextShow, showt)
77−#endif
78−
79−-- $setup
80−-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
81−-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
82−-- >>> import Data.Time.Compat
83−-- >>> import Data.Version
84−
85−-- | Convert value to HTTP API data.
86−--
87−-- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated
88−-- instance will loop indefinitely.
89−class ToHttpApiData a where
90− {-# MINIMAL toUrlPiece | toQueryParam #-}
91− -- | Convert to URL path piece.
92− toUrlPiece :: a -> Text
93− toUrlPiece = toQueryParam
94−
95− -- | Convert to a URL path piece, making sure to encode any special chars.
96− -- The default definition uses 'H.encodePathSegmentsRelative',
97− -- but this may be overriden with a more efficient version.
98− toEncodedUrlPiece :: a -> BS.Builder
99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
100−
101− -- | Convert to HTTP header value.
102− toHeader :: a -> ByteString
103− toHeader = encodeUtf8 . toUrlPiece
104−
105− -- | Convert to query param value.
106− toQueryParam :: a -> Text
107− toQueryParam = toUrlPiece
108−
109−-- | Parse value from HTTP API data.
110−--
111−-- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated
112−-- instance will loop indefinitely.
113−class FromHttpApiData a where
114− {-# MINIMAL parseUrlPiece | parseQueryParam #-}
115− -- | Parse URL path piece.
116− parseUrlPiece :: Text -> Either Text a
117− parseUrlPiece = parseQueryParam
118−
119− -- | Parse HTTP header value.
120− parseHeader :: ByteString -> Either Text a
121− parseHeader = parseUrlPiece <=< (left (T.pack . show) . decodeUtf8')
122−
123− -- | Parse query param value.
124− parseQueryParam :: Text -> Either Text a
125− parseQueryParam = parseUrlPiece
126−
127−-- | Convert multiple values to a list of URL pieces.
128−--
129−-- >>> toUrlPieces [1, 2, 3] :: [Text]
130−-- ["1","2","3"]
131−toUrlPieces :: (Functor t, ToHttpApiData a) => t a -> t Text
132−toUrlPieces = fmap toUrlPiece
133−
134−-- | Parse multiple URL pieces.
135−--
136−-- >>> parseUrlPieces ["true", "false"] :: Either Text [Bool]
137−-- Right [True,False]
138−-- >>> parseUrlPieces ["123", "hello", "world"] :: Either Text [Int]
139−-- Left "could not parse: `hello' (input does not start with a digit)"
140−parseUrlPieces :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a)
141−parseUrlPieces = traverse parseUrlPiece
142−
143−-- | Convert multiple values to a list of query parameter values.
144−--
145−-- >>> toQueryParams [fromGregorian 2015 10 03, fromGregorian 2015 12 01] :: [Text]
146−-- ["2015-10-03","2015-12-01"]
147−toQueryParams :: (Functor t, ToHttpApiData a) => t a -> t Text
148−toQueryParams = fmap toQueryParam
149−
150−-- | Parse multiple query parameters.
151−--
152−-- >>> parseQueryParams ["1", "2", "3"] :: Either Text [Int]
153−-- Right [1,2,3]
154−-- >>> parseQueryParams ["64", "128", "256"] :: Either Text [Word8]
155−-- Left "out of bounds: `256' (should be between 0 and 255)"
156−parseQueryParams :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a)
157−parseQueryParams = traverse parseQueryParam
158−
159−-- | Parse URL path piece in a @'Maybe'@.
160−--
161−-- >>> parseUrlPieceMaybe "12" :: Maybe Int
162−-- Just 12
163−parseUrlPieceMaybe :: FromHttpApiData a => Text -> Maybe a
164−parseUrlPieceMaybe = either (const Nothing) Just . parseUrlPiece
165−
166−-- | Parse HTTP header value in a @'Maybe'@.
167−--
168−-- >>> parseHeaderMaybe "hello" :: Maybe Text
169−-- Just "hello"
170−parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a
171−parseHeaderMaybe = either (const Nothing) Just . parseHeader
172−
173−-- | Parse query param value in a @'Maybe'@.
174−--
175−-- >>> parseQueryParamMaybe "true" :: Maybe Bool
176−-- Just True
177−parseQueryParamMaybe :: FromHttpApiData a => Text -> Maybe a
178−parseQueryParamMaybe = either (const Nothing) Just . parseQueryParam
179−
180−-- | Default parsing error.
181−defaultParseError :: Text -> Either Text a
182−defaultParseError input = Left ("could not parse: `" <> input <> "'")
183−
184−-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
185−parseMaybeTextData :: (Text -> Maybe a) -> (Text -> Either Text a)
186−parseMaybeTextData parse input =
187− case parse input of
188− Nothing -> defaultParseError input
189− Just val -> Right val
190−
191−#if USE_TEXT_SHOW
192−-- | /Lower case/.
193−--
194−-- Convert to URL piece using @'TextShow'@ instance.
195−-- The result is always lower cased.
196−--
197−-- >>> showTextData True
198−-- "true"
199−--
200−-- This can be used as a default implementation for enumeration types:
201−--
202−-- @
203−-- data MyData = Foo | Bar | Baz deriving (Generic)
204−--
205−-- instance TextShow MyData where
206−-- showt = genericShowt
207−--
208−-- instance ToHttpApiData MyData where
209−-- toUrlPiece = showTextData
210−-- @
211−showTextData :: TextShow a => a -> Text
212−showTextData = T.toLower . showt
213−#else
214−-- | /Lower case/.
215−--
216−-- Convert to URL piece using @'Show'@ instance.
217−-- The result is always lower cased.
218−--
219−-- >>> showTextData True
220−-- "true"
221−--
222−-- This can be used as a default implementation for enumeration types:
223−--
224−-- >>> data MyData = Foo | Bar | Baz deriving (Show)
225−-- >>> instance ToHttpApiData MyData where toUrlPiece = showTextData
226−-- >>> toUrlPiece Foo
227−-- "foo"
228−showTextData :: Show a => a -> Text
229−showTextData = T.toLower . showt
230−
231−-- | Like @'show'@, but returns @'Text'@.
232−showt :: Show a => a -> Text
233−showt = T.pack . show
234−#endif
235−
236−-- | /Case insensitive/.
237−--
238−-- Parse given text case insensitive and then parse the rest of the input
239−-- using @'parseUrlPiece'@.
240−--
241−-- >>> parseUrlPieceWithPrefix "Just " "just 10" :: Either Text Int
242−-- Right 10
243−-- >>> parseUrlPieceWithPrefix "Left " "left" :: Either Text Bool
244−-- Left "could not parse: `left'"
245−--
246−-- This can be used to implement @'FromHttpApiData'@ for single field constructors:
247−--
248−-- >>> data Foo = Foo Int deriving (Show)
249−-- >>> instance FromHttpApiData Foo where parseUrlPiece s = Foo <$> parseUrlPieceWithPrefix "Foo " s
250−-- >>> parseUrlPiece "foo 1" :: Either Text Foo
251−-- Right (Foo 1)
252−parseUrlPieceWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a
253−parseUrlPieceWithPrefix pattern input
254− | T.toLower pattern == T.toLower prefix = parseUrlPiece rest
255− | otherwise = defaultParseError input
256− where
257− (prefix, rest) = T.splitAt (T.length pattern) input
258−
259−-- | Parse given bytestring then parse the rest of the input using @'parseHeader'@.
260−--
261−-- @
262−-- data BasicAuthToken = BasicAuthToken Text deriving (Show)
263−--
264−-- instance FromHttpApiData BasicAuthToken where
265−-- parseHeader h = BasicAuthToken \<$\> parseHeaderWithPrefix "Basic " h
266−-- parseQueryParam p = BasicAuthToken \<$\> parseQueryParam p
267−-- @
268−--
269−-- >>> parseHeader "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" :: Either Text BasicAuthToken
270−-- Right (BasicAuthToken "QWxhZGRpbjpvcGVuIHNlc2FtZQ==")
271−parseHeaderWithPrefix :: FromHttpApiData a => ByteString -> ByteString -> Either Text a
272−parseHeaderWithPrefix pattern input
273− | pattern `BS.isPrefixOf` input = parseHeader (BS.drop (BS.length pattern) input)
274− | otherwise = defaultParseError (showt input)
275−
276−-- | /Case insensitive/.
277−--
278−-- Parse given text case insensitive and then parse the rest of the input
279−-- using @'parseQueryParam'@.
280−--
281−-- >>> parseQueryParamWithPrefix "z" "z10" :: Either Text Int
282−-- Right 10
283−parseQueryParamWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a
284−parseQueryParamWithPrefix pattern input
285− | T.toLower pattern == T.toLower prefix = parseQueryParam rest
286− | otherwise = defaultParseError input
287− where
288− (prefix, rest) = T.splitAt (T.length pattern) input
289−
290−#if USE_TEXT_SHOW
291−-- | /Case insensitive/.
292−--
293−-- Parse values case insensitively based on @'TextShow'@ instance.
294−--
295−-- >>> parseBoundedTextData "true" :: Either Text Bool
296−-- Right True
297−-- >>> parseBoundedTextData "FALSE" :: Either Text Bool
298−-- Right False
299−--
300−-- This can be used as a default implementation for enumeration types:
301−--
302−-- @
303−-- data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum, Generic)
304−--
305−-- instance TextShow MyData where
306−-- showt = genericShowt
307−--
308−-- instance FromHttpApiData MyData where
309−-- parseUrlPiece = parseBoundedTextData
310−-- @
311−parseBoundedTextData :: (TextShow a, Bounded a, Enum a) => Text -> Either Text a
312−#else
313−-- | /Case insensitive/.
314−--
315−-- Parse values case insensitively based on @'Show'@ instance.
316−--
317−-- >>> parseBoundedTextData "true" :: Either Text Bool
318−-- Right True
319−-- >>> parseBoundedTextData "FALSE" :: Either Text Bool
320−-- Right False
321−--
322−-- This can be used as a default implementation for enumeration types:
323−--
324−-- >>> data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum)
325−-- >>> instance FromHttpApiData MyData where parseUrlPiece = parseBoundedTextData
326−-- >>> parseUrlPiece "foo" :: Either Text MyData
327−-- Right Foo
328−parseBoundedTextData :: (Show a, Bounded a, Enum a) => Text -> Either Text a
329−#endif
330−parseBoundedTextData = parseBoundedEnumOfI showTextData
331−
332−-- | Lookup values based on a precalculated mapping of their representations.
333−lookupBoundedEnumOf :: (Bounded a, Enum a, Eq b) => (a -> b) -> b -> Maybe a
334−lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
335−
336−-- | Parse values based on a precalculated mapping of their @'Text'@ representation.
337−--
338−-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
339−-- Right True
340−--
341−-- For case insensitive parser see 'parseBoundedEnumOfI'.
342−parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
343−parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
344−
345−-- | /Case insensitive/.
346−--
347−-- Parse values case insensitively based on a precalculated mapping
348−-- of their @'Text'@ representations.
349−--
350−-- >>> parseBoundedEnumOfI toUrlPiece "FALSE" :: Either Text Bool
351−-- Right False
352−--
353−-- For case sensitive parser see 'parseBoundedEnumOf'.
354−parseBoundedEnumOfI :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
355−parseBoundedEnumOfI f = parseBoundedEnumOf (T.toLower . f) . T.toLower
356−
357−-- | /Case insensitive/.
358−--
359−-- Parse values case insensitively based on @'ToHttpApiData'@ instance.
360−-- Uses @'toUrlPiece'@ to get possible values.
361−parseBoundedUrlPiece :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a
362−parseBoundedUrlPiece = parseBoundedEnumOfI toUrlPiece
363−
364−-- | /Case insensitive/.
365−--
366−-- Parse values case insensitively based on @'ToHttpApiData'@ instance.
367−-- Uses @'toQueryParam'@ to get possible values.
368−parseBoundedQueryParam :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a
369−parseBoundedQueryParam = parseBoundedEnumOfI toQueryParam
370−
371−-- | Parse values based on @'ToHttpApiData'@ instance.
372−-- Uses @'toHeader'@ to get possible values.
373−parseBoundedHeader :: (ToHttpApiData a, Bounded a, Enum a) => ByteString -> Either Text a
374−parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of
375− Nothing -> defaultParseError $ T.pack $ show bs
376− Just x -> return x
377−
378−-- | Parse URL piece using @'Read'@ instance.
379−--
380−-- Use for types which do not involve letters:
381−--
382−-- >>> readTextData "1991-06-02" :: Either Text Day
383−-- Right 1991-06-02
384−--
385−-- This parser is case sensitive and will not match @'showTextData'@
386−-- in presence of letters:
387−--
388−-- >>> readTextData (showTextData True) :: Either Text Bool
389−-- Left "could not parse: `true'"
390−--
391−-- See @'parseBoundedTextData'@.
392−readTextData :: Read a => Text -> Either Text a
393−readTextData = parseMaybeTextData (readMaybe . T.unpack)
394−
395−-- | Run @'Reader'@ as HTTP API data parser.
396−runReader :: Reader a -> Text -> Either Text a
397−runReader reader input =
398− case reader input of
399− Left err -> Left ("could not parse: `" <> input <> "' (" <> T.pack err <> ")")
400− Right (x, rest)
401− | T.null rest -> Right x
402− | otherwise -> defaultParseError input
403−
404−-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
405−--
406−-- >>> parseBounded decimal "256" :: Either Text Word8
407−-- Left "out of bounds: `256' (should be between 0 and 255)"
408−parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
409−parseBounded reader input = do
410− n <- runReader reader input
411− if (n > h || n < l)
412− then Left ("out of bounds: `" <> input <> "' (should be between " <> showt l <> " and " <> showt h <> ")")
413− else Right (fromInteger n)
414− where
415− l = toInteger (minBound :: a)
416− h = toInteger (maxBound :: a)
417−
418−-- | Convert to a URL-encoded path piece using 'toUrlPiece'.
419−-- /Note/: this function does not check if the result contains unescaped characters!
420−-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation
421−-- when the resulting URL piece /never/ has to be escaped.
422−unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder
423−unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece
424−
425−-- |
426−-- >>> toUrlPiece ()
427−-- "_"
428−instance ToHttpApiData () where
429− toUrlPiece () = "_"
430− toEncodedUrlPiece = unsafeToEncodedUrlPiece
431−
432−instance ToHttpApiData Char where
433− toUrlPiece = T.singleton
434−
435−-- |
436−-- >>> toUrlPiece (Version [1, 2, 3] [])
437−-- "1.2.3"
438−instance ToHttpApiData Version where
439− toUrlPiece = T.pack . showVersion
440− toEncodedUrlPiece = unsafeToEncodedUrlPiece
441−
442−instance ToHttpApiData Void where toUrlPiece = absurd
443−instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
444−
445−instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
446−instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
447−
448−instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
449−instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
450−instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
451−instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
452−instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
453−instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
454−instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
455−instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
456−instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
457−instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
458−instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
459−instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
460−instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
461−
462−-- | Note: this instance is not polykinded
463−instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
464−
465−-- |
466−-- >>> toUrlPiece (fromGregorian 2015 10 03)
467−-- "2015-10-03"
468−instance ToHttpApiData Day where
469− toUrlPiece = T.pack . show
470− toEncodedUrlPiece = unsafeToEncodedUrlPiece
471−
472−timeToUrlPiece :: FormatTime t => String -> t -> Text
473−timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
474−
475−-- |
476−-- >>> toUrlPiece $ TimeOfDay 14 55 23.1
477−-- "14:55:23.1"
478−instance ToHttpApiData TimeOfDay where
479− toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"
480− toEncodedUrlPiece = unsafeToEncodedUrlPiece
481−
482−-- |
483−-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687)
484−-- "2015-10-03T14:55:21.687"
485−instance ToHttpApiData LocalTime where
486− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"
487− toEncodedUrlPiece = unsafeToEncodedUrlPiece
488−
489−-- |
490−-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc
491−-- "2015-10-03T14:55:51.001+0000"
492−instance ToHttpApiData ZonedTime where
493− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"
494− toEncodedUrlPiece = unsafeToEncodedUrlPiece
495−
496−-- |
497−-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5
498−-- "2015-10-03T00:14:24.5Z"
499−instance ToHttpApiData UTCTime where
500− toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
501− toEncodedUrlPiece = unsafeToEncodedUrlPiece
502−
503−-- |
504−-- >>> toUrlPiece Monday
505−-- "monday"
506−instance ToHttpApiData DayOfWeek where
507− toUrlPiece Monday = "monday"
508− toUrlPiece Tuesday = "tuesday"
509− toUrlPiece Wednesday = "wednesday"
510− toUrlPiece Thursday = "thursday"
511− toUrlPiece Friday = "friday"
512− toUrlPiece Saturday = "saturday"
513− toUrlPiece Sunday = "sunday"
514−
515− toEncodedUrlPiece = unsafeToEncodedUrlPiece
516−
517−-- |
518−-- >>> toUrlPiece Q4
519−-- "q4"
520−instance ToHttpApiData QuarterOfYear where
521− toUrlPiece Q1 = "q1"
522− toUrlPiece Q2 = "q2"
523− toUrlPiece Q3 = "q3"
524− toUrlPiece Q4 = "q4"
525−
526−-- |
527−-- >>> import Data.Time.Calendar.Quarter.Compat (Quarter (..))
528−-- >>> MkQuarter 8040
529−-- 2010-Q1
530−--
531−-- >>> toUrlPiece $ MkQuarter 8040
532−-- "2010-q1"
533−--
534−instance ToHttpApiData Quarter where
535− toUrlPiece q = case toYearQuarter q of
536− (y, qoy) -> T.pack (show y ++ "-" ++ f qoy)
537− where
538− f Q1 = "q1"
539− f Q2 = "q2"
540− f Q3 = "q3"
541− f Q4 = "q4"
542−
543−-- |
544−-- >>> import Data.Time.Calendar.Month.Compat (Month (..))
545−-- >>> MkMonth 24482
546−-- 2040-03
547−--
548−-- >>> toUrlPiece $ MkMonth 24482
549−-- "2040-03"
550−--
551−instance ToHttpApiData Month where
552− toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"
553−
554−instance ToHttpApiData NominalDiffTime where
555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
556− toEncodedUrlPiece = unsafeToEncodedUrlPiece
557−
558−instance ToHttpApiData String where toUrlPiece = T.pack
559−instance ToHttpApiData Text where toUrlPiece = id
560−instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
561−
562−instance ToHttpApiData All where
563− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
564− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
565−
566−instance ToHttpApiData Any where
567− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
568− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
569−
570−instance ToHttpApiData a => ToHttpApiData (Dual a) where
571− toUrlPiece = coerce (toUrlPiece :: a -> Text)
572− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
573−
574−instance ToHttpApiData a => ToHttpApiData (Sum a) where
575− toUrlPiece = coerce (toUrlPiece :: a -> Text)
576− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
577−
578−instance ToHttpApiData a => ToHttpApiData (Product a) where
579− toUrlPiece = coerce (toUrlPiece :: a -> Text)
580− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
581−
582−instance ToHttpApiData a => ToHttpApiData (First a) where
583− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
584− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
585−
586−instance ToHttpApiData a => ToHttpApiData (Last a) where
587− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
588− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
589−
590−instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where
591− toUrlPiece = coerce (toUrlPiece :: a -> Text)
592− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
593−
594−instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where
595− toUrlPiece = coerce (toUrlPiece :: a -> Text)
596− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
597−
598−instance ToHttpApiData a => ToHttpApiData (Semi.First a) where
599− toUrlPiece = coerce (toUrlPiece :: a -> Text)
600− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
601−
602−instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where
603− toUrlPiece = coerce (toUrlPiece :: a -> Text)
604− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
605−
606−-- |
607−-- >>> toUrlPiece (Just "Hello")
608−-- "just Hello"
609−instance ToHttpApiData a => ToHttpApiData (Maybe a) where
610− toUrlPiece (Just x) = "just " <> toUrlPiece x
611− toUrlPiece Nothing = "nothing"
612−
613−-- |
614−-- >>> toUrlPiece (Left "err" :: Either String Int)
615−-- "left err"
616−-- >>> toUrlPiece (Right 3 :: Either String Int)
617−-- "right 3"
618−instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
619− toUrlPiece (Left x) = "left " <> toUrlPiece x
620− toUrlPiece (Right x) = "right " <> toUrlPiece x
621−
622−-- | /Note:/ this instance works correctly for alphanumeric name and value
623−--
624−-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
625−-- >>> toUrlPiece c
626−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"
627−--
628−-- >>> toHeader c
629−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"
630−--
631−instance ToHttpApiData SetCookie where
632− toUrlPiece = decodeUtf8With lenientDecode . toHeader
633− toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
634− -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
635−
636−-- | Note: this instance is not polykinded
637−instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where
638− toUrlPiece = coerce (toUrlPiece :: a -> Text)
639− toHeader = coerce (toHeader :: a -> ByteString)
640− toQueryParam = coerce (toQueryParam :: a -> Text)
641− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
642−
643−-- | @since 0.4.2
644−instance ToHttpApiData a => ToHttpApiData (Const a b) where
645− toUrlPiece = coerce (toUrlPiece :: a -> Text)
646− toHeader = coerce (toHeader :: a -> ByteString)
647− toQueryParam = coerce (toQueryParam :: a -> Text)
648− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
649−
650−-- | @since 0.4.2
651−instance ToHttpApiData a => ToHttpApiData (Identity a) where
652− toUrlPiece = coerce (toUrlPiece :: a -> Text)
653− toHeader = coerce (toHeader :: a -> ByteString)
654− toQueryParam = coerce (toQueryParam :: a -> Text)
655− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
656−
657−-- |
658−-- >>> parseUrlPiece "_" :: Either Text ()
659−-- Right ()
660−instance FromHttpApiData () where
661− parseUrlPiece "_" = pure ()
662− parseUrlPiece s = defaultParseError s
663−
664−instance FromHttpApiData Char where
665− parseUrlPiece s =
666− case T.uncons s of
667− Just (c, s') | T.null s' -> pure c
668− _ -> defaultParseError s
669−
670−-- |
671−-- >>> showVersion <$> parseUrlPiece "1.2.3"
672−-- Right "1.2.3"
673−instance FromHttpApiData Version where
674− parseUrlPiece s =
675− case reverse (readP_to_S parseVersion (T.unpack s)) of
676− ((x, ""):_) -> pure x
677− _ -> defaultParseError s
678−
679−-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
680−instance FromHttpApiData Void where
681− parseUrlPiece _ = Left "Void cannot be parsed!"
682−
683−instance FromHttpApiData Natural where
684− parseUrlPiece s = do
685− n <- runReader (signed decimal) s
686− if n < 0
687− then Left ("underflow: " <> s <> " (should be a non-negative integer)")
688− else Right (fromInteger n)
689−
690−instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
691−instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
692−instance FromHttpApiData Double where parseUrlPiece = runReader rational
693−instance FromHttpApiData Float where parseUrlPiece = runReader rational
694−instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal)
695−instance FromHttpApiData Int8 where parseUrlPiece = parseBounded (signed decimal)
696−instance FromHttpApiData Int16 where parseUrlPiece = parseBounded (signed decimal)
697−instance FromHttpApiData Int32 where parseUrlPiece = parseBounded (signed decimal)
698−instance FromHttpApiData Int64 where parseUrlPiece = parseBounded (signed decimal)
699−instance FromHttpApiData Integer where parseUrlPiece = runReader (signed decimal)
700−instance FromHttpApiData Word where parseUrlPiece = parseBounded decimal
701−instance FromHttpApiData Word8 where parseUrlPiece = parseBounded decimal
702−instance FromHttpApiData Word16 where parseUrlPiece = parseBounded decimal
703−instance FromHttpApiData Word32 where parseUrlPiece = parseBounded decimal
704−instance FromHttpApiData Word64 where parseUrlPiece = parseBounded decimal
705−instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706−instance FromHttpApiData Text where parseUrlPiece = Right
707−instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
708−
709−-- | Note: this instance is not polykinded
710−instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where
711− parseUrlPiece = runReader rational
712−
713−-- |
714−-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
715−-- Right (2016,12,1)
716−instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day
717−
718−-- |
719−-- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay
720−-- Right 14:55:01.333
721−instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay
722−
723−-- |
724−-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
725−-- Right 2015-10-03 14:55:01
726−instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime
727−
728−-- |
729−-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
730−-- Right 2015-10-03 14:55:01 +0000
731−--
732−-- >>> parseQueryParam "2016-12-31T01:00:00Z" :: Either Text ZonedTime
733−-- Right 2016-12-31 01:00:00 +0000
734−instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
735−
736−-- |
737−-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
738−-- Right 2015-10-03 00:14:24 UTC
739−instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
740−
741−-- |
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
743−-- Right Monday
744−instance FromHttpApiData DayOfWeek where
745− parseUrlPiece t = case Map.lookup (T.toLower t) m of
746− Just dow -> Right dow
747− Nothing -> Left $ "Incorrect DayOfWeek: " <> T.take 10 t
748− where
749− m :: Map.Map Text DayOfWeek
750− m = Map.fromList [ (toUrlPiece dow, dow) | dow <- [Monday .. Sunday] ]
751−
752−
753−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
754−
755−-- |
756−-- >>> parseUrlPiece "2021-01" :: Either Text Month
757−-- Right 2021-01
758−instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month
759−
760−-- |
761−-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter
762−-- Right 2021-Q1
763−instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter
764−
765−-- |
766−-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear
767−-- Right Q2
768−--
769−-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear
770−-- Right Q3
771−instance FromHttpApiData QuarterOfYear where
772− parseUrlPiece t = case T.toLower t of
773− "q1" -> return Q1
774− "q2" -> return Q2
775− "q3" -> return Q3
776− "q4" -> return Q4
777− _ -> Left "Invalid quarter of year"
778−
779−instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
780−instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
781−
782−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
783−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
784−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
785−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
786−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
787−
788−instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
789−instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
790−instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
791−instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
792−
793−-- |
794−-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
795−-- Right (Just 123)
796−instance FromHttpApiData a => FromHttpApiData (Maybe a) where
797− parseUrlPiece s
798− | T.toLower (T.take 7 s) == "nothing" = pure Nothing
799− | otherwise = Just <$> parseUrlPieceWithPrefix "Just " s
800−
801−-- |
802−-- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int)
803−-- Right (Right 123)
804−instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where
805− parseUrlPiece s =
806− Right <$> parseUrlPieceWithPrefix "Right " s
807− <!> Left <$> parseUrlPieceWithPrefix "Left " s
808− where
809− infixl 3 <!>
810− Left _ <!> y = y
811− x <!> _ = x
812−
813−instance ToHttpApiData UUID.UUID where
814− toUrlPiece = UUID.toText
815− toHeader = UUID.toASCIIBytes
816− toEncodedUrlPiece = unsafeToEncodedUrlPiece
817−
818−instance FromHttpApiData UUID.UUID where
819− parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
820− parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
821−
822−
823−-- | Lenient parameters. 'FromHttpApiData' combinators always return `Right`.
824−--
825−-- @since 0.3.5
826−newtype LenientData a = LenientData { getLenientData :: Either Text a }
827− deriving (Eq, Ord, Show, Read, Typeable, Data, Functor, Foldable, Traversable)
828−
829−instance FromHttpApiData a => FromHttpApiData (LenientData a) where
830− parseUrlPiece = Right . LenientData . parseUrlPiece
831− parseHeader = Right . LenientData . parseHeader
832− parseQueryParam = Right . LenientData . parseQueryParam
833−
834−-- | /Note:/ this instance works correctly for alphanumeric name and value
835−--
836−-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
837−-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing})
838−instance FromHttpApiData SetCookie where
839− parseUrlPiece = parseHeader . encodeUtf8
840− parseHeader = Right . parseSetCookie
841−
842−-- | Note: this instance is not polykinded
843−instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where
844− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
845− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
846− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
847−
848−-- | @since 0.4.2
849−instance FromHttpApiData a => FromHttpApiData (Const a b) where
850− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
851− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
852− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
853−
854−-- | @since 0.4.2
855−instance FromHttpApiData a => FromHttpApiData (Identity a) where
856− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
857− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
858− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
859−
860−-------------------------------------------------------------------------------
861−-- Attoparsec helpers
862−-------------------------------------------------------------------------------
863−
864−runAtto :: Atto.Parser a -> Text -> Either Text a
865−runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
866− Left err -> Left (T.pack err)
867− Right x -> Right x