{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TupleSections              #-}
module URI.ByteString.Internal where

-------------------------------------------------------------------------------
import           Blaze.ByteString.Builder           (Builder)
import qualified Blaze.ByteString.Builder           as BB
import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
import           Control.Applicative
import           Control.Monad
import qualified Control.Monad.Fail                 as F
import           Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString         as A
import qualified Data.Attoparsec.ByteString.Char8   as A (decimal)
import           Data.Bits
import           Data.ByteString                    (ByteString)
import qualified Data.ByteString                    as BS
import qualified Data.ByteString.Char8              as BS8
import           Data.Char                          (ord, toLower)
import           Data.Ix
import           Data.List                          (delete, intersperse,
                                                     sortBy, stripPrefix, (\\))
import qualified Data.Map.Strict                    as M
import           Data.Maybe
import           Data.Monoid                        as Monoid (mempty)
import           Data.Ord                           (comparing)
import           Data.Semigroup                     as Semigroup
import           Data.Word
import           Text.Read                          (readMaybe)
-------------------------------------------------------------------------------
import           URI.ByteString.Types
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- | Strict URI Parser config. Follows RFC3986 as-specified. Use this
-- if you can be certain that your URIs are properly encoded or if you
-- want parsing to fail if they deviate from the spec at all.
strictURIParserOptions :: URIParserOptions
strictURIParserOptions :: URIParserOptions
strictURIParserOptions =  URIParserOptions {
      upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
validForQuery
    }


-------------------------------------------------------------------------------
-- | Lax URI Parser config. Use this if you you want to handle common
-- deviations from the spec gracefully.
--
-- * Allows non-encoded [ and ] in query string
laxURIParserOptions :: URIParserOptions
laxURIParserOptions :: URIParserOptions
laxURIParserOptions = URIParserOptions {
      upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
validForQueryLax
    }


-------------------------------------------------------------------------------
-- | All normalization options disabled
noNormalization :: URINormalizationOptions
noNormalization :: URINormalizationOptions
noNormalization = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Map Scheme Port
-> URINormalizationOptions
URINormalizationOptions Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Map Scheme Port
httpDefaultPorts


-------------------------------------------------------------------------------
-- | The set of known default ports to schemes. Currently only
-- contains http\/80 and https\/443. Feel free to extend it if needed
-- with 'unoDefaultPorts'.
httpDefaultPorts :: M.Map Scheme Port
httpDefaultPorts :: Map Scheme Port
httpDefaultPorts = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (ByteString -> Scheme
Scheme ByteString
"http", Int -> Port
Port Int
80)
                              , (ByteString -> Scheme
Scheme ByteString
"https", Int -> Port
Port Int
443)
                              ]


-------------------------------------------------------------------------------
-- | Only normalizations deemed appropriate for all protocols by
-- RFC3986 enabled, namely:
--
-- * Downcase Scheme
-- * Downcase Host
-- * Remove Dot Segments
rfc3986Normalization :: URINormalizationOptions
rfc3986Normalization :: URINormalizationOptions
rfc3986Normalization = URINormalizationOptions
noNormalization { unoDowncaseScheme :: Bool
unoDowncaseScheme = Bool
True
                                       , unoDowncaseHost :: Bool
unoDowncaseHost = Bool
True
                                       , unoRemoveDotSegments :: Bool
unoRemoveDotSegments = Bool
True
                                       }


-------------------------------------------------------------------------------
-- | The same as 'rfc3986Normalization' but with additional enabled
-- features if you're working with HTTP URIs:
--
-- * Drop Default Port (with 'httpDefaultPorts')
-- * Drop Extra Slashes
httpNormalization :: URINormalizationOptions
httpNormalization :: URINormalizationOptions
httpNormalization = URINormalizationOptions
rfc3986Normalization { unoDropDefPort :: Bool
unoDropDefPort = Bool
True
                                         , unoSlashEmptyPath :: Bool
unoSlashEmptyPath = Bool
True
                                         }

-------------------------------------------------------------------------------
-- | All options enabled
aggressiveNormalization :: URINormalizationOptions
aggressiveNormalization :: URINormalizationOptions
aggressiveNormalization = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Map Scheme Port
-> URINormalizationOptions
URINormalizationOptions Bool
True Bool
True Bool
True Bool
True Bool
True Bool
True Bool
True Map Scheme Port
httpDefaultPorts


-------------------------------------------------------------------------------
-- | @toAbsolute scheme ref@ converts @ref@ to an absolute URI.
-- If @ref@ is already absolute, then it is unchanged.
toAbsolute :: Scheme -> URIRef a -> URIRef Absolute
toAbsolute :: forall a. Scheme -> URIRef a -> URIRef Absolute
toAbsolute Scheme
scheme (RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: URIRef Relative -> Maybe ByteString
rrQuery :: URIRef Relative -> Query
rrPath :: URIRef Relative -> ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
..}) = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI Scheme
scheme Maybe Authority
rrAuthority ByteString
rrPath Query
rrQuery Maybe ByteString
rrFragment
toAbsolute Scheme
_ uri :: URIRef a
uri@(URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
..}) = URIRef a
uri


-------------------------------------------------------------------------------
-- | URI Serializer
-------------------------------------------------------------------------------

-- | Serialize a URI reference into a 'Builder'.
--
-- Example of serializing + converting to a lazy "Data.ByteString.Lazy.ByteString":
--
-- >>> BB.toLazyByteString $ serializeURIRef $ URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar","baz")]}, uriFragment = Just "quux"}
-- "http://www.example.org/foo?bar=baz#quux"
serializeURIRef :: URIRef a -> Builder
serializeURIRef :: forall a. URIRef a -> Builder
serializeURIRef = forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
noNormalization


-------------------------------------------------------------------------------
-- | Like 'serializeURIRef', with conversion into a strict 'ByteString'.
serializeURIRef' :: URIRef a -> ByteString
serializeURIRef' :: forall a. URIRef a -> ByteString
serializeURIRef' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. URIRef a -> Builder
serializeURIRef


-------------------------------------------------------------------------------
-- | Serialize a URI into a Builder.
serializeURI :: URIRef Absolute -> Builder
serializeURI :: URIRef Absolute -> Builder
serializeURI = forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
noNormalization
{-# DEPRECATED serializeURI "Use 'serializeURIRef' instead" #-}


-------------------------------------------------------------------------------
-- | Similar to 'serializeURIRef' but performs configurable degrees of
-- URI normalization. If your goal is the fastest serialization speed
-- possible, 'serializeURIRef' will be fine. If you intend on
-- comparing URIs (say for caching purposes), you'll want to use this.
normalizeURIRef :: URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef :: forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
o uri :: URIRef a
uri@(URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
..})       = URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI URINormalizationOptions
o URIRef a
uri
normalizeURIRef URINormalizationOptions
o uri :: URIRef a
uri@(RelativeRef {}) = URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
o forall a. Maybe a
Nothing URIRef a
uri


-------------------------------------------------------------------------------
normalizeURIRef' :: URINormalizationOptions -> URIRef a -> ByteString
normalizeURIRef' :: forall a. URINormalizationOptions -> URIRef a -> ByteString
normalizeURIRef' URINormalizationOptions
o = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
o


-------------------------------------------------------------------------------
normalizeURI :: URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI :: URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI o :: URINormalizationOptions
o@URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
..} =
  Builder
scheme forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.fromString [Char]
":" forall a. Semigroup a => a -> a -> a
<> URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
o (forall a. a -> Maybe a
Just Scheme
uriScheme) URIRef Relative
rr
  where
    scheme :: Builder
scheme = ByteString -> Builder
bs (ByteString -> ByteString
sCase (Scheme -> ByteString
schemeBS Scheme
uriScheme))
    sCase :: ByteString -> ByteString
