{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Text.URI.Parser.ByteString
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- URI parser for string 'ByteString', an internal module.
module Text.URI.Parser.ByteString
  ( mkURIBs,
    parserBs,
  )
where

import Control.Monad
import Control.Monad.Catch (MonadThrow (..))
import Control.Monad.State.Strict
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (catMaybes, isJust, maybeToList)
import qualified Data.Set as E
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Void
import Data.Word (Word8)
import Text.Megaparsec
import Text.Megaparsec.Byte
import qualified Text.Megaparsec.Byte.Lexer as L
import Text.URI.Types hiding (pHost)

-- | Construct a 'URI' from 'ByteString'. The input you pass to 'mkURIBs'
-- must be a valid URI as per RFC 3986, that is, its components should be
-- percent-encoded where necessary. In case of parse failure
-- 'ParseExceptionBs' is thrown.
--
-- This function uses the 'parserBs' parser under the hood, which you can also
-- use directly in a Megaparsec parser.
--
-- @since 0.3.3.0
mkURIBs :: MonadThrow m => ByteString -> m URI
mkURIBs :: forall (m :: * -> *). MonadThrow m => ByteString -> m URI
mkURIBs ByteString
input =
  case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall e (m :: * -> *). MonadParsec e ByteString m => m URI
parserBs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof :: Parsec Void ByteString URI) String
"" ByteString
input of
    Left ParseErrorBundle ByteString Void
b -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseErrorBundle ByteString Void -> ParseExceptionBs
ParseExceptionBs ParseErrorBundle ByteString Void
b)
    Right URI
x -> forall (m :: * -> *) a. Monad m => a -> m a
return URI
x

-- | This parser can be used to parse 'URI' from strict 'ByteString'.
-- Remember to use a concrete non-polymorphic parser type for efficiency.
--
-- @since 0.0.2.0
parserBs :: MonadParsec e ByteString m => m URI
parserBs :: forall e (m :: * -> *). MonadParsec e ByteString m => m URI
parserBs = do
  Maybe (RText 'Scheme)
uriScheme <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Scheme)
pScheme)
  Maybe Authority
mauth <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e (m :: * -> *). MonadParsec e ByteString m => m Authority
pAuthority
  (Bool
absPath, Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath) <- forall e (m :: * -> *).
MonadParsec e ByteString m =>
Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath (forall a. Maybe a -> Bool
isJust Maybe Authority
mauth)
  [QueryParam]
uriQuery <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] forall e (m :: * -> *).
MonadParsec e ByteString m =>
m [QueryParam]
pQuery
  Maybe (RText 'Fragment)
uriFragment <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Fragment)
pFragment
  let uriAuthority :: Either Bool Authority
uriAuthority = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Bool
absPath) forall a b. b -> Either a b
Right Maybe Authority
mauth
  forall (m :: * -> *) a. Monad m => a -> m a
