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