sCase
      | Bool
unoDowncaseScheme = ByteString -> ByteString
downcaseBS
      | Bool
otherwise = forall a. a -> a
id
    rr :: URIRef Relative
rr = Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> URIRef Relative
RelativeRef Maybe Authority
uriAuthority ByteString
uriPath Query
uriQuery Maybe ByteString
uriFragment


-------------------------------------------------------------------------------
normalizeRelativeRef :: URINormalizationOptions -> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef :: URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef o :: URINormalizationOptions
o@URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} Maybe Scheme
mScheme RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
rrFragment :: URIRef Relative -> Maybe ByteString
rrQuery :: URIRef Relative -> Query
rrPath :: URIRef Relative -> ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
..} =
  Builder
authority forall a. Semigroup a => a -> a -> a
<> Builder
path forall a. Semigroup a => a -> a -> a
<> Builder
query forall a. Semigroup a => a -> a -> a
<> Builder
fragment
  where
    path :: Builder
path
      | Bool
unoSlashEmptyPath Bool -> Bool -> Bool
&& ByteString -> Bool
BS.null ByteString
rrPath  = ByteString -> Builder
BB.fromByteString ByteString
"/"
      | [ByteString]
segs forall a. Eq a => a -> a -> Bool
== [ByteString
""] = ByteString -> Builder
BB.fromByteString ByteString
"/"
      | Bool
otherwise  = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
c8 Char
'/') (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Builder
urlEncodePath [ByteString]
segs))
    segs :: [ByteString]
segs = [ByteString] -> [ByteString]
dropSegs (Word8 -> ByteString -> [ByteString]
BS.split Word8
slash (ByteString -> ByteString
pathRewrite ByteString
rrPath))
    pathRewrite :: ByteString -> ByteString
pathRewrite
      | Bool
unoRemoveDotSegments = ByteString -> ByteString
removeDotSegments
      | Bool
otherwise = forall a. a -> a
id
    dropSegs :: [ByteString] -> [ByteString]
dropSegs [] = []
    dropSegs (ByteString
h:[ByteString]
t)
      | Bool
unoDropExtraSlashes = ByteString
hforall a. a -> [a] -> [a]
:(forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
t)
      | Bool
otherwise = ByteString
hforall a. a -> [a] -> [a]
:[ByteString]
t
    authority :: Builder
authority = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
Monoid.mempty (URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority URINormalizationOptions
o Maybe Scheme
mScheme) Maybe Authority
rrAuthority
    query :: Builder
query = URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
o Query
rrQuery
    fragment :: Builder
fragment = Maybe ByteString -> Builder
serializeFragment Maybe ByteString
rrFragment


-------------------------------------------------------------------------------
--TODO: this is probably ripe for benchmarking
-- | Algorithm described in
-- <https://tools.ietf.org/html/rfc3986#section-5.2.4>, reproduced
-- artlessly.
removeDotSegments :: ByteString -> ByteString
removeDotSegments :: ByteString -> ByteString
removeDotSegments ByteString
path = forall a. Monoid a => [a] -> a
mconcat (forall a. RL a -> [a]
rl2L (ByteString -> RL ByteString -> RL ByteString
go ByteString
path (forall a. [a] -> RL a
RL [])))
  where
    go :: ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf RL ByteString
outBuf
      -- A. If the input buffer begins with prefix of ../ or ./ then
      -- remove the prefix from the input buffer
      | ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
"../" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
3 ByteString
inBuf) RL ByteString
outBuf
      | ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
"./" ByteString
inBuf  = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
2 ByteString
inBuf) RL ByteString
outBuf
      -- B. If the input buffer begins with a prefix of "/./" or "/.",
      -- where "." is a complete path segment, then replace that
      -- prefix with "/" in the input buffer. TODO: I think "a
      -- complete path segment" means its the whole thing?
      | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"/./" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
2 ByteString
inBuf) RL ByteString
outBuf
      | ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
"/." = ByteString -> RL ByteString -> RL ByteString
go ByteString
"/" RL ByteString
outBuf
      -- C. If the input buffer begins with a prefix of "/../" or
      -- "/..", where ".." is a complete path segment, then replace
      -- that prefix with "/" in the input buffer and remove the last
      -- segment and its preceding "/" (if any) from the output buffer
      | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"/../" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
3 ByteString
inBuf) (forall a. RL a -> RL a
unsnoc (forall a. RL a -> RL a
unsnoc RL ByteString
outBuf))
      | ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
"/.." = ByteString -> RL ByteString -> RL ByteString
go ByteString
"/" (forall a. RL a -> RL a
unsnoc (forall a. RL a -> RL a
unsnoc RL ByteString
outBuf))
      -- D. If the input buffer consists only of "." or "..", then
      -- remove that from the input buffer
      | ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
"." = ByteString -> RL ByteString -> RL ByteString
go forall a. Monoid a => a
mempty RL ByteString
outBuf
      | ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
".." = ByteString -> RL ByteString -> RL ByteString
go forall a. Monoid a => a
mempty RL ByteString
outBuf
      -- E. Move the first path segment in the input buffer to the end
      -- of the output buffer, including the initial "/" character (if
      -- any) and any subsequent characters up to, but not including,
      -- the next "/" character or the end of the input buffer.
      | Bool
otherwise = case ByteString -> Maybe (Char, ByteString)
BS8.uncons ByteString
inBuf of
                      Just (Char
'/', ByteString
rest) ->
                        let (ByteString
thisSeg, ByteString
inBuf') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
rest
                        in ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf' (RL ByteString
outBuf forall a. RL a -> a -> RL a
|> ByteString
"/" forall a. RL a -> a -> RL a
|> ByteString
thisSeg)
                      Just (Char
_, ByteString
_) ->
                        let (ByteString
thisSeg, ByteString
inBuf') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
inBuf
                        in ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf' (RL ByteString
outBuf forall a. RL a -> a -> RL a
|> ByteString
thisSeg)
                      Maybe (Char, ByteString)
Nothing -> RL ByteString
outBuf



-------------------------------------------------------------------------------
-- | Like 'serializeURI', with conversion into a strict 'ByteString'.
serializeURI' :: URIRef Absolute -> ByteString
serializeURI' :: URIRef Absolute -> ByteString
serializeURI' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Absolute -> Builder
serializeURI
{-# DEPRECATED serializeURI' "Use 'serializeURIRef'' instead" #-}


-------------------------------------------------------------------------------
-- | Like 'serializeURI', but do not render scheme.
serializeRelativeRef :: URIRef Relative -> Builder
serializeRelativeRef :: URIRef Relative -> Builder
serializeRelativeRef = URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
noNormalization forall a. Maybe a
Nothing
{-# DEPRECATED serializeRelativeRef "Use 'serializeURIRef' instead" #-}


-------------------------------------------------------------------------------
-- | Like 'serializeRelativeRef', with conversion into a strict 'ByteString'.
serializeRelativeRef' :: URIRef Relative -> ByteString
serializeRelativeRef' :: URIRef Relative -> ByteString
serializeRelativeRef' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Relative -> Builder
serializeRelativeRef
{-# DEPRECATED serializeRelativeRef' "Use 'serializeURIRef'' instead" #-}


-------------------------------------------------------------------------------
-- | Serialize the query part of a url
-- @serializeQuery opts mempty = ""@
-- @serializeQuery opts (Query [("a","b"),("c","d")]) = "?a=b&c=d"@
serializeQuery :: URINormalizationOptions -> Query -> Builder
serializeQuery :: URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
_ (Query []) = forall a. Monoid a => a
mempty
serializeQuery URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} (Query [(ByteString, ByteString)]
ps) =
    Char -> Builder
c8 Char
'?' forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
c8 Char
'&') (forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> Builder
serializePair [(ByteString, ByteString)]
ps'))
  where
    serializePair :: (ByteString, ByteString) -> Builder
serializePair (ByteString
k, ByteString
v) = ByteString -> Builder
urlEncodeQuery ByteString
k forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
'=' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
urlEncodeQuery ByteString
v
    ps' :: [(ByteString, ByteString)]
ps'
      | Bool
unoSortParameters = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) [(ByteString, ByteString)]
ps
      | Bool
otherwise = [(ByteString, ByteString)]
ps


serializeQuery' :: URINormalizationOptions -> Query -> ByteString
serializeQuery' :: URINormalizationOptions -> Query -> ByteString
serializeQuery' URINormalizationOptions
opts = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
opts


-------------------------------------------------------------------------------
serializeFragment :: Maybe ByteString -> Builder
serializeFragment :: Maybe ByteString -> Builder
serializeFragment = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\ByteString
s -> Char -> Builder
c8 Char
'#' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
s)