return URI {[QueryParam]
Maybe (Bool, NonEmpty (RText 'PathPiece))
Maybe (RText 'Scheme)
Maybe (RText 'Fragment)
Either Bool Authority
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriAuthority :: Either Bool Authority
uriScheme :: Maybe (RText 'Scheme)
uriAuthority :: Either Bool Authority
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriScheme :: Maybe (RText 'Scheme)
..}
{-# INLINEABLE parserBs #-}
{-# SPECIALIZE parserBs :: Parsec Void ByteString URI #-}

pScheme :: MonadParsec e ByteString m => m (RText 'Scheme)
pScheme :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Scheme)
pScheme = do
  RText 'Scheme
r <- forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"scheme" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
mkScheme forall a b. (a -> b) -> a -> b
$ do
    Word8
x <- forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaChar
    [Word8]
xs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
43 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
x forall a. a -> [a] -> [a]
: [Word8]
xs)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
  forall (m :: * -> *) a. Monad m => a -> m a
return RText 'Scheme
r
{-# INLINE pScheme #-}

pAuthority :: MonadParsec e ByteString m => m Authority
pAuthority :: forall e (m :: * -> *). MonadParsec e ByteString m => m Authority
pAuthority = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"//")
  Maybe UserInfo
authUserInfo <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e (m :: * -> *). MonadParsec e ByteString m => m UserInfo
pUserInfo
  RText 'Host
authHost <- forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"host" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Host)
mkHost forall e (m :: * -> *). MonadParsec e ByteString m => m [Word8]
pHost
  Maybe Word
authPort <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal)
  forall (m :: * -> *) a. Monad m => a -> m a
return Authority {Maybe Word
Maybe UserInfo
RText 'Host
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
..}
{-# INLINE pAuthority #-}

-- | Parser that can parse host names.
pHost :: MonadParsec e ByteString m => m [Word8]
pHost :: forall e (m :: * -> *). MonadParsec e ByteString m => m [Word8]
pHost =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m ()
ipLiteral),
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m ()
ipv4Address),
      m [Word8]
regName
    ]
  where
    asConsumed :: MonadParsec e ByteString m => m a -> m [Word8]
    asConsumed :: forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m a
p = ByteString -> [Word8]
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m a
p
    ipLiteral :: m ()
ipLiteral =
      forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
91) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
93) forall a b. (a -> b) -> a -> b
$
        forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m ()
ipv6Address forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
ipvFuture
    octet :: m ()
octet = do
      Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      (ByteString
toks, Integer
x) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
x forall a. Ord a => a -> a -> Bool
>= (Integer
256 :: Integer)) forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
        forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall a b. (a -> b) -> a -> b
$ ByteString
toks)
          (forall a. a -> Set a
E.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty Char -> ErrorItem t
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ String
"decimal number from 0 to 255")
    ipv4Address :: m ()
ipv4Address =
      forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 (m ()
octet forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
octet
    ipv6Address :: m ()
ipv6Address = do
      Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      (ByteString
toks, [[Token ByteString]]
xs) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match forall a b. (a -> b) -> a -> b
$ do
        [[Token ByteString]]
xs' <- forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"::")
        [[Token ByteString]]
xs <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58) forall a b. (a -> b) -> a -> b
$ do
          (Bool
skip, Bool
hasMore) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ do
            Bool
skip <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
            Bool
hasMore <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar)
            forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
skip, Bool
hasMore)
          case (Bool
skip, Bool
hasMore) of
            (Bool
True, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
            (Bool
True, Bool
False) -> [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58
            (Bool
False, Bool
_) -> forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' Int
1 Int
4 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
        forall (m :: * -> *) a. Monad m => a -> m a
return ([[Token ByteString]]
xs' forall a. [a] -> [a] -> [a]
++ [[Token ByteString]]
xs)
      let nskips :: Int
nskips = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Token ByteString]]
xs)
          npieces :: Int
npieces = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token ByteString]]
xs
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
nskips forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
&& (Int
npieces forall a. Eq a => a -> a -> Bool
== Int
8 Bool -> Bool -> Bool
|| (Int
nskips forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
npieces forall a. Ord a => a -> a -> Bool
< Int
8))) forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
        forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall a b. (a -> b) -> a -> b
$ ByteString
toks)
          (forall a. a -> Set a
E.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty Char -> ErrorItem t
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ String
"valid IPv6 address")
    ipvFuture :: m ()
ipvFuture = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
118)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46)
      forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
    regName :: m [Word8]
regName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [[a]] -> [a]
intercalate [Word8
46]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46) forall a b. (a -> b) -> a -> b
$ do
      let ch :: m Word8
ch = forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar
      Maybe Word8
mx <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Word8
ch
      case Maybe Word8
mx of
        Maybe Word8
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just Word8
x -> do
          let r :: m Word8
r =
                m Word8
ch
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
                    (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (m Word8
ch forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45))
          [Word8]
xs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Word8
r
          forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
x forall a. a -> [a] -> [a]
: [Word8]
xs)

pUserInfo :: MonadParsec e ByteString m => m UserInfo
pUserInfo :: forall e (m :: * -> *). MonadParsec e ByteString m => m UserInfo
pUserInfo = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  RText 'Username
uiUsername <-
    forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR
      String
"username"
      forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Username)
