{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Data.MIME.Parameter
(
Parameters(..)
, emptyParameters
, parameterList
, parameter
, rawParameter
, newParameter
, ParameterValue(..)
, EncodedParameterValue
, DecodedParameterValue
, value
, HasParameters(..)
) where
import Control.Applicative ((<|>), optional)
import Data.Foldable (fold)
import Data.Functor (($>))
import Data.Semigroup (Sum(..), Max(..))
import Data.String (IsString(..))
import Data.Word (Word8)
import Data.Void (Void)
import Foreign (withForeignPtr, plusPtr, minusPtr, peek, peekByteOff, poke)
import GHC.Generics (Generic)
import System.IO.Unsafe (unsafeDupablePerformIO)
import Control.DeepSeq (NFData)
import Control.Lens
import Control.Lens.Cons.Extras (recons)
import Data.Attoparsec.ByteString.Char8 hiding (take)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Char8 as C
import Data.CaseInsensitive (CI, foldedCase, mk, original)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.MIME.Charset
import Data.MIME.Internal
import Data.IMF.Syntax (ci, isQtext, isVchar)
type RawParameters = [(CI B.ByteString, B.ByteString)]
newtype Parameters = Parameters [(CI B.ByteString, B.ByteString)]
deriving (Parameters -> Parameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c== :: Parameters -> Parameters -> Bool
Eq, Int -> Parameters -> ShowS
[Parameters] -> ShowS
Parameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Int -> Parameters -> ShowS
$cshowsPrec :: Int -> Parameters -> ShowS
Show, forall x. Rep Parameters x -> Parameters
forall x. Parameters -> Rep Parameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Parameters x -> Parameters
$cfrom :: forall x. Parameters -> Rep Parameters x
Generic, Parameters -> ()
forall a. (a -> ()) -> NFData a
rnf :: Parameters -> ()
$crnf :: Parameters -> ()
NFData)
instance Semigroup Parameters where
Parameters [(CI ByteString, ByteString)]
a <> :: Parameters -> Parameters -> Parameters
<> Parameters [(CI ByteString, ByteString)]
b = [(CI ByteString, ByteString)] -> Parameters
Parameters ([(CI ByteString, ByteString)]
a forall a. Semigroup a => a -> a -> a
<> [(CI ByteString, ByteString)]
b)
instance Monoid Parameters where
mempty :: Parameters
mempty = [(CI ByteString, ByteString)] -> Parameters
Parameters []
type instance Index Parameters = CI B.ByteString
type instance IxValue Parameters = EncodedParameterValue
paramiso :: Iso' Parameters [(CI B.ByteString, B.ByteString)]
paramiso :: Iso' Parameters [(CI ByteString, ByteString)]
paramiso = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Parameters [(CI ByteString, ByteString)]
raw) -> [(CI ByteString, ByteString)]
raw) [(CI ByteString, ByteString)] -> Parameters
Parameters
instance Ixed Parameters where
ix :: Index Parameters -> Traversal' Parameters (IxValue Parameters)
ix Index Parameters
k = Iso' Parameters [(CI ByteString, ByteString)]
paramiso forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncodedParameterValue -> f EncodedParameterValue)
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
l
where
l :: (EncodedParameterValue -> f EncodedParameterValue)
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
l EncodedParameterValue -> f EncodedParameterValue
f [(CI ByteString, ByteString)]
kv = case CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe EncodedParameterValue
getParameter Index Parameters
k [(CI ByteString, ByteString)]
kv of
Maybe EncodedParameterValue
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(CI ByteString, ByteString)]
kv
Just EncodedParameterValue
v -> (\EncodedParameterValue
v' -> CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam Index Parameters
k EncodedParameterValue
v' [(CI ByteString, ByteString)]
kv) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncodedParameterValue -> f EncodedParameterValue
f EncodedParameterValue
v
emptyParameters :: Parameters
emptyParameters :: Parameters
emptyParameters = forall a. Monoid a => a
mempty
setParam :: CI B.ByteString -> EncodedParameterValue -> RawParameters -> RawParameters
setParam :: CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam CI ByteString
k EncodedParameterValue
v = (CI ByteString
-> EncodedParameterValue -> [(CI ByteString, ByteString)]
renderParam CI ByteString
k EncodedParameterValue
v forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
k
renderParam :: CI B.ByteString -> EncodedParameterValue -> [(CI B.ByteString, B.ByteString)]
renderParam :: CI ByteString
-> EncodedParameterValue -> [(CI ByteString, ByteString)]
renderParam CI ByteString
k EncodedParameterValue
pv = case EncodedParameterValue
pv of
ParameterValue Maybe (CI ByteString)
Nothing Maybe (CI ByteString)
Nothing ByteString
v -> case ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode forall a. Bounded a => a
minBound ByteString
v of
(ParameterEncoding
Plain, ByteString
v') -> [(CI ByteString
k, ByteString
v')]
(ParameterEncoding
Quoted, ByteString
v') -> [(CI ByteString
k, ByteString
"\"" forall a. Semigroup a => a -> a -> a
<> ByteString
v' forall a. Semigroup a => a -> a -> a
<> ByteString
"\"")]
(ParameterEncoding
Extended, ByteString
v') -> [(CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*", ByteString
"''" forall a. Semigroup a => a -> a -> a
<> ByteString
v')]
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang ByteString
v ->
[(CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*", Maybe (CI ByteString) -> ByteString
f Maybe (CI ByteString)
cs forall a. Semigroup a => a -> a -> a
<> ByteString
"'" forall a. Semigroup a => a -> a -> a
<> Maybe (CI ByteString) -> ByteString
f Maybe (CI ByteString)
lang forall a. Semigroup a => a -> a -> a
<> ByteString
"'" forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode ParameterEncoding
Extended ByteString
v))]
where
f :: Maybe (CI ByteString) -> ByteString
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" forall s. CI s -> s
original
deleteParam :: CI B.ByteString -> RawParameters -> RawParameters
deleteParam :: CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
k = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
where
test :: CI ByteString -> Bool
test CI ByteString
x =
CI ByteString
x forall a. Eq a => a -> a -> Bool
== CI ByteString
k
Bool -> Bool -> Bool
|| (forall s. CI s -> s
foldedCase CI ByteString
k forall a. Semigroup a => a -> a -> a
<> ByteString
"*") ByteString -> ByteString -> Bool
`B.isPrefixOf` forall s. CI s -> s
foldedCase CI ByteString
x
instance At Parameters where
at :: Index Parameters -> Lens' Parameters (Maybe (IxValue Parameters))
at Index Parameters
k = Iso' Parameters [(CI ByteString, ByteString)]
paramiso forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' [(CI ByteString, ByteString)] (Maybe EncodedParameterValue)
l
where
l :: Lens' RawParameters (Maybe EncodedParameterValue)
l :: Lens' [(CI ByteString, ByteString)] (Maybe EncodedParameterValue)
l Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue)
f [(CI ByteString, ByteString)]
kv =
let
g :: Maybe EncodedParameterValue -> [(CI ByteString, ByteString)]
g Maybe EncodedParameterValue
Nothing = CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam Index Parameters
k [(CI ByteString, ByteString)]
kv
g (Just EncodedParameterValue
v) = (CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam Index Parameters
k EncodedParameterValue
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam Index Parameters
k) [(CI ByteString, ByteString)]
kv
in
Maybe EncodedParameterValue -> [(CI ByteString, ByteString)]
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue)
f (CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe EncodedParameterValue
getParameter Index Parameters
k [(CI ByteString, ByteString)]
kv)
data Continued = Continued | NotContinued
deriving (Int -> Continued -> ShowS
[Continued] -> ShowS
Continued -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Continued] -> ShowS
$cshowList :: [Continued] -> ShowS
show :: Continued -> String
$cshow :: Continued -> String
showsPrec :: Int -> Continued -> ShowS
$cshowsPrec :: Int -> Continued -> ShowS
Show)
data Encoded = Encoded | NotEncoded
deriving (Int -> Encoded -> ShowS
[Encoded] -> ShowS
Encoded -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encoded] -> ShowS
$cshowList :: [Encoded] -> ShowS
show :: Encoded -> String
$cshow :: Encoded -> String
showsPrec :: Int -> Encoded -> ShowS
$cshowsPrec :: Int -> Encoded -> ShowS
Show)
data InitialSection = InitialSection Continued Encoded B.ByteString
deriving (Int -> InitialSection -> ShowS
[InitialSection] -> ShowS
InitialSection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialSection] -> ShowS
$cshowList :: [InitialSection] -> ShowS
show :: InitialSection -> String
$cshow :: InitialSection -> String
showsPrec :: Int -> InitialSection -> ShowS
$cshowsPrec :: Int -> InitialSection -> ShowS
Show)
data OtherSection = OtherSection Encoded B.ByteString
deriving (Int -> OtherSection -> ShowS
[OtherSection] -> ShowS
OtherSection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherSection] -> ShowS
$cshowList :: [OtherSection] -> ShowS
show :: OtherSection -> String
$cshow :: OtherSection -> String
showsPrec :: Int -> OtherSection -> ShowS
$cshowsPrec :: Int -> OtherSection -> ShowS
Show)
initialSection
:: CI B.ByteString
-> RawParameters
-> Maybe InitialSection
initialSection :: CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe InitialSection
initialSection CI ByteString
k [(CI ByteString, ByteString)]
m =
Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
NotContinued Encoded
NotEncoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
k [(CI ByteString, ByteString)]
m
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
Continued Encoded
NotEncoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*0") [(CI ByteString, ByteString)]
m
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
NotContinued Encoded
Encoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*") [(CI ByteString, ByteString)]
m
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
Continued Encoded
Encoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*0*") [(CI ByteString, ByteString)]
m
otherSection
:: CI B.ByteString
-> Int
-> RawParameters
-> Maybe OtherSection
otherSection :: CI ByteString
-> Int -> [(CI ByteString, ByteString)] -> Maybe OtherSection
otherSection CI ByteString
k Int
i [(CI ByteString, ByteString)]
m =
Encoded -> ByteString -> OtherSection
OtherSection Encoded
NotEncoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*" forall a. Semigroup a => a -> a -> a
<> CI ByteString
i') [(CI ByteString, ByteString)]
m
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoded -> ByteString -> OtherSection
OtherSection Encoded
Encoded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*" forall a. Semigroup a => a -> a -> a
<> CI ByteString
i' forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*") [(CI ByteString, ByteString)]
m
where
i' :: CI ByteString
i' = forall s. FoldCase s => s -> CI s
mk forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack (forall a. Show a => a -> String
show Int
i)
data ParameterValue cs a = ParameterValue
(Maybe cs)
(Maybe (CI B.ByteString))
a
deriving (ParameterValue cs a -> ParameterValue cs a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall cs a.
(Eq cs, Eq a) =>
ParameterValue cs a -> ParameterValue cs a -> Bool
/= :: ParameterValue cs a -> ParameterValue cs a -> Bool
$c/= :: forall cs a.
(Eq cs, Eq a) =>
ParameterValue cs a -> ParameterValue cs a -> Bool
== :: ParameterValue cs a -> ParameterValue cs a -> Bool
$c== :: forall cs a.
(Eq cs, Eq a) =>
ParameterValue cs a -> ParameterValue cs a -> Bool
Eq, Int -> ParameterValue cs a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall cs a.
(Show cs, Show a) =>
Int -> ParameterValue cs a -> ShowS
forall cs a. (Show cs, Show a) => [ParameterValue cs a] -> ShowS
forall cs a. (Show cs, Show a) => ParameterValue cs a -> String
showList :: [ParameterValue cs a] -> ShowS
$cshowList :: forall cs a. (Show cs, Show a) => [ParameterValue cs a] -> ShowS
show :: ParameterValue cs a -> String
$cshow :: forall cs a. (Show cs, Show a) => ParameterValue cs a -> String
showsPrec :: Int -> ParameterValue cs a -> ShowS
$cshowsPrec :: forall cs a.
(Show cs, Show a) =>
Int -> ParameterValue cs a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall cs a x. Rep (ParameterValue cs a) x -> ParameterValue cs a
forall cs a x. ParameterValue cs a -> Rep (ParameterValue cs a) x
$cto :: forall cs a x. Rep (ParameterValue cs a) x -> ParameterValue cs a
$cfrom :: forall cs a x. ParameterValue cs a -> Rep (ParameterValue cs a) x
Generic, forall a. (a -> ()) -> NFData a
forall cs a. (NFData cs, NFData a) => ParameterValue cs a -> ()
rnf :: ParameterValue cs a -> ()
$crnf :: forall cs a. (NFData cs, NFData a) => ParameterValue cs a -> ()
NFData)
type EncodedParameterValue = ParameterValue CharsetName B.ByteString
type DecodedParameterValue = ParameterValue Void T.Text
instance IsString DecodedParameterValue where
fromString :: String -> DecodedParameterValue
fromString = forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance IsString EncodedParameterValue where
fromString :: String -> EncodedParameterValue
fromString = forall a. HasCharset a => Decoded a -> a
charsetEncode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
value :: Lens (ParameterValue cs a) (ParameterValue cs b) a b
value :: forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value a -> f b
f (ParameterValue Maybe cs
a Maybe (CI ByteString)
b a
c) = forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe cs
a Maybe (CI ByteString)
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
c
charset :: Lens (ParameterValue cs a) (ParameterValue cs' a) (Maybe cs) (Maybe cs')
charset :: forall cs a cs'.
Lens
(ParameterValue cs a) (ParameterValue cs' a) (Maybe cs) (Maybe cs')
charset Maybe cs -> f (Maybe cs')
f (ParameterValue Maybe cs
a Maybe (CI ByteString)
b a
c) = (\Maybe cs'
a' -> forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe cs'
a' Maybe (CI ByteString)
b a
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe cs -> f (Maybe cs')
f Maybe cs
a
newParameter :: Cons s s Char Char => s -> EncodedParameterValue
newParameter :: forall s. Cons s s Char Char => s -> EncodedParameterValue
newParameter = forall a. HasCharset a => Decoded a -> a
charsetEncode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons
instance HasCharset EncodedParameterValue where
type Decoded EncodedParameterValue = DecodedParameterValue
charsetName :: Getter EncodedParameterValue (Maybe (CI ByteString))
charsetName = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \(ParameterValue Maybe (CI ByteString)
name Maybe (CI ByteString)
_ ByteString
_) -> Maybe (CI ByteString)
name forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just CI ByteString
"us-ascii"
charsetData :: Getter EncodedParameterValue ByteString
charsetData = forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value
charsetDecoded :: forall e.
AsCharsetError e =>
CharsetLookup
-> forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic'
p
f
EncodedParameterValue
(Either e (Decoded EncodedParameterValue))
charsetDecoded CharsetLookup
m = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \EncodedParameterValue
a -> (\Text
t -> (forall s t a b. ASetter s t a b -> b -> s -> t
set forall cs a cs'.
Lens
(ParameterValue cs a) (ParameterValue cs' a) (Maybe cs) (Maybe cs')
charset forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value Text
t) EncodedParameterValue
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a e (p :: * -> * -> *) (f :: * -> *).
(HasCharset a, AsCharsetError e, Profunctor p, Contravariant f) =>
CharsetLookup -> Optic' p f a (Either e Text)
charsetText CharsetLookup
m) EncodedParameterValue
a
charsetEncode :: Decoded EncodedParameterValue -> EncodedParameterValue
charsetEncode (ParameterValue Maybe Void
_ Maybe (CI ByteString)
lang Text
s) =
let
bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
s
cs :: Maybe (CI ByteString)
cs = if (Word8 -> Bool) -> ByteString -> Bool
B.all (forall a. Ord a => a -> a -> Bool
< Word8
0x80) ByteString
bs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just CI ByteString
"utf-8"
in forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang ByteString
bs
getParameter :: CI B.ByteString -> RawParameters -> Maybe EncodedParameterValue
getParameter :: CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe EncodedParameterValue
getParameter CI ByteString
k [(CI ByteString, ByteString)]
m = do
InitialSection Continued
cont Encoded
enc ByteString
s <- CI ByteString
-> [(CI ByteString, ByteString)] -> Maybe InitialSection
initialSection CI ByteString
k [(CI ByteString, ByteString)]
m
(Maybe (CI ByteString)
cs, Maybe (CI ByteString)
lang, ByteString
v0) <-
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Either String a
parseOnly (Encoded
-> Parser
ByteString
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
parseInitialValue Encoded
enc) ByteString
s
let
sect0 :: OtherSection
sect0 = Encoded -> ByteString -> OtherSection
OtherSection Encoded
enc ByteString
v0
otherSects :: Int -> [OtherSection]
otherSects Int
i = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
: Int -> [OtherSection]
otherSects (Int
i forall a. Num a => a -> a -> a
+ Int
1)) (CI ByteString
-> Int -> [(CI ByteString, ByteString)] -> Maybe OtherSection
otherSection CI ByteString
k Int
i [(CI ByteString, ByteString)]
m)
sects :: [OtherSection]
sects = case Continued
cont of
Continued
NotContinued -> [OtherSection
sect0]
Continued
Continued -> OtherSection
sect0 forall a. a -> [a] -> [a]
: Int -> [OtherSection]
otherSects Int
1
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse OtherSection -> Maybe ByteString
decode [OtherSection]
sects
where
parseInitialValue :: Encoded
-> Parser
ByteString
(Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
parseInitialValue Encoded
NotEncoded =
(forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeByteString
parseInitialValue Encoded
Encoded =
(,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe (CI ByteString))
charsetOrLang forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe (CI ByteString))
charsetOrLang forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
takeByteString
charsetOrLang :: Parser ByteString (Maybe (CI ByteString))
charsetOrLang = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. FoldCase s => Parser s -> Parser (CI s)
ci ((Char -> Bool) -> Parser ByteString
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'\''))) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
'\''
decode :: OtherSection -> Maybe ByteString
decode (OtherSection Encoded
enc ByteString
s) = case Encoded
enc of
Encoded
NotEncoded -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
Encoded
Encoded -> ByteString -> Maybe ByteString
decodePercent ByteString
s
decodePercent :: B.ByteString -> Maybe B.ByteString
decodePercent :: ByteString -> Maybe ByteString
decodePercent (B.PS ForeignPtr Word8
sfp Int
soff Int
slen) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
slen
Maybe Int
result <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
let
slimit :: Ptr Word8
slimit = Ptr Word8
sptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff forall a. Num a => a -> a -> a
+ Int
slen)
fill :: Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill !Ptr Word8
dp !Ptr Word8
sp
| Ptr Word8
sp forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Ptr Word8
dp forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
| Bool
otherwise = do
Word8
c <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
case (Word8
c :: Word8) of
Word8
37
| Ptr Word8
sp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| Bool
otherwise -> do
Word8
c1 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
1
Word8
c2 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
2
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
(\(Word8
hi,Word8
lo) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp (Word8
hi forall a. Num a => a -> a -> a
* Word8
16 forall a. Num a => a -> a -> a
+ Word8
lo)
Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill (Ptr Word8
dp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) )
((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
parseHex Word8
c1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Maybe Word8
parseHex Word8
c2)
Word8
_ ->
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill (Ptr Word8
dp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill Ptr Word8
dptr (Ptr Word8
sptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
result
data ParameterEncoding = Plain | Quoted | Extended
deriving (ParameterEncoding -> ParameterEncoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterEncoding -> ParameterEncoding -> Bool
$c/= :: ParameterEncoding -> ParameterEncoding -> Bool
== :: ParameterEncoding -> ParameterEncoding -> Bool
$c== :: ParameterEncoding -> ParameterEncoding -> Bool
Eq, Eq ParameterEncoding
ParameterEncoding -> ParameterEncoding -> Bool
ParameterEncoding -> ParameterEncoding -> Ordering
ParameterEncoding -> ParameterEncoding -> ParameterEncoding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
$cmin :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
max :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
$cmax :: ParameterEncoding -> ParameterEncoding -> ParameterEncoding
>= :: ParameterEncoding -> ParameterEncoding -> Bool
$c>= :: ParameterEncoding -> ParameterEncoding -> Bool
> :: ParameterEncoding -> ParameterEncoding -> Bool
$c> :: ParameterEncoding -> ParameterEncoding -> Bool
<= :: ParameterEncoding -> ParameterEncoding -> Bool
$c<= :: ParameterEncoding -> ParameterEncoding -> Bool
< :: ParameterEncoding -> ParameterEncoding -> Bool
$c< :: ParameterEncoding -> ParameterEncoding -> Bool
compare :: ParameterEncoding -> ParameterEncoding -> Ordering
$ccompare :: ParameterEncoding -> ParameterEncoding -> Ordering
Ord, ParameterEncoding
forall a. a -> a -> Bounded a
maxBound :: ParameterEncoding
$cmaxBound :: ParameterEncoding
minBound :: ParameterEncoding
$cminBound :: ParameterEncoding
Bounded)
extEncode :: ParameterEncoding -> B.ByteString -> (ParameterEncoding, B.ByteString)
extEncode :: ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode ParameterEncoding
encReq s :: ByteString
s@(B.PS ForeignPtr Word8
sfp Int
soff Int
slen) = (ParameterEncoding
enc, ByteString
d)
where
isTspecial :: Word8 -> Bool
isTspecial = (Word8 -> ByteString -> Bool
`B.elem` ByteString
"()<>@,;:\\\"/[]?=")
isAttrChar :: Word8 -> Bool
isAttrChar Word8
c = forall c. IsChar c => c -> Bool
isVchar Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> ByteString -> Bool
`B.notElem` ByteString
"*'%" Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isTspecial Word8
c)
numEncChars :: Word8 -> a
numEncChars Word8
c = if Word8 -> Bool
isAttrChar Word8
c then a
1 else a
3
charEncoding :: Word8 -> ParameterEncoding
charEncoding Word8
c
| Word8 -> Bool
isAttrChar Word8
c = ParameterEncoding
Plain
| forall c. IsChar c => c -> Bool
isVchar Word8
c Bool -> Bool -> Bool
|| Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
c forall a. Eq a => a -> a -> Bool
== Word8
0x09 = ParameterEncoding
Quoted
| Bool
otherwise = ParameterEncoding
Extended
charInfo :: Word8 -> (Sum a, Max ParameterEncoding)
charInfo Word8
c = (forall a. a -> Sum a
Sum (forall {a}. Num a => Word8 -> a
numEncChars Word8
c), forall a. a -> Max a
Max (Word8 -> ParameterEncoding
charEncoding Word8
c))
(Sum Int
dlenMax, Max ParameterEncoding
encCap) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. Num a => Word8 -> (Sum a, Max ParameterEncoding)
charInfo forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
s
enc :: ParameterEncoding
enc
| ByteString -> Bool
B.null ByteString
s = ParameterEncoding
Quoted
| Bool
otherwise = forall a. Max a -> a
getMax (forall a. a -> Max a
Max ParameterEncoding
encReq forall a. Semigroup a => a -> a -> a
<> Max ParameterEncoding
encCap)
poke' :: Ptr Word8 -> Word8 -> IO (Ptr Word8)
poke' Ptr Word8
ptr Word8
c = case ParameterEncoding
enc of
ParameterEncoding
Plain -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
ParameterEncoding
Quoted
| forall c. IsChar c => c -> Bool
isQtext Word8
c -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
| Bool
otherwise -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
0x5c
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
c
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
ParameterEncoding
Extended
| Word8 -> Bool
isAttrChar Word8
c -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
| Bool
otherwise -> do
let (Word8
hi, Word8
lo) = Word8 -> (Word8, Word8)
hexEncode Word8
c
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
37
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
hi
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
lo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
d :: ByteString
d = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
dfp <- forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
dlenMax
Int
dlen <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
let
slimit :: Ptr Word8
slimit = Ptr Word8
sptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff forall a. Num a => a -> a -> a
+ Int
slen)
fill :: Ptr Word8 -> Ptr Word8 -> IO Int
fill !Ptr Word8
sp !Ptr Word8
dp
| Ptr Word8
sp forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
dp forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
| Bool
otherwise = forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Word8 -> IO (Ptr Word8)
poke' Ptr Word8
dp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Ptr Word8 -> IO Int
fill (Ptr Word8
sp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Ptr Word8 -> Ptr Word8 -> IO Int
fill Ptr Word8
sptr Ptr Word8
dptr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 Int
dlen
class HasParameters a where
parameters :: Lens' a Parameters
instance HasParameters Parameters where
parameters :: Lens' Parameters Parameters
parameters = forall a. a -> a
id
parameterList :: HasParameters a => Lens' a RawParameters
parameterList :: forall a. HasParameters a => Lens' a [(CI ByteString, ByteString)]
parameterList = forall a. HasParameters a => Lens' a Parameters
parameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced
parameter
:: HasParameters a
=> CI B.ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter :: forall a.
HasParameters a =>
CI ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter CI ByteString
k = forall a. HasParameters a => Lens' a Parameters
parameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
k
rawParameter :: HasParameters a => CI B.ByteString -> Traversal' a B.ByteString
rawParameter :: forall a.
HasParameters a =>
CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
k = forall a. HasParameters a => Lens' a Parameters
parameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' Parameters [(CI ByteString, ByteString)]
paramiso forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((CI ByteString
k forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2