-- This file is part of purebred-email
-- Copyright (C) 2018-2021  Fraser Tweedale
--
-- purebred-email is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

{- |

MIME parameters, per RFC 2045 and RFC 2231.

RFC 2231 defines a mechanism for parameter continuations (for long
parameters), encoding of non-ASCII characters, and charset and
language annotation.  The most common use of these capabilities is
in the @Content-Disposition@ header, for the @filename@ parameter.

This module provides types and functions for working with parameters.

-}
module Data.MIME.Parameter
  (
    Parameters(..)
  , 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)]
-- | Header parameters.  Used for some headers including Content-Type
-- and Content-Disposition.  This type handles parameter continuations
-- and optional charset and language information (RFC 2231).
--
newtype Parameters = Parameters [(CI B.ByteString, B.ByteString)]
  deriving (Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
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
(Int -> Parameters -> ShowS)
-> (Parameters -> String)
-> ([Parameters] -> ShowS)
-> Show Parameters
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. Parameters -> Rep Parameters x)
-> (forall x. Rep Parameters x -> Parameters) -> Generic Parameters
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 -> ()
(Parameters -> ()) -> NFData 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 [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
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 :: p [(CI ByteString, ByteString)] (f [(CI ByteString, ByteString)])
-> p Parameters (f Parameters)
paramiso = (Parameters -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> Parameters)
-> Iso
     Parameters
     Parameters
     [(CI ByteString, ByteString)]
     [(CI ByteString, ByteString)]
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

-- Traverses 0 or 1 instances of a parameter, which may consist of
-- one or more raw parameters.
instance Ixed Parameters where
  ix :: Index Parameters -> Traversal' Parameters (IxValue Parameters)
ix Index Parameters
k = ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
Iso
  Parameters
  Parameters
  [(CI ByteString, ByteString)]
  [(CI ByteString, ByteString)]
paramiso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
 -> Parameters -> f Parameters)
-> ((EncodedParameterValue -> f EncodedParameterValue)
    -> [(CI ByteString, ByteString)]
    -> f [(CI ByteString, ByteString)])
-> (EncodedParameterValue -> f EncodedParameterValue)
-> Parameters
-> f Parameters
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 CI ByteString
Index Parameters
k [(CI ByteString, ByteString)]
kv of
      Maybe EncodedParameterValue
Nothing -> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
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 CI ByteString
Index Parameters
k EncodedParameterValue
v' [(CI ByteString, ByteString)]
kv) (EncodedParameterValue -> [(CI ByteString, ByteString)])
-> f EncodedParameterValue -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncodedParameterValue -> f EncodedParameterValue
f EncodedParameterValue
v

-- | Set the parameter (which may need to use the parameter
-- continuation mechanism).
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 [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<>) ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
k

-- | Turn a ParameterValue into a list of raw parameters
--
-- FIXME: currently does not do continutations etc.
-- 'ParameterValue' value is used as-is.
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 ParameterEncoding
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
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\"")]
    (ParameterEncoding
Extended, ByteString
v') -> [(CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*", ByteString
"''" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v')]
  ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang ByteString
v ->
    -- charset or lang has been specified; force extended syntax
    [(CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*", Maybe (CI ByteString) -> ByteString
f Maybe (CI ByteString)
cs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe (CI ByteString) -> ByteString
f Maybe (CI ByteString)
lang ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ParameterEncoding, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (ParameterEncoding -> ByteString -> (ParameterEncoding, ByteString)
extEncode ParameterEncoding
Extended ByteString
v))]
  where
  f :: Maybe (CI ByteString) -> ByteString
f = ByteString
-> (CI ByteString -> ByteString)
-> Maybe (CI ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" CI ByteString -> ByteString
forall s. CI s -> s
original

-- | Delete all raw keys that are "part of" the extended/continued
-- parameter.
deleteParam :: CI B.ByteString -> RawParameters -> RawParameters
deleteParam :: CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
k = ((CI ByteString, ByteString) -> Bool)
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((CI ByteString, ByteString) -> Bool)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> Bool
test (CI ByteString -> Bool)
-> ((CI ByteString, ByteString) -> CI ByteString)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst)
  where
  test :: CI ByteString -> Bool
test CI ByteString
x =
    CI ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
k
    Bool -> Bool -> Bool
|| (CI ByteString -> ByteString
forall s. CI s -> s
foldedCase CI ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"*") ByteString -> ByteString -> Bool
`B.isPrefixOf` CI ByteString -> ByteString
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 = ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
Iso
  Parameters
  Parameters
  [(CI ByteString, ByteString)]
  [(CI ByteString, ByteString)]
paramiso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
 -> Parameters -> f Parameters)