mkUsername
      ( forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"username" forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar)
      )
  Maybe (RText 'Password)
uiPassword <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
    forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR
      String
"password"
      forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Password)
mkPassword
      (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58))
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64)
  forall (m :: * -> *) a. Monad m => a -> m a
return UserInfo {Maybe (RText 'Password)
RText 'Username
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
..}
{-# INLINE pUserInfo #-}

pPath ::
  MonadParsec e ByteString m =>
  Bool ->
  m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath Bool
hasAuth = do
  Bool
doubleSlash <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"//"))
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doubleSlash Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasAuth) forall a b. (a -> b) -> a -> b
$
    (forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList) [Token ByteString
47, Token ByteString
47]
  Bool
absPath <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47)
  let mkPathPiece' :: Text -> Maybe (Maybe (RText 'PathPiece))
mkPathPiece' Text
x =
        if Text -> Bool
T.null Text
x
          then forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
          else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => Text -> m (RText 'PathPiece)
mkPathPiece Text
x
  ([Maybe (RText 'PathPiece)]
maybePieces, Bool
trailingSlash) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Bool
False forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47) forall a b. (a -> b) -> a -> b
$
      forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"path piece" Text -> Maybe (Maybe (RText 'PathPiece))
mkPathPiece' forall a b. (a -> b) -> a -> b
$
        forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"path piece" forall a b. (a -> b) -> a -> b
$ do
          [Word8]
x <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar
          forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
x)
          forall (m :: * -> *) a. Monad m => a -> m a
return [Word8]
x
  let pieces :: [RText 'PathPiece]
pieces = forall a. [Maybe a] -> [a]
catMaybes [Maybe (RText 'PathPiece)]
maybePieces
  forall (m :: * -> *) a. Monad m => a -> m a
return
    ( Bool
absPath,
      case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [RText 'PathPiece]
pieces of
        Maybe (NonEmpty (RText 'PathPiece))
Nothing -> forall a. Maybe a
Nothing
        Just NonEmpty (RText 'PathPiece)
ps -> forall a. a -> Maybe a
Just (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
ps)
    )
{-# INLINE pPath #-}

pQuery :: MonadParsec e ByteString m => m [QueryParam]
pQuery :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
m [QueryParam]
pQuery = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
38))
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
38) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"query parameter" forall a b. (a -> b) -> a -> b
$ do
    let p :: m [Word8]
p = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63)
    RText 'QueryKey
k <- forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"query key" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryKey)
mkQueryKey m [Word8]
p
    Maybe (RText 'QueryValue)
mv <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
61 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"query value" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryValue)
mkQueryValue m [Word8]
p)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      if Text -> Bool
T.null (forall (l :: RTextLabel). RText l -> Text
unRText RText 'QueryKey
k)
        then forall a. Maybe a
Nothing
        else
          forall a. a -> Maybe a
Just
            ( case Maybe (RText 'QueryValue)
mv of
                Maybe (RText 'QueryValue)
Nothing -> RText 'QueryKey -> QueryParam
QueryFlag RText 'QueryKey
k
                Just RText 'QueryValue
v -> RText 'QueryKey -> RText 'QueryValue -> QueryParam
QueryParam RText 'QueryKey
k RText 'QueryValue
v
            )
{-# INLINE pQuery #-}

pFragment :: MonadParsec e ByteString m => m (RText 'Fragment)
pFragment :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Fragment)
pFragment = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
35)
  forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR
    String
"fragment"
    forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Fragment)
mkFragment
    ( forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"fragment character" forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63
    )
{-# INLINE pFragment #-}

----------------------------------------------------------------------------
-- Helpers

-- | Lift a smart constructor that consumes 'Text' into a parser.
liftR ::
  MonadParsec e ByteString m =>
  -- | What is being parsed
  String ->
  -- | The smart constructor that produces the result
  (Text -> Maybe r) ->
  -- | How to parse @['Word8']@ that will be converted to 'Text' and fed to
  -- the smart constructor
  m [Word8] ->
  m r
liftR :: forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
lbl Text -> Maybe r
f m [Word8]
p = do
  Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (ByteString
toks, [Word8]
s) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m [Word8]
p
  case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ([Word8] -> ByteString
B.pack [Word8]
s) of
    Left UnicodeException
_ -> do
      let unexp :: NonEmpty Word8
unexp = forall a. [a] -> NonEmpty a
NE.fromList (ByteString -> [Word8]
B.unpack ByteString
toks)
          expecting :: NonEmpty Char
expecting = forall a. [a] -> NonEmpty a
NE.fromList (String
lbl forall a. [a] -> [a] -> [a]
++ String
" that can be decoded as UTF-8")
      forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError
        ( forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError
            Int
o
            (forall a. a -> Maybe a
Just (forall t. NonEmpty t -> ErrorItem t
Tokens NonEmpty Word8
unexp))
            (forall a. a -> Set a
S.singleton (forall t. NonEmpty Char -> ErrorItem t
Label NonEmpty Char
expecting))
        )
    Right Text
text -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe r
f Text
text)
{-# INLINE liftR #-}

asciiAlphaChar :: MonadParsec e ByteString m => m Word8
asciiAlphaChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaChar = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Word8 -> Bool
isAsciiAlpha forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ASCII alpha character"
{-# INLINE asciiAlphaChar #-}

asciiAlphaNumChar :: MonadParsec e ByteString m => m Word8
asciiAlphaNumChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Word8 -> Bool
isAsciiAlphaNum forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ASCII alpha-numeric character"
{-# INLINE asciiAlphaNumChar #-}

unreservedChar :: MonadParsec e ByteString m => m Word8
unreservedChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unreserved character" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ \Word8
x ->
  Word8 -> Bool
isAsciiAlphaNum Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
46 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
95 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
126
{-# INLINE unreservedChar #-}

percentEncChar :: MonadParsec e ByteString m => m Word8
percentEncChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
37)
  Word8
h <- Word8 -> Word8
restoreDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
  Word8
l <- Word8 -> Word8
restoreDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
h forall a. Num a => a -> a -> a
* Word8
16 forall a. Num a => a -> a -> a
+ Word8
l)
{-# INLINE percentEncChar #-}

subDelimChar :: MonadParsec e ByteString m => m Word8
subDelimChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set (Token ByteString)
s forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sub-delimiter"
  where
    s :: Set (Token ByteString)
s = forall a. Ord a => [a] -> Set a
E.fromList (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
"!$&'()*+,;=")
{-# INLINE subDelimChar #-}

pchar :: MonadParsec e ByteString m => m Word8
pchar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar,
      forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar,
      forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar,
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58,
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64
    ]
{-# INLINE pchar #-}

pchar' :: MonadParsec e ByteString m => m Word8
pchar' :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar' =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar,
      forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar,
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
43 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
32,
      forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set (Token ByteString)
s forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sub-delimiter",
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58,
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64
    ]
  where
    s :: Set (Token ByteString)
s = forall a. Ord a => [a] -> Set a
E.fromList (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
"!$'()*,;")
{-# INLINE pchar' #-}

isAsciiAlpha :: Word8 -> Bool
isAsciiAlpha :: Word8 -> Bool
isAsciiAlpha Word8
x
  | Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True
  | Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True
  | Bool
otherwise = Bool
False

isAsciiAlphaNum :: Word8 -> Bool
isAsciiAlphaNum :: Word8 -> Bool
isAsciiAlphaNum Word8
x
  | Word8 -> Bool
isAsciiAlpha Word8
x = Bool
True
  | Word8
48 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True
  | Bool
otherwise = Bool
False

restoreDigit :: Word8 -> Word8
restoreDigit :: Word8 -> Word8
restoreDigit Word8
x
  | Word8
48 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
57 = Word8
x forall a. Num a => a -> a -> a
- Word8
48
  | Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
70 = Word8
x forall a. Num a => a -> a -> a
- Word8
55
  | Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
102 = Word8
x forall a. Num a => a -> a -> a
- Word8
87
  | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Text.URI.Parser.restoreDigit: bad input"