--------------------------------------------------------------------------------
-- |
-- Module      : Network.URL
-- Copyright   : (c) Galois, Inc. 2007, 2008
-- License     : BSD3
--
-- Maintainer  : Iavor S. Diatchki
-- Stability   : Provisional
-- Portability : Portable
--
-- Provides a convenient way for working with HTTP URLs.
-- Based on RFC 1738.
-- See also: RFC 3986

module Network.URL
  ( URL(..), URLType(..), Host(..), Protocol(..)
  , secure, secure_prot
  , exportURL, importURL, exportHost
  , add_param
  , decString, encString
  , ok_host, ok_url, ok_param, ok_path
  , exportParams, importParams
  ) where

import Data.Char (isAlpha, isAscii, isDigit)
import Data.List (intersperse)
import Data.Word (Word8)
import Numeric   (readHex, showHex)

import qualified Codec.Binary.UTF8.String as UTF8


-- | Contains information about the connection to the host.
data Host     = Host { Host -> Protocol
protocol :: Protocol
                     , Host -> String
host     :: String
                     , Host -> Maybe Integer
port     :: Maybe Integer
                     } deriving (Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c== :: Host -> Host -> Bool
Eq,Eq Host
Eq Host
-> (Host -> Host -> Ordering)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Host)
-> (Host -> Host -> Host)
-> Ord Host
Host -> Host -> Bool
Host -> Host -> Ordering
Host -> Host -> Host
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Host -> Host -> Host
$cmin :: Host -> Host -> Host
max :: Host -> Host -> Host
$cmax :: Host -> Host -> Host
>= :: Host -> Host -> Bool
$c>= :: Host -> Host -> Bool
> :: Host -> Host -> Bool
$c> :: Host -> Host -> Bool
<= :: Host -> Host -> Bool
$c<= :: Host -> Host -> Bool
< :: Host -> Host -> Bool
$c< :: Host -> Host -> Bool
compare :: Host -> Host -> Ordering
$ccompare :: Host -> Host -> Ordering
Ord,Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
(Int -> Host -> ShowS)
-> (Host -> String) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> String
$cshow :: Host -> String
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show)

-- | The type of known protocols.
data Protocol = HTTP Bool | FTP Bool | RawProt String deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq,Eq Protocol
Eq Protocol
-> (Protocol -> Protocol -> Ordering)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Protocol)
-> (Protocol -> Protocol -> Protocol)
-> Ord Protocol
Protocol -> Protocol -> Bool
Protocol -> Protocol -> Ordering
Protocol -> Protocol -> Protocol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Protocol -> Protocol -> Protocol
$cmin :: Protocol -> Protocol -> Protocol
max :: Protocol -> Protocol -> Protocol
$cmax :: Protocol -> Protocol -> Protocol
>= :: Protocol -> Protocol -> Bool
$c>= :: Protocol -> Protocol -> Bool
> :: Protocol -> Protocol -> Bool
$c> :: Protocol -> Protocol -> Bool
<= :: Protocol -> Protocol -> Bool
$c<= :: Protocol -> Protocol -> Bool
< :: Protocol -> Protocol -> Bool
$c< :: Protocol -> Protocol -> Bool
compare :: Protocol -> Protocol -> Ordering
$ccompare :: Protocol -> Protocol -> Ordering
Ord,Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show)

-- | Is this a \"secure\" protocol.  This works only for known protocols,
-- for 'RawProt' values we return 'False'.
secure_prot :: Protocol -> Bool
secure_prot :: Protocol -> Bool
secure_prot (HTTP Bool
s)     = Bool
s
secure_prot (FTP Bool
s)      = Bool
s
secure_prot (RawProt String
_)  = Bool
False

-- | Does this host use a \"secure\" protocol (e.g., https).
secure :: Host -> Bool
secure :: Host -> Bool
secure = Protocol -> Bool
secure_prot (Protocol -> Bool) -> (Host -> Protocol) -> Host -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Protocol
protocol