serializeFragment' :: Maybe ByteString -> ByteString
serializeFragment' :: Maybe ByteString -> ByteString
serializeFragment' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Builder
serializeFragment


-------------------------------------------------------------------------------
serializeAuthority :: URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority :: URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} Maybe Scheme
mScheme Authority {Maybe UserInfo
Maybe Port
Host
authorityPort :: Authority -> Maybe Port
authorityHost :: Authority -> Host
authorityUserInfo :: Authority -> Maybe UserInfo
authorityPort :: Maybe Port
authorityHost :: Host
authorityUserInfo :: Maybe UserInfo
..} = [Char] -> Builder
BB.fromString [Char]
"//" forall a. Semigroup a => a -> a -> a
<> Builder
userinfo forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
host forall a. Semigroup a => a -> a -> a
<> Builder
port
  where
    userinfo :: Builder
userinfo = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty UserInfo -> Builder
serializeUserInfo Maybe UserInfo
authorityUserInfo
    host :: ByteString
host = ByteString -> ByteString
hCase (Host -> ByteString
hostBS Host
authorityHost)
    hCase :: ByteString -> ByteString
hCase
      | Bool
unoDowncaseHost = ByteString -> ByteString
downcaseBS
      | Bool
otherwise = forall a. a -> a
id
    port :: Builder
port = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Port -> Builder
packPort Maybe Port
effectivePort
    effectivePort :: Maybe Port
effectivePort = do
      Port
p <- Maybe Port
authorityPort
      Maybe Scheme -> Port -> Maybe Port
dropPort Maybe Scheme
mScheme Port
p
    packPort :: Port -> Builder
packPort (Port Int
p) = Char -> Builder
c8 Char
':' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.fromString (forall a. Show a => a -> [Char]
show Int
p)
    dropPort :: Maybe Scheme -> Port -> Maybe Port
dropPort Maybe Scheme
Nothing = forall a. a -> Maybe a
Just
    dropPort (Just Scheme
scheme)
      | Bool
unoDropDefPort = Scheme -> Port -> Maybe Port
dropPort' Scheme
scheme
      | Bool
otherwise = forall a. a -> Maybe a
Just
    dropPort' :: Scheme -> Port -> Maybe Port
dropPort' Scheme
s Port
p
      | forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Scheme
s Map Scheme Port
unoDefaultPorts forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Port
p = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just Port
p


serializeAuthority' :: URINormalizationOptions -> Maybe Scheme -> Authority -> ByteString
serializeAuthority' :: URINormalizationOptions -> Maybe Scheme -> Authority -> ByteString
serializeAuthority' URINormalizationOptions
opts Maybe Scheme
mScheme = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority URINormalizationOptions
opts Maybe Scheme
mScheme

-------------------------------------------------------------------------------
serializeUserInfo :: UserInfo -> Builder
serializeUserInfo :: UserInfo -> Builder
serializeUserInfo UserInfo {ByteString
uiPassword :: UserInfo -> ByteString
uiUsername :: UserInfo -> ByteString
uiPassword :: ByteString
uiUsername :: ByteString
..} = ByteString -> Builder
bs ByteString
uiUsername forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
':' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
uiPassword forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
'@'


serializeUserInfo' :: UserInfo -> ByteString
serializeUserInfo' :: UserInfo -> ByteString
serializeUserInfo' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Builder
serializeUserInfo


-------------------------------------------------------------------------------
bs :: ByteString -> Builder
bs :: ByteString -> Builder
bs = ByteString -> Builder
BB.fromByteString


-------------------------------------------------------------------------------
c8 :: Char -> Builder
c8 :: Char -> Builder
c8 = Char -> Builder
BB.fromChar


