--------------------------------------------------------------------------------
-- |
-- 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
$cp1Ord :: Eq Host
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
$cp1Ord :: Eq Protocol
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 s :: Bool
s)     = Bool
s
secure_prot (FTP s :: Bool
s)      = Bool
s
secure_prot (RawProt _)  = 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
$cp1Ord :: Eq URLType
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
$cp1Ord :: Eq URL
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
url x :: (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 cs0 :: String
cs0 =
  do (ho :: URLType
ho,cs5 :: String
cs5) <- String -> Maybe (URLType, String)
front String
cs0
     (pa :: String
pa,cs6 :: 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 ('/':cs :: String
cs)  = (URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (URLType
HostRelative,String
cs)
  front cs :: String
cs =
    case String -> Maybe (Protocol, String)
the_prot String
cs of
      Just (pr :: Protocol
pr,cs1 :: String
cs1) ->
        do let (ho :: String
ho,cs2 :: String
cs2) = String -> (String, String)
the_host String
cs1
           (po :: Maybe Integer
po,cs3 :: 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 []
                    '/':cs5 :: String
cs5 -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs5
                    _ -> 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)
      _ -> (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 urlStr :: String
urlStr = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
urlStr of
     (as :: String
as@(_:_), ':' : '/' : '/' : bs :: 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
                      "https" -> Bool -> Protocol
HTTP Bool
True
                      "http"  -> Bool -> Protocol
HTTP Bool
False
                      "ftps"  -> Bool -> Protocol
FTP  Bool
True
                      "ftp"   -> Bool -> Protocol
FTP  Bool
False
                      _       -> String -> Protocol
RawProt String
as
     _                                -> 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 (':':cs :: String
cs)     = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs of
                            ([],_)   -> Maybe (Maybe a, String)
forall a. Maybe a
Nothing
                            (xs :: String
xs,ds :: 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 cs5 :: 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 cs :: String
cs = do let (as :: String
as,bs :: 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 c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '?'

  the_args :: String -> Maybe [(String, String)]
the_args ('?' : cs :: String
cs)   = String -> Maybe [(String, String)]
importParams String
cs
  the_args _            = [(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 ds :: 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 -> Bool
forall a. Eq a => a -> a -> Bool
==) String
ds)
  where
  a_param :: String -> Maybe (String, String)
a_param cs :: String
cs = do let (as :: String
as,bs :: String
bs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ('=' 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 -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
                         _:xs :: 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 absol :: Host
absol = String
the_prot String -> ShowS
forall a. [a] -> [a] -> [a]
++ "://" 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 "" (\x :: Integer
x -> ':' 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 prot :: Protocol
prot = case Protocol
prot of
  HTTP True   -> "https"
  HTTP False  -> "http"
  FTP  True   -> "ftps"
  FTP  False  -> "ftp"
  RawProt s :: 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
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 hst :: Host
hst -> Host -> String
exportHost Host
hst String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/"
                  HostRelative  -> "/"
                  PathRelative  -> ""

  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
                  [] -> ""
                  xs :: [(String, String)]
xs -> '?' Char -> ShowS
forall a. a -> [a] -> [a]
: [(String, String)] -> String
exportParams [(String, String)]
xs

exportParams :: [(String,String)] -> String
exportParams :: [(String, String)] -> String
exportParams ps :: [(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]
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 (k :: String
k,mv :: 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
                      "" -> ""
                      v :: String
v  -> '=' 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 pl :: Bool
pl p :: Char -> Bool
p ys :: 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 ' ' xs :: String
xs | Bool
pl = '+' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
        enc1 x :: Char
x xs :: 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 c :: 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 b :: Word8
b = '%' Char -> ShowS
forall a. a -> [a] -> [a]
: case Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
b "" of
                    d :: String
d@[_] -> '0' Char -> ShowS
forall a. a -> [a] -> [a]
: String
d
                    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 b :: 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 _ []          = [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just []
decStrBytes p :: Bool
p ('%' : cs :: String
cs)  = do (n :: Word8
n,cs1 :: 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 p :: Bool
p (c :: Char
c : cs :: String
cs)    = let b :: Word8
b = if Bool
p Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '+'
                                       then 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 (x :: Char
x : y :: Char
y : cs :: String
cs)  = case ReadS Word8
forall a. (Eq a, Num a) => ReadS a
readHex [Char
x,Char
y] of
                          [(n :: Word8
n,"")] -> (Word8, String) -> Maybe (Word8, String)
forall a. a -> Maybe a
Just (Word8
n,String
cs)
                          _ -> Maybe (Word8, String)
forall a. Maybe a
Nothing
decByte _             = 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 c :: 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
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'

ok_param :: Char -> Bool
ok_param :: Char -> Bool
ok_param c :: 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` "~;:@$_!*'(),"

-- | Characters that can appear non % encoded in the path part of the URL
ok_path :: Char -> Bool
ok_path :: Char -> Bool
ok_path c :: 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` "/=&"

-- XXX: others? check RFC
-- | Characters that do not need to be encoded in URL
ok_url :: Char -> Bool
ok_url :: Char -> Bool
ok_url c :: 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` ".-;:@$_!*'(),/=&?~+"

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

breaks :: (a -> Bool) -> [a] -> [[a]]
breaks :: (a -> Bool) -> [a] -> [[a]]
breaks p :: a -> Bool
p xs :: [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs of
                (as :: [a]
as,[])   -> [[a]
as]
                (as :: [a]
as,_:bs :: [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