-- | Different types of URL.
data URLType  = Absolute Host       -- ^ Has a host
              | HostRelative        -- ^ Does not have a host
              | PathRelative        -- ^ Relative to another URL
                deriving (URLType -> URLType -> Bool
(URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool) -> Eq URLType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URLType -> URLType -> Bool
$c/= :: URLType -> URLType -> Bool
== :: URLType -> URLType -> Bool
$c== :: URLType -> URLType -> Bool
Eq, Eq URLType
Eq URLType
-> (URLType -> URLType -> Ordering)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> URLType)
-> (URLType -> URLType -> URLType)
-> Ord URLType
URLType -> URLType -> Bool
URLType -> URLType -> Ordering
URLType -> URLType -> URLType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URLType -> URLType -> URLType
$cmin :: URLType -> URLType -> URLType
max :: URLType -> URLType -> URLType
$cmax :: URLType -> URLType -> URLType
>= :: URLType -> URLType -> Bool
$c>= :: URLType -> URLType -> Bool
> :: URLType -> URLType -> Bool
$c> :: URLType -> URLType -> Bool
<= :: URLType -> URLType -> Bool
$c<= :: URLType -> URLType -> Bool
< :: URLType -> URLType -> Bool
$c< :: URLType -> URLType -> Bool
compare :: URLType -> URLType -> Ordering
$ccompare :: URLType -> URLType -> Ordering
Ord, Int -> URLType -> ShowS
[URLType] -> ShowS
URLType -> String
(Int -> URLType -> ShowS)
-> (URLType -> String) -> ([URLType] -> ShowS) -> Show URLType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URLType] -> ShowS
$cshowList :: [URLType] -> ShowS
show :: URLType -> String
$cshow :: URLType -> String
showsPrec :: Int -> URLType -> ShowS
$cshowsPrec :: Int -> URLType -> ShowS
Show)

-- | A type for working with URL.
-- The parameters are in @application\/x-www-form-urlencoded@ format:
-- <http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1>
data URL = URL
            { URL -> URLType
url_type    :: URLType
            , URL -> String
url_path    :: String
            , URL -> [(String, String)]
url_params  :: [(String,String)]
            } deriving (URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq,Eq URL
Eq URL
-> (URL -> URL -> Ordering)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> URL)
-> (URL -> URL -> URL)
-> Ord URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord,Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show)

