module Network.Web.URI (
URI, uriScheme, uriAuthority, uriPath, uriQuery, uriFragment
, URIAuth, uriUserInfo, uriRegName, uriPort
, parseURI
, uriHostName, uriPortNumber, toURL, toURLwoPort, toURLPath
, isAbsoluteURI, unEscapeString, unEscapeByteString
) where
import qualified Data.ByteString.Char8 as S
import Data.Char
data URI = URI {
uriScheme :: S.ByteString
, uriAuthority :: Maybe URIAuth
, uriPath :: S.ByteString
, uriQuery :: S.ByteString
, uriFragment :: S.ByteString
} deriving Show
data URIAuth = URIAuth {
uriUserInfo :: S.ByteString
, uriRegName :: S.ByteString
, uriPort :: S.ByteString
} deriving Show
parseURI :: S.ByteString -> Maybe URI
parseURI url = Just URI {
uriScheme = "http:"
, uriAuthority = Just URIAuth {
uriUserInfo = ""
, uriRegName = host
, uriPort = port
}
, uriPath = path
, uriQuery = query
, uriFragment = ""
}
where
(auth,pathQuery) = parseURL url
(path,query) = parsePathQuery pathQuery
(host,port) = parseAuthority auth
parseURL :: S.ByteString -> (S.ByteString,S.ByteString)
parseURL reqUri = let (hostServ,path) = S.break (=='/') $ S.drop 7 reqUri
in (hostServ, checkPath path)
where
checkPath "" = "/"
checkPath path = path
parsePathQuery :: S.ByteString -> (S.ByteString,S.ByteString)
parsePathQuery = S.break (=='?')
parseAuthority :: S.ByteString -> (S.ByteString,S.ByteString)
parseAuthority hostServ
| serv == "" = (host, "")
| otherwise = (host, S.tail serv)
where
(host,serv) = S.break (==':') hostServ
uriHostName :: URI -> S.ByteString
uriHostName uri = maybe "" uriRegName $ uriAuthority uri
uriPortNumber :: URI -> S.ByteString
uriPortNumber uri = maybe "" uriPort $ uriAuthority uri
toURL :: URI -> S.ByteString
toURL uri = uriScheme uri +++ "//" +++ hostServ +++ uriPath uri +++ uriQuery uri
where
host = uriHostName uri
serv = uriPortNumber uri
hostServ = if S.null serv
then host
else host +++ ":" +++ serv
(+++) = S.append
toURLwoPort :: URI -> S.ByteString
toURLwoPort uri = uriScheme uri +++ "//" +++ uriHostName uri +++ uriPath uri +++ uriQuery uri
where
(+++) = S.append
toURLPath :: URI -> S.ByteString
toURLPath uri = uriScheme uri +++ "//" +++ uriHostName uri +++ uriPath uri
where
(+++) = S.append
isAbsoluteURI :: S.ByteString -> Bool
isAbsoluteURI url = "http://" `S.isPrefixOf` url
unEscapeByteString :: S.ByteString -> S.ByteString
unEscapeByteString "" = ""
unEscapeByteString bs
| S.head bs == '%' && S.length bs >= 3
&& isHexDigit c1 && isHexDigit c2 = dc <:> unEscapeByteString cs
where
[_,c1,c2] = S.unpack $ S.take 3 bs
cs = S.drop 3 bs
dc = chr $ digitToInt c1 * 16 + digitToInt c2
(<:>) = S.cons
unEscapeByteString bs = c <:> unEscapeByteString cs
where
c = S.head bs
cs = S.tail bs
(<:>) = S.cons
unEscapeString :: String -> String
unEscapeString [] = ""
unEscapeString ('%':c1:c2:cs)
| isHexDigit c1 && isHexDigit c2 = dc : unEscapeString cs
where
dc = chr $ digitToInt c1 * 16 + digitToInt c2
unEscapeString (c:cs) = c : unEscapeString cs