-------------------------------------------------------------------------------
-- | Parse a strict ByteString into a URI or an error.
--
-- Example:
--
-- >>> parseURI strictURIParserOptions "http://www.example.org/foo?bar=baz#quux"
-- Right (URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar","baz")]}, uriFragment = Just "quux"})
--
-- >>> parseURI strictURIParserOptions "$$$$://badurl.example.org"
-- Left (MalformedScheme NonAlphaLeading)
--
-- There are some urls that you'll encounter which defy the spec, such
-- as those with square brackets in the query string. If you must be
-- able to parse those, you can use "laxURIParserOptions" or specify your own
--
-- >>> parseURI strictURIParserOptions "http://www.example.org/foo?bar[]=baz"
-- Left MalformedQuery
--
-- >>> parseURI laxURIParserOptions "http://www.example.org/foo?bar[]=baz"
-- Right (URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar[]","baz")]}, uriFragment = Nothing})
--
-- >>> let myLaxOptions = URIParserOptions { upoValidQueryChar = liftA2 (||) (upoValidQueryChar strictURIParserOptions) (inClass "[]")}
-- >>> parseURI myLaxOptions "http://www.example.org/foo?bar[]=baz"
-- Right (URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar[]","baz")]}, uriFragment = Nothing})
parseURI :: URIParserOptions -> ByteString -> Either URIParseError (URIRef Absolute)
parseURI :: URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
opts = forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> URIParseError
OtherError (URIParserOptions -> URIParser (URIRef Absolute)
uriParser' URIParserOptions
opts)

-- | Like 'parseURI', but do not parse scheme.
parseRelativeRef :: URIParserOptions -> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef :: URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
opts = forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> URIParseError
OtherError (URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' URIParserOptions
opts)


-------------------------------------------------------------------------------
-- | Convenience alias for a parser that can return URIParseError
type URIParser = Parser' URIParseError


-------------------------------------------------------------------------------
-- | Underlying attoparsec parser. Useful for composing with your own parsers.
uriParser :: URIParserOptions -> Parser (URIRef Absolute)
uriParser :: URIParserOptions -> Parser (URIRef Absolute)
uriParser = forall e a. Parser' e a -> Parser a
unParser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions -> URIParser (URIRef Absolute)
uriParser'


-------------------------------------------------------------------------------
-- | Toplevel parser for URIs
uriParser' :: URIParserOptions -> URIParser (URIRef Absolute)
uriParser' :: URIParserOptions -> URIParser (URIRef Absolute)
uriParser' URIParserOptions
opts = do
  Scheme
scheme <- URIParser Scheme
schemeParser
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
word8 Word8
colon forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
MissingColon
  RelativeRef Maybe Authority
authority ByteString
path Query
query Maybe ByteString
fragment <- URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' URIParserOptions
opts
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI Scheme
scheme Maybe Authority
authority ByteString
path Query
query Maybe ByteString
fragment


-------------------------------------------------------------------------------
-- | Underlying attoparsec parser. Useful for composing with your own parsers.
relativeRefParser :: URIParserOptions -> Parser (URIRef Relative)
relativeRefParser :: URIParserOptions -> Parser (URIRef Relative)
relativeRefParser = forall e a. Parser' e a -> Parser a
unParser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser'


-------------------------------------------------------------------------------
-- | Toplevel parser for relative refs
relativeRefParser' :: URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' :: URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' URIParserOptions
opts = do
  (Maybe Authority
authority, ByteString
path) <- Parser' URIParseError (Maybe Authority, ByteString)
hierPartParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' URIParseError (Maybe Authority, ByteString)
rrPathParser
  Query
query <- URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts
  Maybe ByteString
frag  <- URIParser (Maybe ByteString)
mFragmentParser
  case Maybe ByteString
frag of
    Just ByteString
_  -> forall t. Chunk t => Parser t ()
endOfInput forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedFragment
    Maybe ByteString
Nothing -> forall t. Chunk t => Parser t ()
endOfInput forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> URIRef Relative
RelativeRef Maybe Authority
authority ByteString
path Query
query Maybe ByteString
frag


-------------------------------------------------------------------------------
-- | Parser for scheme, e.g. "http", "https", etc.
schemeParser :: URIParser Scheme
schemeParser :: URIParser Scheme
schemeParser = do
  Word8
c    <- (Word8 -> Bool) -> Parser Word8
satisfy Word8 -> Bool
isAlpha           forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
NonAlphaLeading
  ByteString
rest <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile Word8 -> Bool
isSchemeValid forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
InvalidChars
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Scheme
Scheme forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> ByteString -> ByteString
`BS.cons` ByteString
rest
  where
    isSchemeValid :: Word8 -> Bool
isSchemeValid = [Char] -> Word8 -> Bool
inClass forall a b. (a -> b) -> a -> b
$ [Char]
"-+." forall a. [a] -> [a] -> [a]
++ [Char]
alphaNum


-------------------------------------------------------------------------------
-- | Hier part immediately follows the schema and encompasses the
-- authority and path sections.
hierPartParser :: URIParser (Maybe Authority, ByteString)
hierPartParser :: Parser' URIParseError (Maybe Authority, ByteString)
hierPartParser = Parser' URIParseError (Maybe Authority, ByteString)
authWithPathParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 Parser' URIParseError (Maybe Authority, ByteString)
pathAbsoluteParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 Parser' URIParseError (Maybe Authority, ByteString)
pathRootlessParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 Parser' URIParseError (Maybe Authority, ByteString)
pathEmptyParser


-------------------------------------------------------------------------------
-- | Relative references have awkward corner cases.  See
-- 'firstRelRefSegmentParser'.
rrPathParser :: URIParser (Maybe Authority, ByteString)
rrPathParser :: Parser' URIParseError (Maybe Authority, ByteString)
rrPathParser = (forall a. Maybe a
Nothing,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' URIParseError ByteString
firstRelRefSegmentParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError ByteString
pathParser)


-------------------------------------------------------------------------------
-- | See the "authority path-abempty" grammar in the RFC
authWithPathParser :: URIParser (Maybe Authority, ByteString)
authWithPathParser :: Parser' URIParseError (Maybe Authority, ByteString)
authWithPathParser = forall e. ByteString -> Parser' e ByteString
string' ByteString
"//" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParser (Maybe Authority)
mAuthorityParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError ByteString
pathParser)


-------------------------------------------------------------------------------
-- | See the "path-absolute" grammar in the RFC. Essentially a special
-- case of rootless.
pathAbsoluteParser :: URIParser (Maybe Authority, ByteString)
pathAbsoluteParser :: Parser' URIParseError (Maybe Authority, ByteString)
pathAbsoluteParser = forall e. ByteString -> Parser' e ByteString
string' ByteString
"/" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' URIParseError (Maybe Authority, ByteString)
pathRootlessParser


-------------------------------------------------------------------------------
-- | See the "path-rootless" grammar in the RFC.
pathRootlessParser :: URIParser (Maybe Authority, ByteString)
pathRootlessParser :: Parser' URIParseError (Maybe Authority, ByteString)
pathRootlessParser = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError ByteString
pathParser1


-------------------------------------------------------------------------------
-- | See the "path-empty" grammar in the RFC. Must not be followed
-- with a path-valid char.
pathEmptyParser :: URIParser (Maybe Authority, ByteString)
pathEmptyParser :: Parser' URIParseError (Maybe Authority, ByteString)
pathEmptyParser = do
  Maybe Word8
nextChar <- Parser (Maybe Word8)
peekWord8 forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` [Char] -> URIParseError
OtherError [Char]
"impossible peekWord8 error"
  case Maybe Word8
nextChar of
    Just Word8
c -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char] -> Word8 -> Bool
notInClass [Char]
pchar Word8
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall {a}. (Maybe a, ByteString)
emptyCase
    Maybe Word8
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {a}. (Maybe a, ByteString)
emptyCase
  where
    emptyCase :: (Maybe a, ByteString)
emptyCase = (forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)


-------------------------------------------------------------------------------
-- | Parser whe
mAuthorityParser :: URIParser (Maybe Authority)
mAuthorityParser :: URIParser (Maybe Authority)
mAuthorityParser = forall e a. Parser' e a -> Parser' e (Maybe a)
mParse URIParser Authority
authorityParser


-------------------------------------------------------------------------------
-- | Parses the user info section of a URL (i.e. for HTTP Basic
-- Authentication). Note that this will decode any percent-encoded
-- data.
userInfoParser :: URIParser UserInfo
userInfoParser :: URIParser UserInfo
userInfoParser =  (Parser ByteString UserInfo
uiTokenParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
atSym) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedUserInfo
  where
    atSym :: Word8
atSym = Word8
64
    uiTokenParser :: Parser ByteString UserInfo
uiTokenParser = do
      ByteString
ui <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
validForUserInfo
      let (ByteString
user, ByteString
passWithColon) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (forall a. Eq a => a -> a -> Bool
== Word8
colon) forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
urlDecode' ByteString
ui
      let pass :: ByteString
pass = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
passWithColon
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> UserInfo
UserInfo ByteString
user ByteString
pass
    validForUserInfo :: Word8 -> Bool
validForUserInfo = [Char] -> Word8 -> Bool
inClass forall a b. (a -> b) -> a -> b
$ [Char]
pctEncoded forall a. [a] -> [a] -> [a]
++ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ (Char
':' forall a. a -> [a] -> [a]
: [Char]
unreserved)


-------------------------------------------------------------------------------
-- | Authority consists of host and port
authorityParser :: URIParser Authority
authorityParser :: URIParser Authority
authorityParser = Maybe UserInfo -> Host -> Maybe Port -> Authority
Authority forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Parser' e a -> Parser' e (Maybe a)
mParse URIParser UserInfo
userInfoParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URIParser Host
hostParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URIParser (Maybe Port)
mPortParser


-------------------------------------------------------------------------------
-- | Parser that can handle IPV6/Future literals, IPV4, and domain names.
hostParser :: URIParser Host
hostParser :: URIParser Host
hostParser = (ByteString -> Host
Host forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
parsers) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedHost
  where
    parsers :: Parser ByteString
parsers = Parser ByteString
ipLiteralParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
ipV4Parser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
regNameParser
    ipLiteralParser :: Parser ByteString
ipLiteralParser = Word8 -> Parser Word8
word8 Word8
oBracket forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString
ipVFutureParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
ipV6Parser) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
cBracket


-------------------------------------------------------------------------------
-- | Parses IPV6 addresses. See relevant section in RFC.
ipV6Parser :: Parser ByteString
ipV6Parser :: Parser ByteString
ipV6Parser = do
    [ByteString]
leading <- Parser ByteString [ByteString]
h16s
    [ByteString]
elided <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. a -> b -> a
const [ByteString
""]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByteString -> Parser ByteString
string ByteString
"::")
    [ByteString]
trailing <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Word8 -> Bool) -> Parser ByteString
A.takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
colon) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
colon)
    (Int
finalChunkLen, Maybe ByteString
final) <- Parser ByteString (Int, Maybe ByteString)
finalChunk
    let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ByteString]
leading forall a. [a] -> [a] -> [a]
++ [ByteString]
trailing) forall a. Num a => a -> a -> a
+ Int
finalChunkLen
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> Int
8) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Too many digits in IPv6 address"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
rejoin forall a b. (a -> b) -> a -> b
$ [[ByteString] -> ByteString
rejoin [ByteString]
leading] forall a. [a] -> [a] -> [a]
++ [ByteString]
elided forall a. [a] -> [a] -> [a]
++ [ByteString]
trailing forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe ByteString
final
  where
    finalChunk :: Parser ByteString (Int, Maybe ByteString)
finalChunk = forall a. a -> Maybe a -> a
fromMaybe (Int
0, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString (Int, Maybe ByteString)
finalIpV4 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Int, Maybe ByteString)
finalH16)
    finalH16 :: Parser ByteString (Int, Maybe ByteString)
finalH16 = (Int
1, ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
h16
    finalIpV4 :: Parser ByteString (Int, Maybe ByteString)
finalIpV4 = (Int
2, ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
ipV4Parser
    rejoin :: [ByteString] -> ByteString
rejoin = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":"
    h16s :: Parser ByteString [ByteString]
h16s = Parser ByteString
h16 forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Word8 -> Parser Word8
word8 Word8
colon
    h16 :: Parser ByteString
h16 = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Int -> Int -> m a -> m [a]
parseBetween Int
1 Int
4 ((Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
hexDigit)


-------------------------------------------------------------------------------
-- | Parses IPVFuture addresses. See relevant section in RFC.
ipVFutureParser :: Parser ByteString
ipVFutureParser :: Parser ByteString
ipVFutureParser = do
    Word8
_    <- Word8 -> Parser Word8
word8 Word8
lowercaseV
    ByteString
ds   <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
hexDigit
    Word8
_    <- Word8 -> Parser Word8
word8 Word8
period
    ByteString
rest <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 forall a b. (a -> b) -> a -> b
$ [Char] -> Word8 -> Bool
inClass forall a b. (a -> b) -> a -> b
$ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ [Char]
unreserved
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString
"v" forall a. Semigroup a => a -> a -> a
<> ByteString
ds forall a. Semigroup a => a -> a -> a
<> ByteString
"." forall a. Semigroup a => a -> a -> a
<> ByteString
rest
  where
    lowercaseV :: Word8
lowercaseV = Word8
118


-------------------------------------------------------------------------------
-- | Parses a valid IPV4 address
ipV4Parser :: Parser ByteString
ipV4Parser :: Parser ByteString
ipV4Parser = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Parser ByteString
decOctet
                                  , Parser ByteString
dot
                                  , Parser ByteString
decOctet
                                  , Parser ByteString
dot
                                  , Parser ByteString
decOctet
                                  , Parser ByteString
dot
                                  , Parser ByteString
decOctet]
  where
    decOctet :: Parser ByteString
    decOctet :: Parser ByteString
decOctet = do
      (ByteString
s,Int
num) <- forall a. Parser a -> Parser (ByteString, a)
A.match forall a. Integral a => Parser a
A.decimal
      let len :: Int
len = ByteString -> Int
BS.length ByteString
s
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
len forall a. Ord a => a -> a -> Bool
<= Int
3
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
num forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) Bool -> Bool -> Bool
&& Int
num forall a. Ord a => a -> a -> Bool
<= Int
255
      forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
    dot :: Parser ByteString
dot = ByteString -> Parser ByteString
string ByteString
"."


-------------------------------------------------------------------------------
-- | This corresponds to the hostname, e.g. www.example.org
regNameParser :: Parser ByteString
regNameParser :: Parser ByteString
regNameParser = ByteString -> ByteString
urlDecode' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 ([Char] -> Word8 -> Bool
inClass [Char]
validForRegName)
  where
    validForRegName :: [Char]
validForRegName = [Char]
pctEncoded forall a. [a] -> [a] -> [a]
++ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ [Char]
unreserved


-------------------------------------------------------------------------------
-- | Only parse a port if the colon signifier is there.
mPortParser :: URIParser (Maybe Port)
mPortParser :: URIParser (Maybe Port)
mPortParser = forall e. Word8 -> Parser' e Word8
word8' Word8
colon forall e a b. Parser' e a -> Parser' e b -> Parser' e (Maybe b)
`thenJust` URIParser Port
portParser


-------------------------------------------------------------------------------
-- | Parses port number from the hostname. Colon separator must be
-- handled elsewhere.
portParser :: URIParser Port
portParser :: URIParser Port
portParser = (Int -> Port
Port forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
A.decimal) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPort


-------------------------------------------------------------------------------
-- | Path with any number of segments
pathParser :: URIParser ByteString
pathParser :: Parser' URIParseError ByteString
pathParser = (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many'


-------------------------------------------------------------------------------
-- | Path with at least 1 segment
pathParser1 :: URIParser ByteString
pathParser1 :: Parser' URIParseError ByteString
pathParser1 = (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many1'


-------------------------------------------------------------------------------
-- | Parses the path section of a url. Note that while this can take
-- percent-encoded characters, it does not itself decode them while parsing.
pathParser' :: (Parser ByteString -> Parser [ByteString]) -> URIParser ByteString
pathParser' :: (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' Parser ByteString -> Parser ByteString [ByteString]
repeatParser = (ByteString -> ByteString
urlDecodeQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser ByteString [ByteString]
repeatParser Parser ByteString
segmentParser) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath
  where
    segmentParser :: Parser ByteString
segmentParser = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ByteString -> Parser ByteString
string ByteString
"/", (Word8 -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Word8 -> Bool
inClass [Char]
pchar)]


-------------------------------------------------------------------------------
-- | Parses the first segment of a path section of a relative-path
-- reference.  See RFC 3986, Section 4.2.
-- firstRelRefSegmentParser :: URIParser ByteString
firstRelRefSegmentParser :: URIParser ByteString
firstRelRefSegmentParser :: Parser' URIParseError ByteString
firstRelRefSegmentParser = (Word8 -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Word8 -> Bool
inClass ([Char]
pchar forall a. Eq a => [a] -> [a] -> [a]
\\ [Char]
":")) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath


-------------------------------------------------------------------------------
-- | This parser is being a bit pragmatic. The query section in the
-- spec does not identify the key/value format used in URIs, but that
-- is what most users are expecting to see. One alternative could be
-- to just expose the query string as a string and offer functions on
-- URI to parse a query string to a Query.
queryParser :: URIParserOptions -> URIParser Query
queryParser :: URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts = do
  Maybe Word8
mc <- Parser (Maybe Word8)
peekWord8 forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` [Char] -> URIParseError
OtherError [Char]
"impossible peekWord8 error"
  case Maybe Word8
mc of
    Just Word8
c
      | Word8
c forall a. Eq a => a -> a -> Bool
== Word8
question -> forall e. Int -> Parser' e ()
skip' Int
1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> URIParser Query
itemsParser
      | Word8
c forall a. Eq a => a -> a -> Bool
== Word8
hash     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
      | Bool
otherwise     -> forall e a. Show e => e -> Parser' e a
fail' URIParseError
MalformedPath
    Maybe Word8
_      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  where
    itemsParser :: URIParser Query
itemsParser = [(ByteString, ByteString)] -> Query
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (ByteString, b) -> Bool
neQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
A.sepBy' (URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser URIParserOptions
opts) (forall e. Word8 -> Parser' e Word8
word8' Word8
ampersand)
    neQuery :: (ByteString, b) -> Bool
neQuery (ByteString
k, b
_) = Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
k)


