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