{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Libjwt.Classes
( JwtRep(..)
, JsonBuilder(..)
, JsonParser(..)
, JsonToken(..)
)
where
import Libjwt.ASCII
import Libjwt.FFI.Jwt ( JsonToken(..) )
import Libjwt.Flag
import Libjwt.JsonByteString
import Libjwt.NumericDate
import Control.Monad ( guard
, (<=<)
)
import Control.Monad.Zip ( mzip )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as Word8
import Data.ByteString.Builder ( Builder
, char7
, byteString
, intDec
, int64Dec
, string7
, charUtf8
)
import Data.ByteString.Builder.Extra ( toLazyByteStringWith
, safeStrategy
)
import Data.ByteString.Builder.Prim ( (>*<)
, condB
, (>$<)
, liftFixedToBounded
)
import qualified Data.ByteString.Builder.Prim as E
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Lazy.Char8 as Lazy8
import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8
import qualified Data.ByteString.UTF8 as UTF8
import Data.Char ( ord
, digitToInt
, chr
)
import Data.Coerce ( coerce )
import Data.Either.Extra ( eitherToMaybe )
import Data.List ( intersperse )
import Data.List.NonEmpty ( NonEmpty )
import qualified Data.List.NonEmpty as NEL
import Data.Maybe ( fromJust )
import Data.Text ( Text )
import qualified Data.Text.Encoding as Text
import Data.Text.Lazy ( toStrict )
import qualified Data.Text.Lazy.Encoding as LazyText
import Data.Time.Calendar ( Day )
import Data.Time.Clock
import Data.Time.Format.ISO8601
import Data.Time.LocalTime
import Data.UUID ( UUID )
import qualified Data.UUID as UUID
import Data.Word ( Word16
, Word8
)
class JwtRep a b | b -> a where
rep :: b -> a
unRep :: a -> Maybe b
instance JwtRep ByteString String where
rep :: String -> ByteString
rep = String -> ByteString
UTF8.fromString
unRep :: ByteString -> Maybe String
unRep = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toString
instance JwtRep ByteString ASCII where
rep :: ASCII -> ByteString
rep = String -> ByteString
Char8.pack (String -> ByteString) -> (ASCII -> String) -> ASCII -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
coerce
unRep :: ByteString -> Maybe ASCII
unRep = Maybe String -> Maybe ASCII
coerce (Maybe String -> Maybe ASCII)
-> (ByteString -> Maybe String) -> ByteString -> Maybe ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Char8.unpack
instance JwtRep ByteString UUID where
rep :: UUID -> ByteString
rep = UUID -> ByteString
UUID.toASCIIBytes
unRep :: ByteString -> Maybe UUID
unRep = ByteString -> Maybe UUID
UUID.fromASCIIBytes
encodeAsIso8601 :: (ISO8601 t) => t -> ASCII
encodeAsIso8601 :: t -> ASCII
encodeAsIso8601 = String -> ASCII
ASCII (String -> ASCII) -> (t -> String) -> t -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t. ISO8601 t => t -> String
iso8601Show
decodeFromISO8601 :: (ISO8601 t) => ASCII -> Maybe t
decodeFromISO8601 :: ASCII -> Maybe t
decodeFromISO8601 = String -> Maybe t
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe t) -> (ASCII -> String) -> ASCII -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
getASCII
instance JwtRep ASCII UTCTime where
rep :: UTCTime -> ASCII
rep = UTCTime -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
unRep :: ASCII -> Maybe UTCTime
unRep = ASCII -> Maybe UTCTime
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601
instance JwtRep ASCII ZonedTime where
rep :: ZonedTime -> ASCII
rep = ZonedTime -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
unRep :: ASCII -> Maybe ZonedTime
unRep = ASCII -> Maybe ZonedTime
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601
instance JwtRep ASCII LocalTime where
rep :: LocalTime -> ASCII
rep = LocalTime -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
unRep :: ASCII -> Maybe LocalTime
unRep = ASCII -> Maybe LocalTime
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601
instance JwtRep ASCII Day where
rep :: Day -> ASCII
rep = Day -> ASCII
forall t. ISO8601 t => t -> ASCII
encodeAsIso8601
unRep :: ASCII -> Maybe Day
unRep = ASCII -> Maybe Day
forall t. ISO8601 t => ASCII -> Maybe t
decodeFromISO8601
instance JwtRep ByteString Text where
rep :: Text -> ByteString
rep = Text -> ByteString
Text.encodeUtf8
unRep :: ByteString -> Maybe Text
unRep = Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
Text.decodeUtf8'
instance JwtRep [a] (NonEmpty a) where
rep :: NonEmpty a -> [a]
rep = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NEL.toList
unRep :: [a] -> Maybe (NonEmpty a)
unRep = [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
instance AFlag a => JwtRep ASCII (Flag a) where
rep :: Flag a -> ASCII
rep = Flag a -> ASCII
forall a. AFlag a => a -> ASCII
getFlagValue
unRep :: ASCII -> Maybe (Flag a)
unRep = ASCII -> Maybe (Flag a)
forall a. AFlag a => ASCII -> Maybe a
setFlagValue
class JsonBuilder t where
jsonBuilder :: t -> Builder
default jsonBuilder :: (JwtRep a t, JsonBuilder a) => t -> Builder
jsonBuilder = a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder (a -> Builder) -> (t -> a) -> t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> a
forall a b. JwtRep a b => b -> a
rep
instance JsonBuilder ByteString where
jsonBuilder :: ByteString -> Builder
jsonBuilder = (BoundedPrim Word8 -> ByteString -> Builder)
-> ByteString -> Builder
forall a. (BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords BoundedPrim Word8 -> ByteString -> Builder
E.primMapByteStringBounded
instance JsonBuilder Bool where
jsonBuilder :: Bool -> Builder
jsonBuilder Bool
True = Builder
"true"
jsonBuilder Bool
False = Builder
"false"
instance JsonBuilder Int where
jsonBuilder :: Int -> Builder
jsonBuilder = Int -> Builder
intDec
instance JsonBuilder NumericDate where
jsonBuilder :: NumericDate -> Builder
jsonBuilder = Int64 -> Builder
int64Dec (Int64 -> Builder)
-> (NumericDate -> Int64) -> NumericDate -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericDate -> Int64
coerce
instance {-# OVERLAPPING #-} JsonBuilder String where
jsonBuilder :: String -> Builder
jsonBuilder = BoundedPrim Char -> String -> Builder
optimizedEscapeString BoundedPrim Char
E.charUtf8
instance JsonBuilder ASCII where
jsonBuilder :: ASCII -> Builder
jsonBuilder = BoundedPrim Char -> String -> Builder
optimizedEscapeString (FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Char
E.char7) (String -> Builder) -> (ASCII -> String) -> ASCII -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
getASCII
instance JsonBuilder Text where
jsonBuilder :: Text -> Builder
jsonBuilder = (BoundedPrim Word8 -> Text -> Builder) -> Text -> Builder
forall a. (BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords BoundedPrim Word8 -> Text -> Builder
Text.encodeUtf8BuilderEscaped
instance JsonBuilder UUID where
jsonBuilder :: UUID -> Builder
jsonBuilder = Builder -> Builder
quoteString (Builder -> Builder) -> (UUID -> Builder) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteString (ByteString -> Builder) -> (UUID -> ByteString) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes
iso8601Builder :: (ISO8601 t) => t -> Builder
iso8601Builder :: t -> Builder
iso8601Builder = Builder -> Builder
quoteString (Builder -> Builder) -> (t -> Builder) -> t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
string7 (String -> Builder) -> (t -> String) -> t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t. ISO8601 t => t -> String
iso8601Show
instance JsonBuilder UTCTime where
jsonBuilder :: UTCTime -> Builder
jsonBuilder = UTCTime -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder
instance JsonBuilder LocalTime where
jsonBuilder :: LocalTime -> Builder
jsonBuilder = LocalTime -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder
instance JsonBuilder ZonedTime where
jsonBuilder :: ZonedTime -> Builder
jsonBuilder = ZonedTime -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder
instance JsonBuilder Day where
jsonBuilder :: Day -> Builder
jsonBuilder = Day -> Builder
forall t. ISO8601 t => t -> Builder
iso8601Builder
instance AFlag a => JsonBuilder (Flag a) where
jsonBuilder :: Flag a -> Builder
jsonBuilder = Builder -> Builder
quoteString (Builder -> Builder) -> (Flag a -> Builder) -> Flag a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
string7 (String -> Builder) -> (Flag a -> String) -> Flag a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
getASCII (ASCII -> String) -> (Flag a -> ASCII) -> Flag a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> ASCII
forall a. AFlag a => a -> ASCII
getFlagValue
instance JsonBuilder JsonByteString where
jsonBuilder :: JsonByteString -> Builder
jsonBuilder = JsonByteString -> Builder
toJsonBuilder
instance JsonBuilder a => JsonBuilder [a] where
jsonBuilder :: [a] -> Builder
jsonBuilder = [a] -> Builder
forall a. JsonBuilder a => [a] -> Builder
encodeArray
instance JsonBuilder a => JsonBuilder (Maybe a) where
jsonBuilder :: Maybe a -> Builder
jsonBuilder Maybe a
Nothing = Builder
"null"
jsonBuilder (Just a
a) = a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder a
a
instance (JsonBuilder a, JsonBuilder b) => JsonBuilder (a, b) where
jsonBuilder :: (a, b) -> Builder
jsonBuilder (a
a, b
b) =
Builder -> Builder
arrayBrackets (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder b
b
encodeArray :: JsonBuilder a => [a] -> Builder
encodeArray :: [a] -> Builder
encodeArray =
Builder -> Builder
arrayBrackets (Builder -> Builder) -> ([a] -> Builder) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
char7 Char
',') ([Builder] -> [Builder]) -> ([a] -> [Builder]) -> [a] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall t. JsonBuilder t => t -> Builder
jsonBuilder
arrayBrackets :: Builder -> Builder
arrayBrackets :: Builder -> Builder
arrayBrackets Builder
bs = Char -> Builder
char7 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
']'
quoteString :: Builder -> Builder
quoteString :: Builder -> Builder
quoteString Builder
bs = Char -> Builder
char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'
optimizedEscapeWords :: (E.BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords :: (BoundedPrim Word8 -> a -> Builder) -> a -> Builder
optimizedEscapeWords BoundedPrim Word8 -> a -> Builder
f = Builder -> Builder
quoteString (Builder -> Builder) -> (a -> Builder) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> a -> Builder
f
( (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'\\'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'"'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
32) (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Word8
E.word8)
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'r'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
12) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'f'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'n'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
't'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
8) ((Char, Char) -> BoundedPrim Word8
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'b'))
(BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded
(FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Word8 -> Word16) -> FixedPrim Word16 -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
uEscape
)
optimizedEscapeString :: E.BoundedPrim Char -> String -> Builder
optimizedEscapeString :: BoundedPrim Char -> String -> Builder
optimizedEscapeString BoundedPrim Char
enc = Builder -> Builder
quoteString (Builder -> Builder) -> (String -> Builder) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Char -> String -> Builder
forall a. BoundedPrim a -> [a] -> Builder
E.primMapListBounded BoundedPrim Char
escape
where
escape :: BoundedPrim Char
escape =
(Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'\\'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'"'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' ') BoundedPrim Char
enc
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'r'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\f') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'f'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'n'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
't'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\b') ((Char, Char) -> BoundedPrim Char
forall b. (Char, Char) -> BoundedPrim b
fixed2 (Char
'\\', Char
'b'))
(BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded
(FixedPrim Char -> BoundedPrim Char)
-> FixedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (Char -> Int) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
(Char -> Word16) -> FixedPrim Word16 -> FixedPrim Char
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
uEscape
class JsonParser a where
jsonParser :: JsonToken -> Maybe a
default jsonParser :: (JwtRep t a, JsonParser t) => JsonToken -> Maybe a
jsonParser = t -> Maybe a
forall a b. JwtRep a b => a -> Maybe b
unRep (t -> Maybe a) -> (JsonToken -> Maybe t) -> JsonToken -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JsonToken -> Maybe t
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser
instance JsonParser ByteString where
jsonParser :: JsonToken -> Maybe ByteString
jsonParser (JsStr ByteString
bs) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> ByteString
Lazy.toStrict ByteString -> ByteString
forall a. a -> a
id ByteString
bs
jsonParser JsonToken
_ = Maybe ByteString
forall a. Maybe a
Nothing
instance JsonParser Bool where
jsonParser :: JsonToken -> Maybe Bool
jsonParser JsonToken
JsTrue = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
jsonParser JsonToken
JsFalse = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
jsonParser JsonToken
_ = Maybe Bool
forall a. Maybe a
Nothing
instance JsonParser Int where
jsonParser :: JsonToken -> Maybe Int
jsonParser (JsNum ByteString
bs) = do
(Int
int, ByteString
remainder) <- ByteString -> Maybe (Int, ByteString)
Char8.readInt ByteString
bs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
Char8.null ByteString
remainder
Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
int
jsonParser JsonToken
_ = Maybe Int
forall a. Maybe a
Nothing
instance {-# OVERLAPPING #-} JsonParser String where
jsonParser :: JsonToken -> Maybe String
jsonParser (JsStr ByteString
bs) =
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (ByteString -> String)
-> (ByteString -> String) -> ByteString -> String
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> String
LazyUTF8.toString ByteString -> String
UTF8.toString ByteString
bs
jsonParser JsonToken
_ = Maybe String
forall a. Maybe a
Nothing
instance JsonParser ASCII where
jsonParser :: JsonToken -> Maybe ASCII
jsonParser (JsStr ByteString
bs) =
ASCII -> Maybe ASCII
forall a. a -> Maybe a
Just (ASCII -> Maybe ASCII) -> ASCII -> Maybe ASCII
forall a b. (a -> b) -> a -> b
$ String -> ASCII
coerce (String -> ASCII) -> String -> ASCII
forall a b. (a -> b) -> a -> b
$ (ByteString -> String)
-> (ByteString -> String) -> ByteString -> String
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> String
Lazy8.unpack ByteString -> String
Char8.unpack ByteString
bs
jsonParser JsonToken
_ = Maybe ASCII
forall a. Maybe a
Nothing
instance JsonParser Text where
jsonParser :: JsonToken -> Maybe Text
jsonParser (JsStr ByteString
bs) = Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> Either UnicodeException Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either UnicodeException Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either UnicodeException Text
forall a. (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString
((Text -> Text)
-> Either UnicodeException Text -> Either UnicodeException Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toStrict (Either UnicodeException Text -> Either UnicodeException Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
LazyText.decodeUtf8')
ByteString -> Either UnicodeException Text
Text.decodeUtf8'
ByteString
bs
jsonParser JsonToken
_ = Maybe Text
forall a. Maybe a
Nothing
instance JsonParser NumericDate where
jsonParser :: JsonToken -> Maybe NumericDate
jsonParser (JsNum ByteString
bs) = do
(Integer
int, ByteString
remainder) <- ByteString -> Maybe (Integer, ByteString)
Char8.readInteger ByteString
bs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
Char8.null ByteString
remainder
NumericDate -> Maybe NumericDate
forall (m :: * -> *) a. Monad m => a -> m a
return (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ Int64 -> NumericDate
NumericDate (Int64 -> NumericDate) -> Int64 -> NumericDate
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
int
jsonParser JsonToken
_ = Maybe NumericDate
forall a. Maybe a
Nothing
instance JsonParser UUID where
jsonParser :: JsonToken -> Maybe UUID
jsonParser (JsStr ByteString
bs) = ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
bs
jsonParser JsonToken
_ = Maybe UUID
forall a. Maybe a
Nothing
iso8601Parser :: ISO8601 t => JsonToken -> Maybe t
iso8601Parser :: JsonToken -> Maybe t
iso8601Parser (JsStr ByteString
bs) = String -> Maybe t
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe t) -> String -> Maybe t
forall a b. (a -> b) -> a -> b
$ ByteString -> String
Char8.unpack ByteString
bs
iso8601Parser JsonToken
_ = Maybe t
forall a. Maybe a
Nothing
instance JsonParser UTCTime where
jsonParser :: JsonToken -> Maybe UTCTime
jsonParser = JsonToken -> Maybe UTCTime
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser
instance JsonParser LocalTime where
jsonParser :: JsonToken -> Maybe LocalTime
jsonParser = JsonToken -> Maybe LocalTime
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser
instance JsonParser ZonedTime where
jsonParser :: JsonToken -> Maybe ZonedTime
jsonParser = JsonToken -> Maybe ZonedTime
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser
instance JsonParser Day where
jsonParser :: JsonToken -> Maybe Day
jsonParser = JsonToken -> Maybe Day
forall t. ISO8601 t => JsonToken -> Maybe t
iso8601Parser
instance AFlag a => JsonParser (Flag a) where
jsonParser :: JsonToken -> Maybe (Flag a)
jsonParser (JsStr ByteString
bs) = ASCII -> Maybe (Flag a)
forall a. AFlag a => ASCII -> Maybe a
setFlagValue (ASCII -> Maybe (Flag a)) -> ASCII -> Maybe (Flag a)
forall a b. (a -> b) -> a -> b
$ String -> ASCII
ASCII (String -> ASCII) -> String -> ASCII
forall a b. (a -> b) -> a -> b
$ ByteString -> String
Char8.unpack ByteString
bs
jsonParser JsonToken
_ = Maybe (Flag a)
forall a. Maybe a
Nothing
instance JsonParser JsonByteString where
jsonParser :: JsonToken -> Maybe JsonByteString
jsonParser (JsBlob ByteString
bs) = JsonByteString -> Maybe JsonByteString
forall a. a -> Maybe a
Just (JsonByteString -> Maybe JsonByteString)
-> JsonByteString -> Maybe JsonByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> JsonByteString
jsonFromStrict ByteString
bs
jsonParser JsonToken
_ = Maybe JsonByteString
forall a. Maybe a
Nothing
instance JsonParser a => JsonParser [a] where
jsonParser :: JsonToken -> Maybe [a]
jsonParser (JsArray [JsonToken]
as) = (JsonToken -> Maybe a) -> [JsonToken] -> Maybe [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse JsonToken -> Maybe a
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser [JsonToken]
as
jsonParser JsonToken
_ = Maybe [a]
forall a. Maybe a
Nothing
instance JsonParser a => JsonParser (Maybe a) where
jsonParser :: JsonToken -> Maybe (Maybe a)
jsonParser JsonToken
JsNull = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
jsonParser JsonToken
a' = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonToken -> Maybe a
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser JsonToken
a'
instance (JsonParser a, JsonParser b) => JsonParser (a, b) where
jsonParser :: JsonToken -> Maybe (a, b)
jsonParser (JsArray [JsonToken
a', JsonToken
b']) = Maybe a -> Maybe b -> Maybe (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip (JsonToken -> Maybe a
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser JsonToken
a') (JsonToken -> Maybe b
forall a. JsonParser a => JsonToken -> Maybe a
jsonParser JsonToken
b')
jsonParser JsonToken
_ = Maybe (a, b)
forall a. Maybe a
Nothing
withUnescapedString
:: (Lazy.ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString :: (ByteString -> a) -> (ByteString -> a) -> ByteString -> a
withUnescapedString ByteString -> a
lazy ByteString -> a
strict ByteString
bs = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
Word8.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) ByteString
bs of
(ByteString
x, ByteString
y)
| ByteString -> Bool
Word8.null ByteString
y -> ByteString -> a
strict ByteString
x
| Bool
otherwise -> ByteString -> a
lazy
(ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith AllocationStrategy
allocationStrategy ByteString
forall a. Monoid a => a
mempty (ByteString -> Builder
byteString ByteString
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
go0 ByteString
y)
where
go0 :: ByteString -> Builder
go0 ByteString
ws = case Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Word8, ByteString)
Word8.uncons ByteString
rest of
(Word8
h, ByteString
tl)
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
117
-> let (ByteString
hex, ByteString
tl') = Int -> ByteString -> (ByteString, ByteString)
Word8.splitAt Int
4 ByteString
tl
in Char -> Builder
charUtf8 (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
hexValue ByteString
hex) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl'
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
116
-> Char -> Builder
char7 Char
'\t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
114
-> Char -> Builder
char7 Char
'\r' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
110
-> Char -> Builder
char7 Char
'\n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
102
-> Char -> Builder
char7 Char
'\f' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
98
-> Char -> Builder
char7 Char
'\b' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
| Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92
-> Char -> Builder
char7 Char
'\\' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
builder ByteString
tl
| Bool
otherwise
-> ByteString -> Builder
go1 ByteString
rest
where
rest :: ByteString
rest = ByteString -> ByteString
Word8.tail ByteString
ws
builder :: ByteString -> Builder
builder ByteString
b = case ByteString -> Maybe (Word8, ByteString)
Word8.uncons ByteString
b of
Maybe (Word8, ByteString)
Nothing -> Builder
forall a. Monoid a => a
mempty
Just (Word8
h, ByteString
_) | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92 -> ByteString -> Builder
go0 ByteString
b
| Bool
otherwise -> ByteString -> Builder
go1 ByteString
b
go1 :: ByteString -> Builder
go1 ByteString
ws = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
Word8.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
92) ByteString
ws of
(ByteString
x, ByteString
y) | ByteString -> Bool
Word8.null ByteString
y -> ByteString -> Builder
byteString ByteString
x
| Bool
otherwise -> ByteString -> Builder
byteString ByteString
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
go0 ByteString
y
allocationStrategy :: AllocationStrategy
allocationStrategy =
let initialLength :: Int
initialLength = ByteString -> Int
Word8.length ByteString
bs
wanted :: Int
wanted = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
32 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
initialLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
in Int -> Int -> AllocationStrategy
safeStrategy Int
wanted Int
wanted
hexValue :: ByteString -> Int
hexValue = (Int -> Char -> Int) -> Int -> ByteString -> Int
forall a. (a -> Char -> a) -> a -> ByteString -> a
Char8.foldl' (\Int
val Char
c -> Int
val Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) Int
0
fixed2 :: (Char, Char) -> E.BoundedPrim b
fixed2 :: (Char, Char) -> BoundedPrim b
fixed2 (Char, Char)
repl = FixedPrim b -> BoundedPrim b
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (FixedPrim b -> BoundedPrim b) -> FixedPrim b -> BoundedPrim b
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> b -> (Char, Char)
forall a b. a -> b -> a
const (Char, Char)
repl (b -> (Char, Char)) -> FixedPrim (Char, Char) -> FixedPrim b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
E.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
E.char7
{-# INLINE fixed2 #-}
uEscape :: E.FixedPrim Word16
uEscape :: FixedPrim Word16
uEscape = ((Char
'\\', Char
'u'), ) (Word16 -> ((Char, Char), Word16))
-> FixedPrim ((Char, Char), Word16) -> FixedPrim Word16
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Char
E.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
E.char7) FixedPrim (Char, Char)
-> FixedPrim Word16 -> FixedPrim ((Char, Char), Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word16
E.word16HexFixed
{-# INLINE uEscape #-}