-------------------------------------------------------------------------------
-- | When parsing a single query item string like "foo=bar", turns it
-- into a key/value pair as per convention, with the value being
-- optional. & separators need to be handled further up.
queryItemParser :: URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser :: URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser URIParserOptions
opts = do
  ByteString
s <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile (URIParserOptions -> Word8 -> Bool
upoValidQueryChar URIParserOptions
opts) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
  if ByteString -> Bool
BS.null ByteString
s
     then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
     else do
       let (ByteString
k, ByteString
vWithEquals) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (forall a. Eq a => a -> a -> Bool
== Word8
equals) ByteString
s
       let v :: ByteString
v = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
vWithEquals
       forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
urlDecodeQuery ByteString
k, ByteString -> ByteString
urlDecodeQuery ByteString
v)


-------------------------------------------------------------------------------
validForQuery :: Word8 -> Bool
validForQuery :: Word8 -> Bool
validForQuery = [Char] -> Word8 -> Bool
inClass (Char
'?'forall a. a -> [a] -> [a]
:Char
'/'forall a. a -> [a] -> [a]
:forall a. Eq a => a -> [a] -> [a]
delete Char
'&' [Char]
pchar)


-------------------------------------------------------------------------------
validForQueryLax :: Word8 -> Bool
validForQueryLax :: Word8 -> Bool
validForQueryLax = [Char] -> Word8 -> Bool
notInClass [Char]
"&#"