-> ((Maybe EncodedParameterValue
     -> f (Maybe EncodedParameterValue))
    -> [(CI ByteString, ByteString)]
    -> f [(CI ByteString, ByteString)])
-> (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> Parameters
-> f Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
Lens' [(CI ByteString, ByteString)] (Maybe EncodedParameterValue)
l
    where
    l :: Lens' RawParameters (Maybe EncodedParameterValue)
    l :: (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
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 CI ByteString
Index Parameters
k [(CI ByteString, ByteString)]
kv
        g (Just EncodedParameterValue
v) = (CI ByteString
-> EncodedParameterValue
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
setParam CI ByteString
Index Parameters
k EncodedParameterValue
v ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
deleteParam CI ByteString
Index Parameters
k) [(CI ByteString, ByteString)]
kv
      in
        Maybe EncodedParameterValue -> [(CI ByteString, ByteString)]
g (Maybe EncodedParameterValue -> [(CI ByteString, ByteString)])
-> f (Maybe EncodedParameterValue)
-> f [(CI ByteString, ByteString)]
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 CI ByteString
Index Parameters
k [(CI ByteString, ByteString)]
kv)

data Continued = Continued | NotContinued
  deriving (Int -> Continued -> ShowS
[Continued] -> ShowS
Continued -> String
(Int -> Continued -> ShowS)
-> (Continued -> String)
-> ([Continued] -> ShowS)
-> Show Continued
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
(Int -> Encoded -> ShowS)
-> (Encoded -> String) -> ([Encoded] -> ShowS) -> Show Encoded
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)

-- | Not percent-decoded.  'Encoded' indicates whether
-- percent-decoding is required.  'Continued' indicates whether
-- there are more sections to follow
--
data InitialSection = InitialSection Continued Encoded B.ByteString
  deriving (Int -> InitialSection -> ShowS
[InitialSection] -> ShowS
InitialSection -> String
(Int -> InitialSection -> ShowS)
-> (InitialSection -> String)
-> ([InitialSection] -> ShowS)
-> Show InitialSection
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)

-- | Not percent-decoded.  'Encoded' indicates whether
-- percent-decoding is required.
--
data OtherSection = OtherSection Encoded B.ByteString
  deriving (Int -> OtherSection -> ShowS
[OtherSection] -> ShowS
OtherSection -> String
(Int -> OtherSection -> ShowS)
-> (OtherSection -> String)
-> ([OtherSection] -> ShowS)
-> Show OtherSection
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 (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
k [(CI ByteString, ByteString)]
m
  Maybe InitialSection
-> Maybe InitialSection -> Maybe InitialSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
Continued Encoded
NotEncoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*0") [(CI ByteString, ByteString)]
m
  Maybe InitialSection
-> Maybe InitialSection -> Maybe InitialSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
NotContinued Encoded
Encoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*") [(CI ByteString, ByteString)]
m
  Maybe InitialSection
-> Maybe InitialSection -> Maybe InitialSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Continued -> Encoded -> ByteString -> InitialSection
InitialSection Continued
Continued Encoded
Encoded (ByteString -> InitialSection)
-> Maybe ByteString -> Maybe InitialSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
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 (ByteString -> OtherSection)
-> Maybe ByteString -> Maybe OtherSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*" CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
i') [(CI ByteString, ByteString)]
m
  Maybe OtherSection -> Maybe OtherSection -> Maybe OtherSection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Encoded -> ByteString -> OtherSection
OtherSection Encoded
Encoded (ByteString -> OtherSection)
-> Maybe ByteString -> Maybe OtherSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CI ByteString
k CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*" CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
i' CI ByteString -> CI ByteString -> CI ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString
"*") [(CI ByteString, ByteString)]
m
  where
    i' :: CI ByteString
i' = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack (Int -> String
forall a. Show a => a -> String
show Int
i)

data ParameterValue cs a = ParameterValue
  (Maybe cs)                 -- charset
  (Maybe (CI B.ByteString))  -- language
  a                          -- value
  deriving (ParameterValue cs a -> ParameterValue cs a -> Bool
(ParameterValue cs a -> ParameterValue cs a -> Bool)
-> (ParameterValue cs a -> ParameterValue cs a -> Bool)
-> Eq (ParameterValue cs a)
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
[ParameterValue cs a] -> ShowS
ParameterValue cs a -> String
(Int -> ParameterValue cs a -> ShowS)
-> (ParameterValue cs a -> String)
-> ([ParameterValue cs a] -> ShowS)
-> Show (ParameterValue cs a)
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 x. ParameterValue cs a -> Rep (ParameterValue cs a) x)
-> (forall x. Rep (ParameterValue cs a) x -> ParameterValue cs a)
-> Generic (ParameterValue cs a)
forall x. Rep (ParameterValue cs a) x -> ParameterValue cs a
forall x. ParameterValue cs a -> Rep (ParameterValue cs a) x
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, ParameterValue cs a -> ()
(ParameterValue cs a -> ()) -> NFData (ParameterValue cs a)
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

-- | Parameter value with no language.
instance IsString DecodedParameterValue where
  fromString :: String -> DecodedParameterValue
fromString = Maybe Void
-> Maybe (CI ByteString) -> Text -> DecodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe Void
forall a. Maybe a
Nothing Maybe (CI ByteString)
forall a. Maybe a
Nothing (Text -> DecodedParameterValue)
-> (String -> Text) -> String -> DecodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Parameter value with no language, encoded either in @us-ascii@
-- or @utf-8.
instance IsString EncodedParameterValue where
  fromString :: String -> EncodedParameterValue
fromString = DecodedParameterValue -> EncodedParameterValue
forall a. HasCharset a => Decoded a -> a
charsetEncode (DecodedParameterValue -> EncodedParameterValue)
-> (String -> DecodedParameterValue)
-> String
-> EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DecodedParameterValue
forall a. IsString a => String -> a
fromString

value :: Lens (ParameterValue cs a) (ParameterValue cs b) a b
value :: (a -> f b) -> ParameterValue cs a -> f (ParameterValue cs b)
value a -> f b
f (ParameterValue Maybe cs
a Maybe (CI ByteString)
b a
c) = Maybe cs -> Maybe (CI ByteString) -> b -> ParameterValue cs b
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe cs
a Maybe (CI ByteString)
b (b -> ParameterValue cs b) -> f b -> f (ParameterValue cs 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 :: (Maybe cs -> f (Maybe cs'))
-> ParameterValue cs a -> f (ParameterValue cs' a)
charset Maybe cs -> f (Maybe cs')
f (ParameterValue Maybe cs
a Maybe (CI ByteString)
b a
c) = (\Maybe cs'
a' -> Maybe cs' -> Maybe (CI ByteString) -> a -> ParameterValue cs' a
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe cs'
a' Maybe (CI ByteString)
b a
c) (Maybe cs' -> ParameterValue cs' a)
-> f (Maybe cs') -> f (ParameterValue cs' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe cs -> f (Maybe cs')
f Maybe cs
a


-- | Convenience function to construct a parameter value.
-- If you need to to specify language, use the 'ParameterValue'
-- constructor directly.
--
newParameter :: Cons s s Char Char => s -> EncodedParameterValue
newParameter :: s -> EncodedParameterValue
newParameter = DecodedParameterValue -> EncodedParameterValue
forall a. HasCharset a => Decoded a -> a
charsetEncode (DecodedParameterValue -> EncodedParameterValue)
-> (s -> DecodedParameterValue) -> s -> EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Void
-> Maybe (CI ByteString) -> Text -> DecodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe Void
forall a. Maybe a
Nothing Maybe (CI ByteString)
forall a. Maybe a
Nothing (Text -> DecodedParameterValue)
-> (s -> Text) -> s -> DecodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text s Text -> s -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text s Text
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons


-- | The default charset @us-ascii@ is implied by the abstract of
-- RFC 2231 which states: /This memo defines … a means to specify
-- parameter values in character sets other than US-ASCII/.
--
-- When encoding, 'utf-8' is always used, but if the whole string
-- contains only ASCII characters then the charset declaration is
-- omitted (so that it can be encoded as a non-extended parameter).
--
instance HasCharset EncodedParameterValue where
  type Decoded EncodedParameterValue = DecodedParameterValue
  charsetName :: (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue -> f EncodedParameterValue
charsetName = (EncodedParameterValue -> Maybe (CI ByteString))
-> (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue
-> f EncodedParameterValue
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((EncodedParameterValue -> Maybe (CI ByteString))
 -> (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
 -> EncodedParameterValue
 -> f EncodedParameterValue)
-> (EncodedParameterValue -> Maybe (CI ByteString))
-> (Maybe (CI ByteString) -> f (Maybe (CI ByteString)))
-> EncodedParameterValue
-> f EncodedParameterValue
forall a b. (a -> b) -> a -> b
$ \(ParameterValue Maybe (CI ByteString)
name Maybe (CI ByteString)
_ ByteString
_) -> Maybe (CI ByteString)
name Maybe (CI ByteString)
-> Maybe (CI ByteString) -> Maybe (CI ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CI ByteString -> Maybe (CI ByteString)
forall a. a -> Maybe a
Just CI ByteString
"us-ascii"
  charsetData :: (ByteString -> f ByteString)
-> EncodedParameterValue -> f EncodedParameterValue
charsetData = (ByteString -> f ByteString)
-> EncodedParameterValue -> f EncodedParameterValue
forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value
  charsetDecoded :: CharsetLookup
-> forall (p :: * -> * -> *) (f :: * -> *).
   (Profunctor p, Contravariant f) =>
   Optic'
     p
     f
     EncodedParameterValue
     (Either e (Decoded EncodedParameterValue))
charsetDecoded CharsetLookup
m = (EncodedParameterValue -> Either e DecodedParameterValue)
-> Optic'
     p f EncodedParameterValue (Either e DecodedParameterValue)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((EncodedParameterValue -> Either e DecodedParameterValue)
 -> Optic'
      p f EncodedParameterValue (Either e DecodedParameterValue))
-> (EncodedParameterValue -> Either e DecodedParameterValue)
-> Optic'
     p f EncodedParameterValue (Either e DecodedParameterValue)
forall a b. (a -> b) -> a -> b
$ \EncodedParameterValue
a -> (\Text
t -> (ASetter
  (ParameterValue (CI ByteString) Text)
  DecodedParameterValue
  (Maybe (CI ByteString))
  (Maybe Void)
-> Maybe Void
-> ParameterValue (CI ByteString) Text
-> DecodedParameterValue
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ParameterValue (CI ByteString) Text)
  DecodedParameterValue
  (Maybe (CI ByteString))
  (Maybe Void)
forall cs a cs'.
Lens
  (ParameterValue cs a) (ParameterValue cs' a) (Maybe cs) (Maybe cs')
charset Maybe Void
forall a. Maybe a
Nothing (ParameterValue (CI ByteString) Text -> DecodedParameterValue)
-> (EncodedParameterValue -> ParameterValue (CI ByteString) Text)
-> EncodedParameterValue
-> DecodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  EncodedParameterValue
  (ParameterValue (CI ByteString) Text)
  ByteString
  Text
-> Text
-> EncodedParameterValue
-> ParameterValue (CI ByteString) Text
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  EncodedParameterValue
  (ParameterValue (CI ByteString) Text)
  ByteString
  Text
forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value Text
t) EncodedParameterValue
a) (Text -> DecodedParameterValue)
-> Either e Text -> Either e DecodedParameterValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Either e Text) EncodedParameterValue (Either e Text)
-> EncodedParameterValue -> Either e Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup
-> Getting (Either e Text) EncodedParameterValue (Either e Text)
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 _ lang s) =
    let
      bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
s
      cs :: Maybe (CI ByteString)
cs = if (Word8 -> Bool) -> ByteString -> Bool
B.all (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80) ByteString
bs then Maybe (CI ByteString)
forall a. Maybe a
Nothing else CI ByteString -> Maybe (CI ByteString)
forall a. a -> Maybe a
Just CI ByteString
"utf-8"
    in Maybe (CI ByteString)
-> Maybe (CI ByteString) -> ByteString -> EncodedParameterValue
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) <-
    (String
 -> Maybe
      (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> ((Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
    -> Maybe
         (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Either
     String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> String
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a b. a -> b -> a
const Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a. Maybe a
Nothing) (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a. a -> Maybe a
Just (Either
   String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
 -> Maybe
      (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Either
     String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> Maybe (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a b. (a -> b) -> a -> b
$ Parser (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
-> ByteString
-> Either
     String (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall a. Parser a -> ByteString -> Either String a
parseOnly (Encoded
-> Parser
     (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 = [OtherSection]
-> (OtherSection -> [OtherSection])
-> Maybe OtherSection
-> [OtherSection]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (OtherSection -> [OtherSection] -> [OtherSection]
forall a. a -> [a] -> [a]
: Int -> [OtherSection]
otherSects (Int
i Int -> Int -> Int
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 OtherSection -> [OtherSection] -> [OtherSection]
forall a. a -> [a] -> [a]
: Int -> [OtherSection]
otherSects Int
1
  Maybe (CI ByteString)
-> Maybe (CI ByteString) -> ByteString -> EncodedParameterValue
forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue Maybe (CI ByteString)
cs Maybe (CI ByteString)
lang (ByteString -> EncodedParameterValue)
-> ([ByteString] -> ByteString)
-> [ByteString]
-> EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ByteString] -> EncodedParameterValue)
-> Maybe [ByteString] -> Maybe EncodedParameterValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OtherSection -> Maybe ByteString)
-> [OtherSection] -> Maybe [ByteString]
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
     (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
parseInitialValue Encoded
NotEncoded =
      (Maybe (CI ByteString)
forall a. Maybe a
Nothing, Maybe (CI ByteString)
forall a. Maybe a
Nothing, ) (ByteString
 -> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString ByteString
-> Parser
     (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
takeByteString
    parseInitialValue Encoded
Encoded =
      (,,) (Maybe (CI ByteString)
 -> Maybe (CI ByteString)
 -> ByteString
 -> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString (Maybe (CI ByteString))
-> Parser
     ByteString
     (Maybe (CI ByteString)
      -> ByteString
      -> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe (CI ByteString))
charsetOrLang Parser
  ByteString
  (Maybe (CI ByteString)
   -> ByteString
   -> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString (Maybe (CI ByteString))
-> Parser
     ByteString
     (ByteString
      -> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe (CI ByteString))
charsetOrLang Parser
  ByteString
  (ByteString
   -> (Maybe (CI ByteString), Maybe (CI ByteString), ByteString))
-> Parser ByteString ByteString
-> Parser
     (Maybe (CI ByteString), Maybe (CI ByteString), ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
takeByteString
    charsetOrLang :: Parser ByteString (Maybe (CI ByteString))
charsetOrLang = Parser ByteString (CI ByteString)
-> Parser ByteString (Maybe (CI ByteString))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString -> Parser ByteString (CI ByteString)
forall s. FoldCase s => Parser s -> Parser (CI s)
ci ((Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''))) Parser ByteString (Maybe (CI ByteString))
-> Parser ByteString Word8
-> Parser ByteString (Maybe (CI ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
'\''

    decode :: OtherSection -> Maybe ByteString
decode (OtherSection Encoded
enc ByteString
s) = case Encoded
enc of
      Encoded
NotEncoded -> ByteString -> Maybe ByteString
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) = IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ do
  -- Length of decoded string is not yet known, but it cannot be
  -- longer than input, and is likely to be not much shorter.
  -- Therefore allocate slen bytes and only use as much as we need.
  ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
slen

  Maybe Int
result <- ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
      let
        slimit :: Ptr Word8
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
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 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit = Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
          | Bool
otherwise = do
            Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp
            case (Word8
c :: Word8) of
              Word8
37 {- % -}
                | Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit -> Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
                  -- reached end of input during '=' decoding
                | Bool
otherwise -> do
                    Word8
c1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
1
                    Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
sp Int
2
                    IO (Maybe Int)
-> ((Word8, Word8) -> IO (Maybe Int))
-> Maybe (Word8, Word8)
-> IO (Maybe Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                      (Maybe Int -> IO (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing) -- invalid hex sequence
                      (\(Word8
hi,Word8
lo) -> do
                        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp (Word8
hi Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
lo)
                        Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) )
                      ((,) (Word8 -> Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8 -> (Word8, Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Maybe Word8
parseHex Word8
c1 Maybe (Word8 -> (Word8, Word8))
-> Maybe Word8 -> Maybe (Word8, Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> Maybe Word8
parseHex Word8
c2)
              Word8
_ ->
                Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dp Word8
c IO () -> IO (Maybe Int) -> IO (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Word8 -> Ptr Word8 -> IO (Maybe Int)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
  Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 (Int -> ByteString) -> Maybe Int -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
result

data ParameterEncoding = Plain | Quoted | Extended
  deriving (ParameterEncoding -> ParameterEncoding -> Bool
(ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> Eq ParameterEncoding
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
Eq ParameterEncoding
-> (ParameterEncoding -> ParameterEncoding -> Ordering)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> Bool)
-> (ParameterEncoding -> ParameterEncoding -> ParameterEncoding)
-> (ParameterEncoding -> ParameterEncoding -> ParameterEncoding)
-> Ord 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
$cp1Ord :: Eq ParameterEncoding
Ord, ParameterEncoding
ParameterEncoding -> ParameterEncoding -> Bounded ParameterEncoding
forall a. a -> a -> Bounded a
maxBound :: ParameterEncoding
$cmaxBound :: ParameterEncoding
minBound :: ParameterEncoding
$cminBound :: ParameterEncoding
Bounded)

-- | Given a requested encoding and a string, return an encoded
-- string along with the actual encoding used.
--
-- The requested encoding will be used when it is capable of
-- encoding the string, otherwise the first capable encoding
-- is used.
--
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
  -- regular parameter:
  --  value := token / quoted-string   (RFC 2045)
  --  token := 1*<any (US-ASCII) CHAR except SPACE, CTLs, or tspecials>
  --  tspecials :=  "(" / ")" / "<" / ">" / "@" /
  --                "," / ";" / ":" / "\" / <">
  --                "/" / "[" / "]" / "?" / "="
  --
  -- extended-parameter:
  --  attribute-char := <any (US-ASCII) CHAR except SPACE, CTLs, "*", "'", "%", or tspecials>
  --  extended-other-values := *(ext-octet / attribute-char)
  --  ext-octet := "%" 2(DIGIT / "A" / "B" / "C" / "D" / "E" / "F")
  --
  isTspecial :: Word8 -> Bool
isTspecial = (Word8 -> ByteString -> Bool
`B.elem` ByteString
"()<>@,;:\\\"/[]?=")
  isAttrChar :: Word8 -> Bool
isAttrChar Word8
c = Word8 -> Bool
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 -> p
numEncChars Word8
c = if Word8 -> Bool
isAttrChar Word8
c then p
1 else p
3  -- conservative estimate of bytes
                                                 -- needed to encode char
  charEncoding :: Word8 -> ParameterEncoding
charEncoding Word8
c
    | Word8 -> Bool
isAttrChar Word8
c = ParameterEncoding
Plain
    | Word8 -> Bool
forall c. IsChar c => c -> Bool
isVchar Word8
c Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09 = ParameterEncoding
Quoted
    | Bool
otherwise = ParameterEncoding
Extended
  charInfo :: Word8 -> (Sum a, Max ParameterEncoding)
charInfo Word8
c = (a -> Sum a
forall a. a -> Sum a
Sum (Word8 -> a
forall p. Num p => Word8 -> p
numEncChars Word8
c), ParameterEncoding -> Max ParameterEncoding
forall a. a -> Max a
Max (Word8 -> ParameterEncoding
charEncoding Word8
c))
  (Sum Int
dlenMax, Max ParameterEncoding
encCap) = (Word8 -> (Sum Int, Max ParameterEncoding))
-> [Word8] -> (Sum Int, Max ParameterEncoding)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> (Sum Int, Max ParameterEncoding)
forall a. Num a => Word8 -> (Sum a, Max ParameterEncoding)
charInfo ([Word8] -> (Sum Int, Max ParameterEncoding))
-> [Word8] -> (Sum Int, Max ParameterEncoding)
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
s
  enc :: ParameterEncoding
enc
    | ByteString -> Bool
B.null ByteString
s = ParameterEncoding
Quoted  -- Plain cannot encode empty string
    | Bool
otherwise = Max ParameterEncoding -> ParameterEncoding
forall a. Max a -> a
getMax (ParameterEncoding -> Max ParameterEncoding
forall a. a -> Max a
Max ParameterEncoding
encReq Max ParameterEncoding
-> Max ParameterEncoding -> Max ParameterEncoding
forall a. Semigroup a => a -> a -> a
<> Max ParameterEncoding
encCap)

  -- poke the char (possibly encoded) and return updated dest ptr
  poke' :: Ptr Word8 -> Word8 -> IO (Ptr Word8)
poke' Ptr Word8
ptr Word8
c = case ParameterEncoding
enc of
    ParameterEncoding
Plain -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
    ParameterEncoding
Quoted
      | Word8 -> Bool
forall c. IsChar c => c -> Bool
isQtext Word8
c -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
      | Bool
otherwise -> do
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
0x5c -- backslash
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
c
          Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
    ParameterEncoding
Extended
      | Word8 -> Bool
isAttrChar Word8
c -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
c IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
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
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
37 {- % -}
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
hi
          Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
lo
          Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)

  d :: ByteString
d = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
dlenMax
    Int
dlen <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sptr -> do
        let
          slimit :: Ptr Word8
slimit = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
soff Int -> Int -> Int
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 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
slimit = Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)
            | Bool
otherwise = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
sp IO Word8 -> (Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Word8 -> IO (Ptr Word8)
poke' Ptr Word8
dp IO (Ptr Word8) -> (Ptr Word8 -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Ptr Word8 -> IO Int
fill (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        Ptr Word8 -> Ptr Word8 -> IO Int
fill Ptr Word8
sptr Ptr Word8
dptr
    ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dfp Int
0 Int
dlen

-- | Types that have 'Parameters'
class HasParameters a where
  parameters :: Lens' a Parameters

instance HasParameters Parameters where
  parameters :: (Parameters -> f Parameters) -> Parameters -> f Parameters
parameters = (Parameters -> f Parameters) -> Parameters -> f Parameters
forall a. a -> a
id

-- Access the 'Parameters' as a @[(CI B.ByteString, B.ByteString)]@
parameterList :: HasParameters a => Lens' a RawParameters
parameterList :: Lens' a [(CI ByteString, ByteString)]
parameterList = (Parameters -> f Parameters) -> a -> f a
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> a -> f a)
-> (([(CI ByteString, ByteString)]
     -> f [(CI ByteString, ByteString)])
    -> Parameters -> f Parameters)
-> ([(CI ByteString, ByteString)]
    -> f [(CI ByteString, ByteString)])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

-- | Access parameter value.  Continuations, encoding and charset
-- are processed.
--
parameter
  :: HasParameters a
  => CI B.ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter :: CI ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter CI ByteString
k = (Parameters -> f Parameters) -> a -> f a
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> a -> f a)
-> ((Maybe EncodedParameterValue
     -> f (Maybe EncodedParameterValue))
    -> Parameters -> f Parameters)
-> (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Parameters -> Lens' Parameters (Maybe (IxValue Parameters))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
Index Parameters
k

-- | Raw parameter.  The key is used as-is.  No processing of
-- continuations, encoding or charset is performed.
--
rawParameter :: HasParameters a => CI B.ByteString -> Traversal' a B.ByteString
rawParameter :: CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
k = (Parameters -> f Parameters) -> a -> f a
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> a -> f a)
-> ((ByteString -> f ByteString) -> Parameters -> f Parameters)
-> (ByteString -> f ByteString)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Parameters -> f Parameters
Iso
  Parameters
  Parameters
  [(CI ByteString, ByteString)]
  [(CI ByteString, ByteString)]
paramiso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
 -> Parameters -> f Parameters)
-> ((ByteString -> f ByteString)
    -> [(CI ByteString, ByteString)]
    -> f [(CI ByteString, ByteString)])
-> (ByteString -> f ByteString)
-> Parameters
-> f Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed (((CI ByteString, ByteString) -> f (CI ByteString, ByteString))
 -> [(CI ByteString, ByteString)]
 -> f [(CI ByteString, ByteString)])
-> ((ByteString -> f ByteString)
    -> (CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> (ByteString -> f ByteString)
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> Bool)
-> Optic'
     (->) f (CI ByteString, ByteString) (CI ByteString, ByteString)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((CI ByteString
k CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (CI ByteString -> Bool)
-> ((CI ByteString, ByteString) -> CI ByteString)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst) Optic'
  (->) f (CI ByteString, ByteString) (CI ByteString, ByteString)
-> ((ByteString -> f ByteString)
    -> (CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> (ByteString -> f ByteString)
-> (CI ByteString, ByteString)
-> f (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString)
forall s t a b. Field2 s t a b => Lens s t a b
_2