-- | Add a (key,value) parameter to a URL.
add_param :: URL -> (String,String) -> URL
add_param :: URL -> (String, String) -> URL
add_param URL
url (String, String)
x = URL
url { url_params :: [(String, String)]
url_params = (String, String)
x (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: URL -> [(String, String)]
url_params URL
url }


-- | Convert a list of \"bytes\" to a URL.
importURL :: String -> Maybe URL
importURL :: String -> Maybe URL
importURL String
cs0 =
  do (URLType
ho,String
cs5) <- String -> Maybe (URLType, String)
front String
cs0
     (String
pa,String
cs6) <- String -> Maybe (String, String)
the_path String
cs5
     [(String, String)]
as       <- String -> Maybe [(String, String)]
the_args String
cs6
     URL -> Maybe URL
forall (m :: * -> *) a. Monad m => a -> m a
return URL :: URLType -> String -> [(String, String)] -> URL
URL { url_type :: URLType
url_type = URLType
ho, url_path :: String
url_path = String
pa, url_params :: [(String, String)]
url_params = [(String, String)]
as }

  where
  front :: String -> Maybe (URLType, String)
front (Char
'/':String
cs)  = (URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (URLType
HostRelative,String
cs)
  front String
cs =
    case String -> Maybe (Protocol, String)
the_prot String
cs of
      Just (Protocol
pr,String
cs1) ->
        do let (String
ho,String
cs2) = String -> (String, String)
the_host String
cs1
           (Maybe Integer
po,String
cs3) <- String -> Maybe (Maybe Integer, String)
forall {a}. Read a => String -> Maybe (Maybe a, String)
the_port String
cs2
           String
cs4 <- case String
cs3 of
                    [] -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    Char
'/':String
cs5 -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs5
                    String
_ -> Maybe String
forall a. Maybe a
Nothing
           (URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Host -> URLType
Absolute Host :: Protocol -> String -> Maybe Integer -> Host
Host { protocol :: Protocol
protocol = Protocol
pr
                                 , host :: String
host = String
ho
                                 , port :: Maybe Integer
port = Maybe Integer
po
                                 }, String
cs4)
      Maybe (Protocol, String)
_ -> (URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (URLType
PathRelative,String
cs)

  the_prot :: String -> Maybe (Protocol, String)
  the_prot :: String -> Maybe (Protocol, String)
the_prot String
urlStr = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
urlStr of
     (as :: String
as@(Char
_:String
_), Char
':' : Char
'/' : Char
'/' : String
bs) -> (Protocol, String) -> Maybe (Protocol, String)
forall a. a -> Maybe a
Just (Protocol
prot, String
bs)
       where prot :: Protocol
prot = case String
as of
                      String
"https" -> Bool -> Protocol
HTTP Bool
True
                      String
"http"  -> Bool -> Protocol
HTTP Bool
False
                      String
"ftps"  -> Bool -> Protocol
FTP  Bool
True
                      String
"ftp"   -> Bool -> Protocol
FTP  Bool
False
                      String
_       -> String -> Protocol
RawProt String
as
     (String, String)
_                                -> Maybe (Protocol, String)
forall a. Maybe a
Nothing

  the_host :: String -> (String, String)
the_host = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
ok_host

  the_port :: String -> Maybe (Maybe a, String)
the_port (Char
':':String
cs)     = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs of
                            ([],String
_)   -> Maybe (Maybe a, String)
forall a. Maybe a
Nothing
                            (String
xs,String
ds) -> (Maybe a, String) -> Maybe (Maybe a, String)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read String
xs),String
ds)
  the_port String
cs5          = (Maybe a, String) -> Maybe (Maybe a, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, String
cs5)

  the_path :: String -> Maybe (String, String)
the_path String
cs = do let (String
as,String
bs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
end_path String
cs
                   String
s <- Bool -> String -> Maybe String
decString Bool
False String
as
                   (String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s,String
bs)
    where end_path :: Char -> Bool
end_path Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'

  the_args :: String -> Maybe [(String, String)]
the_args (Char
'?' : String
cs)   = String -> Maybe [(String, String)]
importParams String
cs
  the_args String
_            = [(String, String)] -> Maybe [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []


importParams :: String -> Maybe [(String,String)]
importParams :: String -> Maybe [(String, String)]
importParams [] = [(String, String)] -> Maybe [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
importParams String
ds = (String -> Maybe (String, String))
-> [String] -> Maybe [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Maybe (String, String)
a_param ((Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
breaks (Char
'&'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
ds)
  where
  a_param :: String -> Maybe (String, String)
a_param String
cs = do let (String
as,String
bs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
'=' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
cs
                  String
k <- Bool -> String -> Maybe String
decString Bool
True String
as
                  String
v <- case String
bs of
                         String
"" -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                         Char
_:String
xs -> Bool -> String -> Maybe String
decString Bool
True String
xs
                  (String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
k,String
v)


-- | Convert the host part of a URL to a list of \"bytes\".
exportHost :: Host -> String
exportHost :: Host -> String
exportHost Host
absol = String
the_prot String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Host -> String
host Host
absol String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
the_port
  where the_prot :: String
the_prot  = Protocol -> String
exportProt (Host -> Protocol
protocol Host
absol)
        the_port :: String
the_port  = String -> (Integer -> String) -> Maybe Integer -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Integer
x -> Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
x) (Host -> Maybe Integer
port Host
absol)

-- | Convert the host part of a URL to a list of \"bytes\".
-- WARNING: We output \"raw\" protocols as they are.
exportProt :: Protocol -> String
exportProt :: Protocol -> String
exportProt Protocol
prot = case Protocol
prot of
  HTTP Bool
True   -> String
"https"
  HTTP Bool
False  -> String
"http"
  FTP  Bool
True   -> String
"ftps"
  FTP  Bool
False  -> String
"ftp"
  RawProt String
s   -> String
s


-- | Convert a URL to a list of \"bytes\".
-- We represent non-ASCII characters using UTF8.
exportURL :: URL -> String
exportURL :: URL -> String
exportURL URL
url = String
absol String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
the_path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
the_params
  where
  absol :: String
absol       = case URL -> URLType
url_type URL
url of
                  Absolute Host
hst -> Host -> String
exportHost Host
hst String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
                  URLType
HostRelative  -> String
"/"
                  URLType
PathRelative  -> String
""

  the_path :: String
the_path    = Bool -> (Char -> Bool) -> ShowS
encString Bool
False Char -> Bool
ok_path (URL -> String
url_path URL
url)
  the_params :: String
the_params  = case URL -> [(String, String)]
url_params URL
url of
                  [] -> String
""
                  [(String, String)]
xs -> Char
'?' Char -> ShowS
forall a. a -> [a] -> [a]
: [(String, String)] -> String
exportParams [(String, String)]
xs

exportParams :: [(String,String)] -> String
exportParams :: [(String, String)] -> String
exportParams [(String, String)]
ps = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"&" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
a_param [(String, String)]
ps)
  where
  a_param :: (String, String) -> String
a_param (String
k,String
mv)  = Bool -> (Char -> Bool) -> ShowS
encString Bool
True Char -> Bool
ok_param String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    case String
mv of
                      String
"" -> String
""
                      String
v  -> Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> (Char -> Bool) -> ShowS
encString Bool
True Char -> Bool
ok_param String
v





-- | Convert a string to bytes by escaping the characters that
-- do not satisfy the input predicate.  The first argument specifies
-- if we should replace spaces with +.
encString :: Bool -> (Char -> Bool) -> String -> String
encString :: Bool -> (Char -> Bool) -> ShowS
encString Bool
pl Char -> Bool
p String
ys = (Char -> ShowS) -> String -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
enc1 [] String
ys
  where enc1 :: Char -> ShowS
enc1 Char
' ' String
xs | Bool
pl = Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
        enc1 Char
x String
xs = if Char -> Bool
p Char
x then Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs else Char -> String
encChar Char
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs

-- | %-encode a character. Uses UTF8 to represent characters as bytes.
encChar :: Char -> String
encChar :: Char -> String
encChar Char
c = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
encByte (String -> [Word8]
UTF8.encode [Char
c])

-- | %-encode a byte.
encByte :: Word8 -> String
encByte :: Word8 -> String
encByte Word8
b = Char
'%' Char -> ShowS
forall a. a -> [a] -> [a]
: case Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
b String
"" of
                    d :: String
d@[Char
_] -> Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: String
d
                    String
d     -> String
d

-- | Decode a list of \"bytes\" to a string.
-- Performs % and UTF8 decoding.
decString :: Bool -> String -> Maybe String
decString :: Bool -> String -> Maybe String
decString Bool
b = ([Word8] -> String) -> Maybe [Word8] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> String
UTF8.decode (Maybe [Word8] -> Maybe String)
-> (String -> Maybe [Word8]) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Maybe [Word8]
decStrBytes Bool
b

-- Convert a list of \"bytes\" to actual bytes.
-- Performs %-decoding.  The boolean specifies if we should turn pluses into
-- spaces.
decStrBytes :: Bool -> String -> Maybe [Word8]
decStrBytes :: Bool -> String -> Maybe [Word8]
decStrBytes Bool
_ []          = [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just []
decStrBytes Bool
p (Char
'%' : String
cs)  = do (Word8
n,String
cs1) <- String -> Maybe (Word8, String)
decByte String
cs
                               ([Word8] -> [Word8]) -> Maybe [Word8] -> Maybe [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8
nWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:) (Bool -> String -> Maybe [Word8]
decStrBytes Bool
p String
cs1)
decStrBytes Bool
p (Char
c : String
cs)    = let b :: Word8
b = if Bool
p Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
                                       then Word8
32    -- space
                                       else Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c)
                            in (Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:) ([Word8] -> [Word8]) -> Maybe [Word8] -> Maybe [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Bool -> String -> Maybe [Word8]
decStrBytes Bool
p String
cs
                            -- truncates "large bytes".


-- | Parse a percent-encoded byte.
decByte :: String -> Maybe (Word8,String)
decByte :: String -> Maybe (Word8, String)
decByte (Char
x : Char
y : String
cs)  = case ReadS Word8
forall a. (Eq a, Num a) => ReadS a
readHex [Char
x,Char
y] of
                          [(Word8
n,String
"")] -> (Word8, String) -> Maybe (Word8, String)
forall a. a -> Maybe a
Just (Word8
n,String
cs)
                          [(Word8, String)]
_ -> Maybe (Word8, String)
forall a. Maybe a
Nothing
decByte String
_             = Maybe (Word8, String)
forall a. Maybe a
Nothing



-- Classification of characters.
-- Note that these only return True for ASCII characters; this is important.
--------------------------------------------------------------------------------
ok_host :: Char -> Bool
ok_host :: Char -> Bool
ok_host Char
c   = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaASCII Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

ok_param :: Char -> Bool
ok_param :: Char -> Bool
ok_param Char
c  = Char -> Bool
ok_host Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"~;:@$_!*'(),"

-- | Characters that can appear non % encoded in the path part of the URL
ok_path :: Char -> Bool
ok_path :: Char -> Bool
ok_path Char
c   = Char -> Bool
ok_param Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"/=&"

-- XXX: others? check RFC
-- | Characters that do not need to be encoded in URL
ok_url :: Char -> Bool
ok_url :: Char -> Bool
ok_url Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaASCII Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
".-;:@$_!*'(),/=&?~+"

-- Misc
--------------------------------------------------------------------------------
isAlphaASCII :: Char -> Bool
isAlphaASCII :: Char -> Bool
isAlphaASCII Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x

breaks :: (a -> Bool) -> [a] -> [[a]]
breaks :: forall a. (a -> Bool) -> [a] -> [[a]]
breaks a -> Bool
p [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs of
                ([a]
as,[])   -> [[a]
as]
                ([a]
as,a
_:[a]
bs) -> [a]
as [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
breaks a -> Bool
p [a]
bs