-------------------------------------------------------------------------------
-- | Only parses a fragment if the # signifiier is there
mFragmentParser :: URIParser (Maybe ByteString)
mFragmentParser :: URIParser (Maybe ByteString)
mFragmentParser = forall e a. Parser' e a -> Parser' e (Maybe a)
mParse forall a b. (a -> b) -> a -> b
$ forall e. Word8 -> Parser' e Word8
word8' Word8
hash forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' URIParseError ByteString
fragmentParser


-------------------------------------------------------------------------------
-- | The final piece of a uri, e.g. #fragment, minus the #.
fragmentParser :: URIParser ByteString
fragmentParser :: Parser' URIParseError ByteString
fragmentParser = forall e a. Parser a -> Parser' e a
Parser' forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser ByteString
A.takeWhile Word8 -> Bool
validFragmentWord
  where
    validFragmentWord :: Word8 -> Bool
validFragmentWord = [Char] -> Word8 -> Bool
inClass (Char
'?'forall a. a -> [a] -> [a]
:Char
'/'forall a. a -> [a] -> [a]
:[Char]
pchar)


-------------------------------------------------------------------------------
-- | Grammar Components
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
hexDigit :: Word8 -> Bool
hexDigit :: Word8 -> Bool
hexDigit = [Char] -> Word8 -> Bool
inClass [Char]
"0-9a-fA-F"


-------------------------------------------------------------------------------
isAlpha :: Word8 -> Bool
isAlpha :: Word8 -> Bool
isAlpha = [Char] -> Word8 -> Bool
inClass [Char]
alpha


-------------------------------------------------------------------------------
isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit = [Char] -> Word8 -> Bool
inClass [Char]
digit


-------------------------------------------------------------------------------
pchar :: String
pchar :: [Char]
pchar = [Char]
pctEncoded forall a. [a] -> [a] -> [a]
++ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ [Char]
":@" forall a. [a] -> [a] -> [a]
++ [Char]
unreserved


-------------------------------------------------------------------------------
-- Very important!  When concatenating this to other strings to make larger
-- character classes, you must put this at the end because the '-' character
-- is treated as a range unless it's at the beginning or end.
unreserved :: String
unreserved :: [Char]
unreserved = [Char]
alphaNum forall a. [a] -> [a] -> [a]
++ [Char]
"~._-"


-------------------------------------------------------------------------------
unreserved8 :: [Word8]
unreserved8 :: [Word8]
unreserved8 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
unreserved


-------------------------------------------------------------------------------
unreservedPath8 :: [Word8]
unreservedPath8 :: [Word8]
unreservedPath8 = [Word8]
unreserved8 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
":@&=+$,"

-------------------------------------------------------------------------------
ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord


-------------------------------------------------------------------------------
-- | pc-encoded technically is % HEXDIG HEXDIG but that's handled by
-- the previous alphaNum constraint. May need to double back with a
-- parser to ensure pct-encoded never exceeds 2 hexdigs after
pctEncoded :: String
pctEncoded :: [Char]
pctEncoded = [Char]
"%"


-------------------------------------------------------------------------------
subDelims :: String
subDelims :: [Char]
subDelims = [Char]
"!$&'()*+,;="


-------------------------------------------------------------------------------
alphaNum :: String
alphaNum :: [Char]
alphaNum = [Char]
alpha forall a. [a] -> [a] -> [a]
++ [Char]
digit


-------------------------------------------------------------------------------
alpha :: String
alpha :: [Char]
alpha = [Char]
"a-zA-Z"


-------------------------------------------------------------------------------
digit :: String
digit :: [Char]
digit = [Char]
"0-9"


-------------------------------------------------------------------------------
colon :: Word8
colon :: Word8
colon = Word8
58


-------------------------------------------------------------------------------
oBracket :: Word8
oBracket :: Word8
oBracket = Word8
91


-------------------------------------------------------------------------------
cBracket :: Word8
cBracket :: Word8
cBracket = Word8
93


-------------------------------------------------------------------------------
equals :: Word8
equals :: Word8
equals = Word8
61


-------------------------------------------------------------------------------
question :: Word8
question :: Word8
question = Word8
63


-------------------------------------------------------------------------------
ampersand :: Word8
ampersand :: Word8
ampersand = Word8
38


-------------------------------------------------------------------------------
hash :: Word8
hash :: Word8
hash = Word8
35


-------------------------------------------------------------------------------
period :: Word8
period :: Word8
period = Word8
46


-------------------------------------------------------------------------------
slash :: Word8
slash :: Word8
slash = Word8
47


-------------------------------------------------------------------------------
-- | ByteString Utilities
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- | Decoding specifically for the query string, which decodes + as
-- space. Shorthand for @urlDecode True@
urlDecodeQuery :: ByteString -> ByteString
urlDecodeQuery :: ByteString -> ByteString
urlDecodeQuery = Bool -> ByteString -> ByteString
urlDecode Bool
plusToSpace
  where
    plusToSpace :: Bool
plusToSpace = Bool
True


-------------------------------------------------------------------------------
-- | Decode any part of the URL besides the query, which decodes + as
-- space.
urlDecode' :: ByteString -> ByteString
urlDecode' :: ByteString -> ByteString
urlDecode' = Bool -> ByteString -> ByteString
urlDecode Bool
plusToSpace
  where
    plusToSpace :: Bool
plusToSpace = Bool
False


-------------------------------------------------------------------------------
-- | Parsing with Strongly-Typed Errors
-------------------------------------------------------------------------------


