{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module Iri.Parsing.Attoparsec.ByteString
  ( uri,
    httpUri,
    regName,
  )
where

import Data.Attoparsec.ByteString hiding (try)
import qualified Data.Attoparsec.ByteString.Char8 as F
import qualified Data.ByteString as K
import qualified Data.Text.Encoding as B
import qualified Data.Text.Encoding.Error as L
import qualified Data.Text.Punycode as A
import qualified Data.Vector as S
import qualified Iri.CodePointPredicates.Rfc3986 as C
import Iri.Data
import qualified Iri.MonadPlus as R
import qualified Iri.PercentEncoding as I
import Iri.Prelude hiding (foldl, hash)
import qualified Net.IPv4 as M
import qualified Net.IPv6 as N
import qualified TextBuilder as J
import qualified VectorBuilder.MonadPlus as E

{-# INLINE percent #-}
percent :: Parser Word8
percent :: Parser Word8
percent =
  Word8 -> Parser Word8
word8 Word8
37

{-# INLINE plus #-}
plus :: Parser Word8
plus :: Parser Word8
plus =
  Word8 -> Parser Word8
word8 Word8
43

{-# INLINE colon #-}
colon :: Parser Word8
colon :: Parser Word8
colon =
  Word8 -> Parser Word8
word8 Word8
58

{-# INLINE at #-}
at :: Parser Word8
at :: Parser Word8
at =
  Word8 -> Parser Word8
word8 Word8
64

{-# INLINE forwardSlash #-}
forwardSlash :: Parser Word8
forwardSlash :: Parser Word8
forwardSlash =
  Word8 -> Parser Word8
word8 Word8
47

{-# INLINE question #-}
question :: Parser Word8
question :: Parser Word8
question =
  Word8 -> Parser Word8
word8 Word8
63

{-# INLINE hash #-}
hash :: Parser Word8
hash :: Parser Word8
hash =
  Word8 -> Parser Word8
word8 Word8
35

{-# INLINE equality #-}
equality :: Parser Word8
equality :: Parser Word8
equality =
  Word8 -> Parser Word8
word8 Word8
61

{-# INLINE ampersand #-}
ampersand :: Parser Word8
ampersand :: Parser Word8
ampersand =
  Word8 -> Parser Word8
word8 Word8
38

{-# INLINE semicolon #-}
semicolon :: Parser Word8
semicolon :: Parser Word8
semicolon =
  Word8 -> Parser Word8
word8 Word8
59

{-# INLINE labeled #-}
labeled :: String -> Parser a -> Parser a
labeled :: forall a. String -> Parser a -> Parser a
labeled String
label Parser a
parser =
  Parser a
parser Parser a -> String -> Parser a
forall i a. Parser i a -> String -> Parser i a
<?> String
label

-- |
-- Parser of a well-formed URI conforming to the RFC3986 or RFC3987 standards.
-- Performs URL- and Punycode-decoding.
{-# INLINEABLE uri #-}
uri :: Parser Iri
uri :: Parser Iri
uri =
  String -> Parser Iri -> Parser Iri
forall a. String -> Parser a -> Parser a
labeled String
"URI" (Parser Iri -> Parser Iri) -> Parser Iri -> Parser Iri
forall a b. (a -> b) -> a -> b
$ do
    Scheme
parsedScheme <- Parser Scheme
scheme
    Word8
_ <- Parser Word8
colon
    Hierarchy
parsedHierarchy <- Parser Hierarchy
hierarchy
    Query
parsedQuery <- Parser Query
query
    Fragment
parsedFragment <- Parser Fragment
fragment
    Iri -> Parser Iri
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scheme -> Hierarchy -> Query -> Fragment -> Iri
Iri Scheme
parsedScheme Hierarchy
parsedHierarchy Query
parsedQuery Fragment
parsedFragment)

-- |
-- Same as 'uri', but optimized specifially for the case of HTTP URIs.
{-# INLINEABLE httpUri #-}
httpUri :: Parser HttpIri
httpUri :: Parser HttpIri
httpUri =
  String -> Parser HttpIri -> Parser HttpIri
forall a. String -> Parser a -> Parser a
labeled String
"HTTP URI" (Parser HttpIri -> Parser HttpIri)
-> Parser HttpIri -> Parser HttpIri
forall a b. (a -> b) -> a -> b
$ do
    Word8
_ <- (Word8 -> Bool) -> Parser Word8
satisfy (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
104 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
72)
    Word8
_ <- (Word8 -> Bool) -> Parser Word8
satisfy (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
116 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
84)
    Word8
_ <- (Word8 -> Bool) -> Parser Word8
satisfy (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
116 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
84)
    Word8
_ <- (Word8 -> Bool) -> Parser Word8
satisfy (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
112 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
80)
    Bool
secure <- (Word8 -> Bool) -> Parser Word8
satisfy (\Word8
b -> Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
115 Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
83) Parser Word8 -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ByteString
_ <- ByteString -> Parser ByteString
string ByteString
"://"
    Host
parsedHost <- Parser Host
host
    Port
parsedPort <- Word16 -> Port
PresentPort (Word16 -> Port)
-> Parser ByteString Word16 -> Parser ByteString Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Word8
colon Parser Word8
-> Parser ByteString Word16 -> Parser ByteString Word16
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Word16
port) Parser ByteString Port
-> Parser ByteString Port -> Parser ByteString Port
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Port -> Parser ByteString Port
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Port
MissingPort
    Path
parsedPath <- (Parser Word8
forwardSlash Parser Word8 -> Parser ByteString Path -> Parser ByteString Path
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Path
path) Parser ByteString Path
-> Parser ByteString Path -> Parser ByteString Path
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Path -> Parser ByteString Path
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector PathSegment -> Path
Path Vector PathSegment
forall a. Monoid a => a
mempty)
    Query
parsedQuery <- Parser Query
query
    Fragment
parsedFragment <- Parser Fragment
fragment
    HttpIri -> Parser HttpIri
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Security -> Host -> Port -> Path -> Query -> Fragment -> HttpIri
HttpIri (Bool -> Security
Security Bool
secure) Host
parsedHost Port
parsedPort Path
parsedPath Query
parsedQuery Fragment
parsedFragment)

{-# INLINE hierarchy #-}
hierarchy :: Parser Hierarchy
hierarchy :: Parser Hierarchy
hierarchy =
  do
    Bool
slashPresent <- Parser Word8
forwardSlash Parser Word8 -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    if Bool
slashPresent
      then do
        Bool
slashPresent <- Parser Word8
forwardSlash Parser Word8 -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        if Bool
slashPresent
          then (Authority -> Path -> Hierarchy) -> Parser Hierarchy
forall body. (Authority -> Path -> body) -> Parser body
authorisedHierarchyBody Authority -> Path -> Hierarchy
AuthorisedHierarchy
          else Path -> Hierarchy
AbsoluteHierarchy (Path -> Hierarchy) -> Parser ByteString Path -> Parser Hierarchy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Path
path
      else Path -> Hierarchy
RelativeHierarchy (Path -> Hierarchy) -> Parser ByteString Path -> Parser Hierarchy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Path
path

{-# INLINE authorisedHierarchyBody #-}
authorisedHierarchyBody :: (Authority -> Path -> body) -> Parser body
authorisedHierarchyBody :: forall body. (Authority -> Path -> body) -> Parser body
authorisedHierarchyBody Authority -> Path -> body
body =
  do
    UserInfo
parsedUserInfo <- ((User -> Password -> UserInfo) -> Parser UserInfo
forall a. (User -> Password -> a) -> Parser a
presentUserInfo User -> Password -> UserInfo
PresentUserInfo Parser UserInfo -> Parser Word8 -> Parser UserInfo
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
at) Parser UserInfo -> Parser UserInfo -> Parser UserInfo
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UserInfo -> Parser UserInfo
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserInfo
MissingUserInfo
    Host
parsedHost <- Parser Host
host
    Port
parsedPort <- Word16 -> Port
PresentPort (Word16 -> Port)
-> Parser ByteString Word16 -> Parser ByteString Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Word8
colon Parser Word8
-> Parser ByteString Word16 -> Parser ByteString Word16
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Word16
port) Parser ByteString Port
-> Parser ByteString Port -> Parser ByteString Port
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Port -> Parser ByteString Port
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Port
MissingPort
    Path
parsedPath <- (Parser Word8
forwardSlash Parser Word8 -> Parser ByteString Path -> Parser ByteString Path
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Path
path) Parser ByteString Path
-> Parser ByteString Path -> Parser ByteString Path
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Path -> Parser ByteString Path
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector PathSegment -> Path
Path Vector PathSegment
forall a. Monoid a => a
mempty)
    body -> Parser body
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Authority -> Path -> body
body (UserInfo -> Host -> Port -> Authority
Authority UserInfo
parsedUserInfo Host
parsedHost Port
parsedPort) Path
parsedPath)

{-# INLINE scheme #-}
scheme :: Parser Scheme
scheme :: Parser Scheme
scheme =
  String -> Parser Scheme -> Parser Scheme
forall a. String -> Parser a -> Parser a
labeled String
"Scheme"
    (Parser Scheme -> Parser Scheme) -> Parser Scheme -> Parser Scheme
forall a b. (a -> b) -> a -> b
$ (ByteString -> Scheme) -> Parser ByteString -> Parser Scheme
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Scheme
Scheme ((Word8 -> Bool) -> Parser ByteString
takeWhile1 (Predicate
C.scheme Predicate -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral))

{-# INLINEABLE presentUserInfo #-}
presentUserInfo :: (User -> Password -> a) -> Parser a
presentUserInfo :: forall a. (User -> Password -> a) -> Parser a
presentUserInfo User -> Password -> a
result =
  String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
labeled String
"User info"
    (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ do
      User
user <- ByteString -> User
User (ByteString -> User) -> Parser ByteString -> Parser ByteString User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
urlEncodedString (Predicate
C.unencodedUserInfoComponent Predicate -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
      Bool
passwordFollows <- Bool
True Bool -> Parser Word8 -> Parser ByteString Bool
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Word8
colon Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      if Bool
passwordFollows
        then do
          Password
password <- ByteString -> Password
PresentPassword (ByteString -> Password)
-> Parser ByteString -> Parser ByteString Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
urlEncodedString (Predicate
C.unencodedUserInfoComponent Predicate -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
          a -> Parser a
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (User -> Password -> a
result User
user Password
password)
        else a -> Parser a
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (User -> Password -> a
result User
user Password
MissingPassword)

{-# INLINE host #-}
host :: Parser Host
host :: Parser Host
host =
  String -> Parser Host -> Parser Host
forall a. String -> Parser a -> Parser a
labeled String
"Host"
    (Parser Host -> Parser Host) -> Parser Host -> Parser Host
forall a b. (a -> b) -> a -> b
$ [Parser Host] -> Parser Host
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ IPv6 -> Host
IpV6Host (IPv6 -> Host) -> Parser ByteString IPv6 -> Parser Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString IPv6
ipV6,
        IPv4 -> Host
IpV4Host (IPv4 -> Host) -> Parser ByteString IPv4 -> Parser Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString IPv4
M.parserUtf8,
        RegName -> Host
NamedHost (RegName -> Host) -> Parser ByteString RegName -> Parser Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RegName
regName
      ]

{-# INLINEABLE ipV6 #-}
ipV6 :: Parser IPv6
ipV6 :: Parser ByteString IPv6
ipV6 =
  do
    Word16
a <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
    Word8
_ <- Parser Word8
colon
    Word16
b <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
    Word8
_ <- Parser Word8
colon
    Word16
c <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
    Word8
_ <- Parser Word8
colon
    Word16
d <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
    Word8
_ <- Parser Word8
colon
    Parser ByteString IPv6
-> Parser ByteString IPv6 -> Parser ByteString IPv6
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
      ( do
          Word16
e <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
          Word8
_ <- Parser Word8
colon
          Word16
f <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
          Word8
_ <- Parser Word8
colon
          Word16
g <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
          Word8
_ <- Parser Word8
colon
          Word16
h <- Parser ByteString Word16
forall a. (Integral a, Bits a) => Parser a
F.hexadecimal
          IPv6 -> Parser ByteString IPv6
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
N.fromWord16s Word16
a Word16
b Word16
c Word16
d Word16
e Word16
f Word16
g Word16
h)
      )
      ( do
          Word8
_ <- Parser Word8
colon
          IPv6 -> Parser ByteString IPv6
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
N.fromWord16s Word16
a Word16
b Word16
c Word16
d Word16
0 Word16
0 Word16
0 Word16
0)
      )

{-# INLINE regName #-}
regName :: Parser RegName
regName :: Parser ByteString RegName
regName =
  (Vector DomainLabel -> RegName)
-> Parser ByteString (Vector DomainLabel)
-> Parser ByteString RegName
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector DomainLabel -> RegName
RegName (Parser ByteString DomainLabel
-> Parser Word8 -> Parser ByteString (Vector DomainLabel)
forall (m :: * -> *) (vector :: * -> *) element separator.
(MonadPlus m, Vector vector element) =>
m element -> m separator -> m (vector element)
E.sepBy1 Parser ByteString DomainLabel
domainLabel (Word8 -> Parser Word8
word8 Word8
46))

-- |
-- Domain label with Punycode decoding applied if need be.
{-# INLINE domainLabel #-}
domainLabel :: Parser DomainLabel
domainLabel :: Parser ByteString DomainLabel
domainLabel =
  String
-> Parser ByteString DomainLabel -> Parser ByteString DomainLabel
forall a. String -> Parser a -> Parser a
labeled String
"Domain label" (Parser ByteString DomainLabel -> Parser ByteString DomainLabel)
-> Parser ByteString DomainLabel -> Parser ByteString DomainLabel
forall a b. (a -> b) -> a -> b
$ do
    Bool
punycodeFollows <- Bool
True Bool -> Parser ByteString -> Parser ByteString Bool
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
string ByteString
"xn--" Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ByteString
ascii <- (Word8 -> Bool) -> Parser ByteString
takeWhile1 (Predicate
C.domainLabel Predicate -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    if Bool
punycodeFollows
      then case ByteString -> Either PunycodeDecodeException Text
A.decode ByteString
ascii of
        Right Text
text -> DomainLabel -> Parser ByteString DomainLabel
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> DomainLabel
DomainLabel Text
text)
        Left PunycodeDecodeException
exception -> String -> Parser ByteString DomainLabel
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ShowS
showString String
"Punycode decoding exception: " (PunycodeDecodeException -> String
forall a. Show a => a -> String
show PunycodeDecodeException
exception))
      else DomainLabel -> Parser ByteString DomainLabel
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> DomainLabel
DomainLabel (ByteString -> Text
B.decodeUtf8 ByteString
ascii))

{-# INLINE port #-}
port :: Parser Word16
port :: Parser ByteString Word16
port =
  Parser ByteString Word16
forall a. Integral a => Parser a
F.decimal

{-# INLINE path #-}
path :: Parser Path
path :: Parser ByteString Path
path =
  do
    Vector PathSegment
segments <- Parser ByteString PathSegment
-> Parser Word8 -> Parser ByteString (Vector PathSegment)
forall (m :: * -> *) (vector :: * -> *) element separator.
(MonadPlus m, Vector vector element) =>
m element -> m separator -> m (vector element)
E.sepBy Parser ByteString PathSegment
pathSegment Parser Word8
forwardSlash
    if Vector PathSegment -> Bool
segmentsAreEmpty Vector PathSegment
segments
      then Path -> Parser ByteString Path
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector PathSegment -> Path
Path Vector PathSegment
forall a. Monoid a => a
mempty)
      else Path -> Parser ByteString Path
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector PathSegment -> Path
Path Vector PathSegment
segments)
  where
    segmentsAreEmpty :: Vector PathSegment -> Bool
segmentsAreEmpty Vector PathSegment
segments =
      Vector PathSegment -> Int
forall a. Vector a -> Int
S.length Vector PathSegment
segments
        Int -> Predicate
forall a. Eq a => a -> a -> Bool
== Int
1
        Bool -> Bool -> Bool
&& (case Vector PathSegment -> PathSegment
forall a. Vector a -> a
S.unsafeHead Vector PathSegment
segments of PathSegment ByteString
headSegment -> ByteString -> Bool
K.null ByteString
headSegment)

{-# INLINE pathSegment #-}
pathSegment :: Parser PathSegment
pathSegment :: Parser ByteString PathSegment
pathSegment =
  (ByteString -> PathSegment)
-> Parser ByteString -> Parser ByteString PathSegment
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> PathSegment
PathSegment ((Word8 -> Bool) -> Parser ByteString
urlEncodedString (Predicate
C.unencodedPathSegment Predicate -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral))

{-# INLINEABLE utf8Chunks #-}
utf8Chunks :: Parser ByteString -> Parser Text
utf8Chunks :: Parser ByteString -> Parser Text
utf8Chunks Parser ByteString
chunk =
  String -> Parser Text -> Parser Text
forall a. String -> Parser a -> Parser a
labeled String
"UTF8 chunks"
    (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ ((TextBuilder, ByteString, ByteString -> Decoding)
 -> ByteString
 -> Parser
      ByteString (TextBuilder, ByteString, ByteString -> Decoding))
-> (TextBuilder, ByteString, ByteString -> Decoding)
-> Parser ByteString
-> Parser
     ByteString (TextBuilder, ByteString, ByteString -> Decoding)
forall (m :: * -> *) a b.
MonadPlus m =>
(a -> b -> m a) -> a -> m b -> m a
R.foldlM (TextBuilder, ByteString, ByteString -> Decoding)
-> ByteString
-> Parser
     ByteString (TextBuilder, ByteString, ByteString -> Decoding)
forall {m :: * -> *} {b} {t}.
MonadFail m =>
(TextBuilder, b, t -> Decoding)
-> t -> m (TextBuilder, ByteString, ByteString -> Decoding)
progress (TextBuilder
forall a. Monoid a => a
mempty, ByteString
forall a. Monoid a => a
mempty, ByteString -> Decoding
B.streamDecodeUtf8) Parser ByteString
chunk
    Parser ByteString (TextBuilder, ByteString, ByteString -> Decoding)
-> ((TextBuilder, ByteString, ByteString -> Decoding)
    -> Parser Text)
-> Parser Text
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TextBuilder, ByteString, ByteString -> Decoding) -> Parser Text
forall {m :: * -> *} {c}.
MonadFail m =>
(TextBuilder, ByteString, c) -> m Text
finish
  where
    progress :: (TextBuilder, b, t -> Decoding)
-> t -> m (TextBuilder, ByteString, ByteString -> Decoding)
progress (!TextBuilder
builder, b
_, t -> Decoding
decode) t
bytes =
      case IO (Either UnicodeException Decoding)
-> Either UnicodeException Decoding
forall a. IO a -> a
unsafeDupablePerformIO (IO Decoding -> IO (Either UnicodeException Decoding)
forall e a. Exception e => IO a -> IO (Either e a)
try (Decoding -> IO Decoding
forall a. a -> IO a
evaluate (t -> Decoding
decode t
bytes))) of
        Right (B.Some Text
decodedChunk ByteString
undecodedBytes ByteString -> Decoding
newDecode) ->
          (TextBuilder, ByteString, ByteString -> Decoding)
-> m (TextBuilder, ByteString, ByteString -> Decoding)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TextBuilder
builder TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> TextBuilder
J.text Text
decodedChunk, ByteString
undecodedBytes, ByteString -> Decoding
newDecode)
        Left (L.DecodeError String
error Maybe Word8
_) ->
          String -> m (TextBuilder, ByteString, ByteString -> Decoding)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ShowS
showString String
"UTF8 decoding: " String
error)
        Left UnicodeException
_ ->
          String -> m (TextBuilder, ByteString, ByteString -> Decoding)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected decoding error"
    finish :: (TextBuilder, ByteString, c) -> m Text
finish (TextBuilder
builder, ByteString
undecodedBytes, c
_) =
      if ByteString -> Bool
K.null ByteString
undecodedBytes
        then Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TextBuilder -> Text
J.toText TextBuilder
builder)
        else String -> m Text
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ShowS
showString String
"UTF8 decoding: Bytes remaining: " (ByteString -> String
forall a. Show a => a -> String
show ByteString
undecodedBytes))

{-# INLINEABLE urlEncodedString #-}
urlEncodedString :: (Word8 -> Bool) -> Parser ByteString
urlEncodedString :: (Word8 -> Bool) -> Parser ByteString
urlEncodedString Word8 -> Bool
unencodedBytesPredicate =
  String -> Parser ByteString -> Parser ByteString
forall a. String -> Parser a -> Parser a
labeled String
"URL-encoded string"
    (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Parser ByteString -> Parser ByteString
forall (m :: * -> *). MonadPlus m => m ByteString -> m ByteString
R.foldByteString
    (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
unencodedBytesPredicate
    Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
encoded
  where
    encoded :: Parser ByteString
encoded =
      Word8 -> ByteString
K.singleton (Word8 -> ByteString) -> Parser Word8 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
percentEncodedByte

{-# INLINE percentEncodedByte #-}
percentEncodedByte :: Parser Word8
percentEncodedByte :: Parser Word8
percentEncodedByte =
  String -> Parser Word8 -> Parser Word8
forall a. String -> Parser a -> Parser a
labeled String
"Percent-encoded byte" (Parser Word8 -> Parser Word8) -> Parser Word8 -> Parser Word8
forall a b. (a -> b) -> a -> b
$ do
    Word8
_ <- Parser Word8
percent
    Word8
byte1 <- Parser Word8
anyWord8
    Word8
byte2 <- Parser Word8
anyWord8
    Parser Word8
-> (Word8 -> Parser Word8) -> Word8 -> Word8 -> Parser Word8
forall a. a -> (Word8 -> a) -> Word8 -> Word8 -> a
I.matchPercentEncodedBytes (String -> Parser Word8
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Broken percent encoding") Word8 -> Parser Word8
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
byte1 Word8
byte2

{-# INLINE query #-}
query :: Parser Query
query :: Parser Query
query =
  String -> Parser Query -> Parser Query
forall a. String -> Parser a -> Parser a
labeled String
"Query"
    (Parser Query -> Parser Query) -> Parser Query -> Parser Query
forall a b. (a -> b) -> a -> b
$ (Parser Word8
question Parser Word8 -> Parser Query -> Parser Query
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> Query
Query (ByteString -> Query) -> Parser ByteString -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
queryOrFragmentBody))
    Parser Query -> Parser Query -> Parser Query
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Query -> Parser Query
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Query
Query ByteString
forall a. Monoid a => a
mempty)

{-# INLINE fragment #-}
fragment :: Parser Fragment
fragment :: Parser Fragment
fragment =
  String -> Parser Fragment -> Parser Fragment
forall a. String -> Parser a -> Parser a
labeled String
"Fragment"
    (Parser Fragment -> Parser Fragment)
-> Parser Fragment -> Parser Fragment
forall a b. (a -> b) -> a -> b
$ (Parser Word8
hash Parser Word8 -> Parser Fragment -> Parser Fragment
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> Fragment
Fragment (ByteString -> Fragment) -> Parser ByteString -> Parser Fragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
queryOrFragmentBody))
    Parser Fragment -> Parser Fragment -> Parser Fragment
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Fragment -> Parser Fragment
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Fragment
Fragment ByteString
forall a. Monoid a => a
mempty)

-- |
-- The stuff after the question or the hash mark.
{-# INLINEABLE queryOrFragmentBody #-}
queryOrFragmentBody :: Parser ByteString
queryOrFragmentBody :: Parser ByteString
queryOrFragmentBody =
  Parser ByteString -> Parser ByteString
forall (m :: * -> *). MonadPlus m => m ByteString -> m ByteString
R.foldByteString
    (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser ByteString
takeWhile1 (Predicate
C.unencodedQuery Predicate -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString
" "
    ByteString -> Parser Word8 -> Parser ByteString
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Word8
plus
    Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> ByteString
K.singleton
    (Word8 -> ByteString) -> Parser Word8 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
percentEncodedByte