-- | A parser with a specific error type. Attoparsec unfortunately
-- throws all errors into strings, which cannot be handled well
-- programmatically without doing something silly like parsing error
-- messages. This wrapper attempts to concentrate these errors into
-- one type.
newtype Parser' e a = Parser' { forall e a. Parser' e a -> Parser a
unParser' :: Parser a}
                    deriving ( forall a b. a -> Parser' e b -> Parser' e a
forall a b. (a -> b) -> Parser' e a -> Parser' e b
forall e a b. a -> Parser' e b -> Parser' e a
forall e a b. (a -> b) -> Parser' e a -> Parser' e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Parser' e b -> Parser' e a
$c<$ :: forall e a b. a -> Parser' e b -> Parser' e a
fmap :: forall a b. (a -> b) -> Parser' e a -> Parser' e b
$cfmap :: forall e a b. (a -> b) -> Parser' e a -> Parser' e b
Functor
                             , forall e. Functor (Parser' e)
forall a. a -> Parser' e a
forall e a. a -> Parser' e a
forall a b. Parser' e a -> Parser' e b -> Parser' e a
forall a b. Parser' e a -> Parser' e b -> Parser' e b
forall a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
forall e a b. Parser' e a -> Parser' e b -> Parser' e a
forall e a b. Parser' e a -> Parser' e b -> Parser' e b
forall e a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
forall a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
forall e a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Parser' e a -> Parser' e b -> Parser' e a
$c<* :: forall e a b. Parser' e a -> Parser' e b -> Parser' e a
*> :: forall a b. Parser' e a -> Parser' e b -> Parser' e b
$c*> :: forall e a b. Parser' e a -> Parser' e b -> Parser' e b
liftA2 :: forall a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
$cliftA2 :: forall e a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
<*> :: forall a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
$c<*> :: forall e a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
pure :: forall a. a -> Parser' e a
$cpure :: forall e a. a -> Parser' e a
Applicative
                             , forall e. Applicative (Parser' e)
forall a. Parser' e a
forall a. Parser' e a -> Parser' e [a]
forall a. Parser' e a -> Parser' e a -> Parser' e a
forall e a. Parser' e a
forall e a. Parser' e a -> Parser' e [a]
forall e a. Parser' e a -> Parser' e a -> Parser' e a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Parser' e a -> Parser' e [a]
$cmany :: forall e a. Parser' e a -> Parser' e [a]
some :: forall a. Parser' e a -> Parser' e [a]
$csome :: forall e a. Parser' e a -> Parser' e [a]
<|> :: forall a. Parser' e a -> Parser' e a -> Parser' e a
$c<|> :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
empty :: forall a. Parser' e a
$cempty :: forall e a. Parser' e a
Alternative
                             , forall e. Applicative (Parser' e)
forall a. a -> Parser' e a
forall e a. a -> Parser' e a
forall a b. Parser' e a -> Parser' e b -> Parser' e b
forall a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
forall e a b. Parser' e a -> Parser' e b -> Parser' e b
forall e a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Parser' e a
$creturn :: forall e a. a -> Parser' e a
>> :: forall a b. Parser' e a -> Parser' e b -> Parser' e b
$c>> :: forall e a b. Parser' e a -> Parser' e b -> Parser' e b
>>= :: forall a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
$c>>= :: forall e a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
Monad
                             , forall e. Monad (Parser' e)
forall e. Alternative (Parser' e)
forall a. Parser' e a
forall a. Parser' e a -> Parser' e a -> Parser' e a
forall e a. Parser' e a
forall e a. Parser' e a -> Parser' e a -> Parser' e a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Parser' e a -> Parser' e a -> Parser' e a
$cmplus :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
mzero :: forall a. Parser' e a
$cmzero :: forall e a. Parser' e a
MonadPlus
                             , NonEmpty (Parser' e a) -> Parser' e a
Parser' e a -> Parser' e a -> Parser' e a
forall b. Integral b => b -> Parser' e a -> Parser' e a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e a. NonEmpty (Parser' e a) -> Parser' e a
forall e a. Parser' e a -> Parser' e a -> Parser' e a
forall e a b. Integral b => b -> Parser' e a -> Parser' e a
stimes :: forall b. Integral b => b -> Parser' e a -> Parser' e a
$cstimes :: forall e a b. Integral b => b -> Parser' e a -> Parser' e a
sconcat :: NonEmpty (Parser' e a) -> Parser' e a
$csconcat :: forall e a. NonEmpty (Parser' e a) -> Parser' e a
<> :: Parser' e a -> Parser' e a -> Parser' e a
$c<> :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
Semigroup.Semigroup
                             , Parser' e a
[Parser' e a] -> Parser' e a
Parser' e a -> Parser' e a -> Parser' e a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall e a. Semigroup (Parser' e a)
forall e a. Parser' e a
forall e a. [Parser' e a] -> Parser' e a
forall e a. Parser' e a -> Parser' e a -> Parser' e a
mconcat :: [Parser' e a] -> Parser' e a
$cmconcat :: forall e a. [Parser' e a] -> Parser' e a
mappend :: Parser' e a -> Parser' e a -> Parser' e a
$cmappend :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
mempty :: Parser' e a
$cmempty :: forall e a. Parser' e a
Monoid)


instance F.MonadFail (Parser' e) where
#if MIN_VERSION_attoparsec(0,13,1)
  fail :: forall a. [Char] -> Parser' e a
fail [Char]
e = forall e a. Parser a -> Parser' e a
Parser' (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
F.fail [Char]
e)
#else
  fail e = Parser' (fail e)
#endif


-------------------------------------------------------------------------------
-- | Use with caution. Catch a parser failing and return Nothing.
mParse :: Parser' e a -> Parser' e (Maybe a)
mParse :: forall e a. Parser' e a -> Parser' e (Maybe a)
mParse Parser' e a
p = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' e a
p)


-------------------------------------------------------------------------------
-- | If the first parser succeeds, discard the result and use the
-- second parser (which may fail). If the first parser fails, return
-- Nothing. This is used to check a benign precondition that indicates
-- the presence of a parsible token, i.e. ? preceding a query.
thenJust :: Parser' e a -> Parser' e b -> Parser' e (Maybe b)
thenJust :: forall e a b. Parser' e a -> Parser' e b -> Parser' e (Maybe b)
thenJust Parser' e a
p1 Parser' e b
p2 = Parser' e a
p1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' e b
p2) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing


-------------------------------------------------------------------------------
-- | Lift a word8 Parser into a strongly error typed parser. This will
-- generate a "stringy" error message if it fails, so you should
-- probably be prepared to exit with a nicer error further up.
word8' :: Word8 -> Parser' e Word8
word8' :: forall e. Word8 -> Parser' e Word8
word8' = forall e a. Parser a -> Parser' e a
Parser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Parser Word8
word8


-------------------------------------------------------------------------------
-- | Skip exactly 1 character. Fails if the character isn't
-- there. Generates a "stringy" error.
skip' :: Int -> Parser' e ()
skip' :: forall e. Int -> Parser' e ()
skip' = forall e a. Parser a -> Parser' e a
Parser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser ByteString
A.take


-------------------------------------------------------------------------------
-- | Lifted version of the string token parser. Same caveats about
-- "stringy" errors apply.
string' :: ByteString -> Parser' e ByteString
string' :: forall e. ByteString -> Parser' e ByteString
string' = forall e a. Parser a -> Parser' e a
Parser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser ByteString
string


-------------------------------------------------------------------------------
-- | Combinator for tunnelling more specific error types through the
-- attoparsec machinery using read/show.
orFailWith :: (Show e) => Parser a -> e -> Parser' e a
orFailWith :: forall e a. Show e => Parser a -> e -> Parser' e a
orFailWith Parser a
p e
e = forall e a. Parser a -> Parser' e a
Parser' Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e a. Show e => e -> Parser' e a
fail' e
e


-------------------------------------------------------------------------------
-- | Should be preferred to fail'
fail' :: (Show e) => e -> Parser' e a
fail' :: forall e a. Show e => e -> Parser' e a
fail' = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show


-------------------------------------------------------------------------------
parseBetween :: (Alternative m, Monad m) => Int -> Int -> m a -> m [a]
parseBetween :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Int -> Int -> m a -> m [a]
parseBetween Int
a Int
b m a
f = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [m [a]]
parsers
  where
    parsers :: [m [a]]
parsers = forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
`count` m a
f) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> [a]
range (Int
a, Int
b)


-------------------------------------------------------------------------------
-- | Stronger-typed variation of parseOnly'. Consumes all input.
parseOnly' :: (Read e)
           => (String -> e) -- ^ Fallback if we can't parse a failure message for the sake of totality.
           -> Parser' e a
           -> ByteString
           -> Either e a
parseOnly' :: forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> e
noParse (Parser' Parser a
p) = forall a b r. (a -> b) -> Either a r -> Either b r
fmapL [Char] -> e
readWithFallback forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
parseOnly Parser a
p
  where
    readWithFallback :: [Char] -> e
readWithFallback [Char]
s = forall a. a -> Maybe a -> a
fromMaybe ([Char] -> e
noParse [Char]
s) (forall a. Read a => [Char] -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
stripAttoparsecGarbage forall a b. (a -> b) -> a -> b
$ [Char]
s)

-------------------------------------------------------------------------------
-- | Our pal Control.Monad.fail is how attoparsec propagates
-- errors. If you throw an error string with fail (your only choice),
-- it will *always* prepend it with "Failed reading: ". At least in
-- this version. That may change to something else and break this workaround.
stripAttoparsecGarbage :: String -> String
stripAttoparsecGarbage :: [Char] -> [Char]
stripAttoparsecGarbage = forall a. Eq a => [a] -> [a] -> [a]
stripPrefix' [Char]
"Failed reading: "


-------------------------------------------------------------------------------
-- | stripPrefix where it is a noop if the prefix doesn't exist.
stripPrefix' :: Eq a => [a] -> [a] -> [a]
stripPrefix' :: forall a. Eq a => [a] -> [a] -> [a]
stripPrefix' [a]
pfx [a]
s = forall a. a -> Maybe a -> a
fromMaybe [a]
s forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
pfx [a]
s


-------------------------------------------------------------------------------
fmapL :: (a -> b) -> Either a r -> Either b r
fmapL :: forall a b r. (a -> b) -> Either a r -> Either b r
fmapL a -> b
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. b -> Either a b
Right


-------------------------------------------------------------------------------
-- | This function was extracted from the @http-types@ package. The
-- license can be found in licenses/http-types/LICENSE
urlDecode
    :: Bool
    -- ^ Whether to decode '+' to ' '
    -> BS.ByteString
    -> BS.ByteString
urlDecode :: Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
z = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
z) ByteString -> Maybe (Word8, ByteString)
go ByteString
z
  where
    go :: ByteString -> Maybe (Word8, ByteString)
go ByteString
bs' =
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
            Maybe (Word8, ByteString)
Nothing -> forall a. Maybe a
Nothing
            Just (Word8
43, ByteString
ws) | Bool
replacePlus -> forall a. a -> Maybe a
Just (Word8
32, ByteString
ws) -- plus to space
            Just (Word8
37, ByteString
ws) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Word8
37, ByteString
ws) forall a b. (a -> b) -> a -> b
$ do -- percent
                (Word8
x, ByteString
xs) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
ws
                Word8
x' <- forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
x
                (Word8
y, ByteString
ys) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
xs
                Word8
y' <- forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
y
                forall a. a -> Maybe a
Just (Word8 -> Word8 -> Word8
combine Word8
x' Word8
y', ByteString
ys)
            Just (Word8
w, ByteString
ws) -> forall a. a -> Maybe a
Just (Word8
w, ByteString
ws)
    hexVal :: a -> Maybe a
hexVal a
w
        | a
48 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
57  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
48 -- 0 - 9
        | a
65 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
70  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
55 -- A - F
        | a
97 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
102 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
87 -- a - f
        | Bool
otherwise = forall a. Maybe a
Nothing
    combine :: Word8 -> Word8 -> Word8
    combine :: Word8 -> Word8 -> Word8
combine Word8
a Word8
b = forall a. Bits a => a -> Int -> a
shiftL Word8
a Int
4 forall a. Bits a => a -> a -> a
.|. Word8
b


-------------------------------------------------------------------------------
--TODO: keep an eye on perf here. seems like a good use case for a DList. the word8 list could be a set/hashset

-- | Percent-encoding for URLs. Specify a list of additional
-- unreserved characters to permit.
urlEncode :: [Word8] -> ByteString -> Builder
urlEncode :: [Word8] -> ByteString -> Builder
urlEncode [Word8]
extraUnreserved = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
encodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
    where
      encodeChar :: Word8 -> Builder
encodeChar Word8
ch | Word8 -> Bool
unreserved' Word8
ch = Word8 -> Builder
BB.fromWord8 Word8
ch
                    | Bool
otherwise     = Word8 -> Builder
h2 Word8
ch

      unreserved' :: Word8 -> Bool
unreserved' Word8
ch | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
90  = Bool
True -- A-Z
                    | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True -- a-z
                    | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
57  = Bool
True -- 0-9
      unreserved' Word8
c = Word8
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
extraUnreserved

      h2 :: Word8 -> Builder
h2 Word8
v = let (Word8
a, Word8
b) = Word8
v forall a. Integral a => a -> a -> (a, a)
`divMod` Word8
16 in ByteString -> Builder
bs forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8
37, forall {a}. (Ord a, Num a) => a -> a
h Word8
a, forall {a}. (Ord a, Num a) => a -> a
h Word8
b] -- percent (%)
      h :: a -> a
h a
i | a
i forall a. Ord a => a -> a -> Bool
< a
10    = a
48 forall a. Num a => a -> a -> a
+ a
i -- zero (0)
          | Bool
otherwise = a
65 forall a. Num a => a -> a -> a
+ a
i forall a. Num a => a -> a -> a
- a
10 -- 65: A


-------------------------------------------------------------------------------
-- | Encode a ByteString for use in the query section of a URL
urlEncodeQuery :: ByteString -> Builder
urlEncodeQuery :: ByteString -> Builder
urlEncodeQuery = [Word8] -> ByteString -> Builder
urlEncode [Word8]
unreserved8


-------------------------------------------------------------------------------
-- | Encode a ByteString for use in the path section of a URL
urlEncodePath :: ByteString -> Builder
urlEncodePath :: ByteString -> Builder
urlEncodePath = [Word8] -> ByteString -> Builder
urlEncode [Word8]
unreservedPath8


-------------------------------------------------------------------------------
downcaseBS :: ByteString -> ByteString
downcaseBS :: ByteString -> ByteString
downcaseBS = (Char -> Char) -> ByteString -> ByteString
BS8.map Char -> Char
toLower


-------------------------------------------------------------------------------
-- | Simple data structure to get O(1) prepends on a list and defers the O(n)
newtype RL a = RL [a] deriving (Int -> RL a -> [Char] -> [Char]
forall a. Show a => Int -> RL a -> [Char] -> [Char]
forall a. Show a => [RL a] -> [Char] -> [Char]
forall a. Show a => RL a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [RL a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [RL a] -> [Char] -> [Char]
show :: RL a -> [Char]
$cshow :: forall a. Show a => RL a -> [Char]
showsPrec :: Int -> RL a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> RL a -> [Char] -> [Char]
Show)


(|>) :: RL a -> a -> RL a
RL [a]
as |> :: forall a. RL a -> a -> RL a
|> a
a = forall a. [a] -> RL a
RL (a
aforall a. a -> [a] -> [a]
:[a]
as)


rl2L :: RL a -> [a]
rl2L :: forall a. RL a -> [a]
rl2L (RL [a]
as) = forall a. [a] -> [a]
reverse [a]
as


unsnoc :: RL a -> RL a
unsnoc :: forall a. RL a -> RL a
unsnoc (RL [])     = forall a. [a] -> RL a
RL []
unsnoc (RL (a
_:[a]
xs)) = forall a. [a] -> RL a
RL [a]
xs