uri-bytestring (empty) → 0.0.1

raw patch · 9 files changed

+1045/−0 lines, 9 filesdep +HUnitdep +QuickCheckdep +attoparsecsetup-changed

Dependencies added: HUnit, QuickCheck, attoparsec, base, bytestring, criterion, deepseq, deepseq-generics, derive, network-uri, tasty, tasty-hunit, tasty-quickcheck, uri-bytestring

Files

• LICENSE +28/−0
• README.md +4/−0
• Setup.hs +2/−0
• bench/Main.hs +56/−0
• changelog.md +3/−0
• licenses/http-types/LICENSE +31/−0
• src/URI/ByteString.hs +834/−0
• test/Main.hs +11/−0
• uri-bytestring.cabal +76/−0

@@ -0,0 +1,28 @@+Copyright (c) 2014, Soostone Inc+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the {organization} nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,4 @@+# uri-bytestring+[![Build Status](https://travis-ci.org/Soostone/uri-bytestring.svg)](https://travis-ci.org/Soostone/uri-bytestring)++Haskell URI parsing as ByteStrings

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Main (main) where++-------------------------------------------------------------------------------+import           Control.DeepSeq.Generics+import           Criterion.Main+import           Data.ByteString.Builder+import           Data.String+import qualified Network.URI              as NU+-------------------------------------------------------------------------------+import           URI.ByteString+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+instance NFData Authority+instance NFData UserInfo+instance NFData URI+instance NFData NU.URI+instance NFData SchemaError+instance NFData URIParseError+++-------------------------------------------------------------------------------+main :: IO ()+main = defaultMain+  [+    bgroup "parsing"+      [+        bench "Network.URI.parseURI" $ nf NU.parseURI exampleURIS+      , bench "URI.ByteString.parseURI strict" $ nf (parseURI strictURIParserOptions) exampleURIS+      , bench "URI.ByteString.parseURI lax" $ nf (parseURI laxURIParserOptions) exampleURIS+      ]+  , bgroup "serializing"+    [+      bench "URI.ByteString.serializeURI" $ nf (toLazyByteString . serializeURI) exampleURI+    ]+  ]+++exampleURIS :: IsString s => s+exampleURIS = "http://google.com/example?params=youbetcha"+++exampleURI :: URI+exampleURI = URI {+      uriScheme = Scheme "http"+    , uriAuthority = Just Authority {+          authorityUserInfo = Nothing+        , authorityHost = Host "google.com"+        , authorityPort = Nothing+        }+    , uriPath = "/example"+    , uriQuery = Query [("params", "youbetcha")]+    , uriFragment = Nothing+    }

@@ -0,0 +1,3 @@+0.0.1++* Initial release.

@@ -0,0 +1,31 @@+Copyright (c) 2011, Aristid Breitkreuz+Copyright (c) 2011, Michael Snoyman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Aristid Breitkreuz nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,834 @@+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE TupleSections              #-}+{-|++Module      : URI.ByteString+Description : ByteString URI Parser and Serializer+Copyright   : (c) Soostone Inc., 2014+                  Michael Xavier, 2014+License     : BSD3+Maintainer  : michael.xavier@soostone.com+Stability   : experimental++URI.ByteString aims to be an RFC3986 compliant URI parser that uses+efficient ByteStrings for parsing and representing the data. This+module provides a URI datatype as well as a parser and serializer.++Note that this library is an early release and may have issues. It is+currently being used in production and no issues have been+encountered, however. Please report any issues encountered to the+issue tracker.++-}+module URI.ByteString+    (-- * URI-related types+      Scheme(..)+    , Host(..)+    , Port(..)+    , Authority(..)+    , UserInfo(..)+    , Query(..)+    , URI(..)+    , SchemaError(..)+    , URIParseError(..)+    , URIParserOptions(..)+    , strictURIParserOptions+    , laxURIParserOptions+    -- * Parsing+    , parseURI+    -- * Serializing+    , serializeURI+    ) where++-------------------------------------------------------------------------------+import           Control.Applicative+import           Control.Monad+import           Data.Attoparsec.ByteString+import qualified Data.Attoparsec.ByteString as A+import           Data.Bits+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as BS+import           Data.ByteString.Builder    (Builder)+import qualified Data.ByteString.Builder    as BB+import           Data.Char                  (ord)+import           Data.Ix+import           Data.List                  (delete, intersperse, stripPrefix)+import           Data.Maybe+import           Data.Monoid+import           Data.Typeable+import           Data.Word+import           GHC.Generics               (Generic)+import           Text.Read                  (readMaybe)+-------------------------------------------------------------------------------+++-- | Required first component to referring to a specification for the+-- remainder of the URI's components, e.g. "http" or "https"+newtype Scheme = Scheme { getScheme :: ByteString }+  deriving (Show, Eq, Generic, Typeable)+++-------------------------------------------------------------------------------+newtype Host = Host { getHost :: ByteString }+  deriving (Show, Eq, Generic, Typeable)+++-------------------------------------------------------------------------------+-- | While some libraries have chosen to limit this to a Word16, the+-- spec only specifies that the string be comprised of digits.+newtype Port = Port { getPort :: Int }+  deriving (Show, Eq, Generic, Typeable)+++-------------------------------------------------------------------------------+data Authority = Authority {+      authorityUserInfo :: Maybe UserInfo+    , authorityHost     :: Host+    , authorityPort     :: Maybe Port+    } deriving (Show, Eq, Generic, Typeable)+++-------------------------------------------------------------------------------+data UserInfo = UserInfo {+      uiUsername :: ByteString+    , uiPassword :: ByteString+    } deriving (Show, Eq, Generic, Typeable)+++-------------------------------------------------------------------------------+newtype Query = Query { getQuery :: [(ByteString, ByteString)] }+              deriving (Show, Eq, Monoid)+++-------------------------------------------------------------------------------+data URI = URI {+      uriScheme    :: Scheme+    , uriAuthority :: Maybe Authority+    , uriPath      :: ByteString+    , uriQuery     :: Query+    , uriFragment  :: Maybe ByteString+    -- ^ URI fragment. Does not include the #+    } deriving (Show, Eq, Generic, Typeable)++++-------------------------------------------------------------------------------+-- | Options for the parser. You will probably want to use either+-- "strictURIParserOptions" or "laxURIParserOptions"+data URIParserOptions = URIParserOptions {+      upoValidQueryChar :: Word8 -> Bool+    }+++-------------------------------------------------------------------------------+-- | Strict URI Parser config. Follows RFC3986 as-specified. Use this+-- if you can be certain that your URIs are properly encoded or if you+-- want parsing to fail if they deviate from the spec at all.+strictURIParserOptions :: URIParserOptions+strictURIParserOptions =  URIParserOptions {+      upoValidQueryChar = validForQuery+    }+++-------------------------------------------------------------------------------+-- | Lax URI Parser config. Use this if you you want to handle common+-- deviations from the spec gracefully.+--+-- * Allows non-encoded [ and ] in query string+laxURIParserOptions :: URIParserOptions+laxURIParserOptions = URIParserOptions {+      upoValidQueryChar = validForQueryLax+    }++-------------------------------------------------------------------------------+-- | URI Serializer+-------------------------------------------------------------------------------++-- | Serialize a URI into a strict ByteString+-- Example:+--+-- >>> BB.toLazyByteString $ serializeURI $ URI {uriScheme = Scheme {getScheme = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {getHost = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {getQuery = [("bar","baz")]}, uriFragment = Just "quux"}+-- "http://www.example.org/foo?bar=baz#quux"+serializeURI :: URI -> Builder+serializeURI URI {..} = scheme <> BB.string8 "://" <>+                        authority <>+                        path <>+                        query <>+                        fragment+  where+    path = mconcat $ intersperse (c8 '/') $ map urlEncodePath segs+    segs = BS.split slash uriPath+    scheme = bs $ getScheme uriScheme+    authority = maybe mempty serializeAuthority uriAuthority+    query = serializeQuery uriQuery+    fragment = maybe mempty (\s -> c8 '#' <> bs s) uriFragment+++-------------------------------------------------------------------------------+serializeQuery :: Query -> Builder+serializeQuery (Query []) = mempty+serializeQuery (Query ps) =+    c8 '?' <> mconcat (intersperse (c8 '&') (map serializePair ps))+  where+    serializePair (k, v) = urlEncodeQuery k <> c8 '=' <> urlEncodeQuery v+++-------------------------------------------------------------------------------+serializeAuthority :: Authority -> Builder+serializeAuthority Authority {..} = userinfo <> bs host <> port+  where+    userinfo = maybe mempty serializeUserInfo authorityUserInfo+    host = getHost authorityHost+    port = maybe mempty packPort authorityPort+    packPort (Port p) = c8 ':' <> BB.string8 (show p)+++-------------------------------------------------------------------------------+serializeUserInfo :: UserInfo -> Builder+serializeUserInfo UserInfo {..} = bs uiUsername <> c8 ':' <> bs uiPassword+++-------------------------------------------------------------------------------+bs :: ByteString -> Builder+bs = BB.byteString+++-------------------------------------------------------------------------------+c8 :: Char -> Builder+c8 = BB.char8+++-------------------------------------------------------------------------------+-- | URI Parser+-------------------------------------------------------------------------------+++data SchemaError = NonAlphaLeading -- ^ Scheme must start with an alphabet character+                 | InvalidChars    -- ^ Subsequent characters in the schema were invalid+                 | MissingColon    -- ^ Schemas must be followed by a colon+                 deriving (Show, Eq, Read, Generic, Typeable)+++-------------------------------------------------------------------------------+data URIParseError = MalformedScheme SchemaError+                   | MalformedUserInfo+                   | MalformedQuery+                   | MalformedFragment+                   | MalformedHost+                   | MalformedPort+                   | MalformedPath+                   | OtherError String -- ^ Catchall for unpredictable errors+                   deriving (Show, Eq, Generic, Read, Typeable)+++-------------------------------------------------------------------------------+-- | Parse a strict ByteString into a URI or an error.+--+-- Example:+--+-- >>> parseURI strictURIParserOptions "http://www.example.org/foo?bar=baz#quux"+-- Right (URI {uriScheme = Scheme {getScheme = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {getHost = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {getQuery = [("bar","baz")]}, uriFragment = Just "quux"})+--+-- >>> parseURI strictURIParserOptions "$$$$://badurl.example.org"+-- Left (MalformedScheme NonAlphaLeading)+--+-- There are some urls that you'll encounter which defy the spec, such+-- as those with square brackets in the query string. If you must be+-- able to parse those, you can use "laxURIParserOptions" or specify your own+--+-- >>> parseURI strictURIParserOptions "http://www.example.org/foo?bar[]=baz"+-- Left MalformedQuery+--+-- >>> parseURI laxURIParserOptions "http://www.example.org/foo?bar[]=baz"+-- Right (URI {uriScheme = Scheme {getScheme = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {getHost = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {getQuery = [("bar[]","baz")]}, uriFragment = Nothing})+--+-- >>> let myLaxOptions = URIParserOptions { upoValidQueryChar = liftA2 (||) (upoValidQueryChar strictURIParserOptions) (inClass "[]")}+-- >>> parseURI myLaxOptions "http://www.example.org/foo?bar[]=baz"+-- Right (URI {uriScheme = Scheme {getScheme = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {getHost = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {getQuery = [("bar[]","baz")]}, uriFragment = Nothing})+parseURI :: URIParserOptions -> ByteString -> Either URIParseError URI+parseURI opts = parseOnly' OtherError (uriParser opts)+++-------------------------------------------------------------------------------+-- | Convenience alias for a parser that can return URIParseError+type URIParser = Parser' URIParseError+++-------------------------------------------------------------------------------+-- | Toplevel parser for URIs+uriParser :: URIParserOptions -> URIParser URI+uriParser opts = do+  scheme <- schemeParser+  void $ word8 colon `orFailWith` MalformedScheme MissingColon++  (authority, path) <- hierPartParser+  query <- queryParser opts+  frag  <- mFragmentParser+  case frag of+    Just _ -> endOfInput `orFailWith` MalformedFragment+    Nothing -> endOfInput `orFailWith` MalformedQuery+  return $ URI scheme authority path query frag+++-------------------------------------------------------------------------------+-- | Parser for scheme, e.g. "http", "https", etc.+schemeParser :: URIParser Scheme+schemeParser = do+  c    <- satisfy isAlpha           `orFailWith` MalformedScheme NonAlphaLeading+  rest <- A.takeWhile isSchemeValid `orFailWith` MalformedScheme InvalidChars+  return $ Scheme $ c `BS.cons` rest+  where+    isSchemeValid = inClass $ "-+." ++ alphaNum+++-------------------------------------------------------------------------------+-- | Hier part immediately follows the schema and encompasses the+-- authority and path sections.+hierPartParser :: URIParser (Maybe Authority, ByteString)+hierPartParser = authWithPathParser <|>+                 pathAbsoluteParser <|>+                 pathRootlessParser <|>+                 pathEmptyParser+++-------------------------------------------------------------------------------+-- | See the "authority path-abempty" grammar in the RFC+authWithPathParser :: URIParser (Maybe Authority, ByteString)+authWithPathParser = string' "//" *> ((,) <$> mAuthorityParser <*> pathParser)+++-------------------------------------------------------------------------------+-- | See the "path-absolute" grammar in the RFC. Essentially a special+-- case of rootless.+pathAbsoluteParser :: URIParser (Maybe Authority, ByteString)+pathAbsoluteParser = string' "/" *> pathRootlessParser+++-------------------------------------------------------------------------------+-- | See the "path-rootless" grammar in the RFC.+pathRootlessParser :: URIParser (Maybe Authority, ByteString)+pathRootlessParser = (,) <$> pure Nothing <*> pathParser1+++-------------------------------------------------------------------------------+-- | See the "path-empty" grammar in the RFC. Must not be followed+-- with a path-valid char.+pathEmptyParser :: URIParser (Maybe Authority, ByteString)+pathEmptyParser = do+  nextChar <- peekWord8 `orFailWith` OtherError "impossible peekWord8 error"+  case nextChar of+    Just c -> guard (notInClass pchar c) >> return emptyCase+    _      -> return emptyCase+  where+    emptyCase = (Nothing, mempty)+++-------------------------------------------------------------------------------+-- | Parser whe+mAuthorityParser :: URIParser (Maybe Authority)+mAuthorityParser = mParse authorityParser+++-------------------------------------------------------------------------------+-- | Parses the user info section of a URl (i.e. for HTTP Basic+-- Authentication). Note that this will decode any percent-encoded+-- data.+userInfoParser :: URIParser UserInfo+userInfoParser =  (uiTokenParser <* word8 atSym) `orFailWith` MalformedUserInfo+  where+    atSym = 64+    uiTokenParser = do+      ui <- A.takeWhile1 validForUserInfo+      let (user, passWithColon) = BS.break (== colon) $ urlDecode' ui+      let pass = BS.drop 1 passWithColon+      return $ UserInfo user pass+    validForUserInfo = inClass $ pctEncoded ++ subDelims ++ (':' : unreserved)+++-------------------------------------------------------------------------------+-- | Authority consists of host and port+authorityParser :: URIParser Authority+authorityParser = Authority <$> mParse userInfoParser <*> hostParser <*> mPortParser+++-------------------------------------------------------------------------------+-- | Parser that can handle IPV6/Future literals, IPV4, and domain names.+hostParser :: URIParser Host+hostParser = (Host <$> parsers) `orFailWith` MalformedHost+  where+    parsers = ipLiteralParser <|> ipV4Parser <|> regNameParser+    ipLiteralParser = word8 oBracket *> (ipVFutureParser <|> ipV6Parser) <* word8 cBracket+++-------------------------------------------------------------------------------+-- | Parses IPV6 addresses. See relevant section in RFC.+ipV6Parser :: Parser ByteString+ipV6Parser = do+    leading <- h16s+    elided <- maybe [] (const [""]) <$> optional (string "::")+    trailing <- many (A.takeWhile (/= colon) <* word8 colon)+    (finalChunkLen, final) <- finalChunk+    let len = length (leading ++ trailing) + finalChunkLen+    when (len > 8) $ fail "Too many digits in IPv6 address"+    return $ rejoin $ [rejoin leading] ++ elided ++ trailing ++ maybeToList final+  where+    finalChunk = fromMaybe (0, Nothing) <$> optional (finalIpV4 <|> finalH16)+    finalH16 = (1, ) . Just <$> h16+    finalIpV4 = (2, ) . Just <$> ipV4Parser+    rejoin = BS.intercalate ":"+    h16s = h16 `sepBy` word8 colon+    h16 = mconcat <$> parseBetween 1 4 (A.takeWhile1 hexDigit)+++-------------------------------------------------------------------------------+-- | Parses IPVFuture addresses. See relevant section in RFC.+ipVFutureParser :: Parser ByteString+ipVFutureParser = do+    _    <- word8 lowercaseV+    ds   <- A.takeWhile1 hexDigit+    _    <- word8 period+    rest <- A.takeWhile1 $ inClass $ subDelims ++ ":" ++ unreserved+    return $ "v" <> ds <> "." <> rest+  where+    lowercaseV = 118+++-------------------------------------------------------------------------------+-- | Parses a valid IPV4 address+ipV4Parser :: Parser ByteString+ipV4Parser = mconcat <$> sequence [ decOctet+                                  , dot+                                  , decOctet+                                  , dot+                                  , decOctet+                                  , dot+                                  , decOctet]+  where+    decOctet = do+      s <- A.takeWhile1 isDigit+      let len = BS.length s+      guard $ len > 0 && len <= 3+      let num = bsToNum s+      guard $ num >= 1 && num <= 255+      return s+    dot = string "."+++-------------------------------------------------------------------------------+-- | This corresponds to the hostname, e.g. www.example.org+regNameParser :: Parser ByteString+regNameParser = urlDecode' <$> A.takeWhile1 (inClass validForRegName)+  where+    validForRegName = pctEncoded ++ subDelims ++ unreserved+++-------------------------------------------------------------------------------+-- | Only parse a port if the colon signifier is there.+mPortParser :: URIParser (Maybe Port)+mPortParser = word8' colon `thenJust` portParser+++-------------------------------------------------------------------------------+-- | Parses port number from the hostname. Colon separator must be+-- handled elsewhere.+portParser :: URIParser Port+portParser = (Port . bsToNum <$> A.takeWhile1 isDigit) `orFailWith` MalformedPort+++-------------------------------------------------------------------------------+-- | Path with any number of segments+pathParser :: URIParser ByteString+pathParser = pathParser' A.many'+++-------------------------------------------------------------------------------+-- | Path with at least 1 segment+pathParser1 :: URIParser ByteString+pathParser1 = pathParser' A.many1'+++-------------------------------------------------------------------------------+-- | Parses the path section of a url. Note that while this can take+-- percent-encoded characters, it does not itself decode them while parsing.+pathParser' :: (Parser ByteString -> Parser [ByteString]) -> URIParser ByteString+pathParser' repeatParser = (mconcat <$> repeatParser segmentParser) `orFailWith` MalformedPath+  where+    segmentParser = mconcat <$> sequence [string "/", A.takeWhile (inClass pchar)]+++-------------------------------------------------------------------------------+-- | This parser is being a bit pragmatic. The query section in the+-- spec does not identify the key/value format used in URIs, but that+-- is what most users are expecting to see. One alternative could be+-- to just expose the query string as a string and offer functions on+-- URI to parse a query string to a Query.+queryParser :: URIParserOptions -> URIParser Query+queryParser opts = do+  mc <- peekWord8 `orFailWith` OtherError "impossible peekWord8 error"+  case mc of+    Just c+      | c == question -> skip' 1 *> itemsParser+      | c == hash     -> pure mempty+      | otherwise     -> fail' MalformedPath+    _      -> pure mempty+  where+    itemsParser = Query <$> A.sepBy' (queryItemParser opts) (word8' ampersand)+++-------------------------------------------------------------------------------+-- | When parsing a single query item string like "foo=bar", turns it+-- into a key/value pair as per convention, with the value being+-- optional. & separators need to be handled further up.+queryItemParser :: URIParserOptions -> URIParser (ByteString, ByteString)+queryItemParser opts = do+  s <- A.takeWhile1 (upoValidQueryChar opts) `orFailWith` MalformedQuery+  let (k, vWithEquals) = BS.break (== equals) s+  let v = BS.drop 1 vWithEquals+  return (urlDecodeQuery k, urlDecodeQuery v)+++-------------------------------------------------------------------------------+validForQuery :: Word8 -> Bool+validForQuery = inClass ('?':'/':delete '&' pchar)+++-------------------------------------------------------------------------------+validForQueryLax :: Word8 -> Bool+validForQueryLax = notInClass "&#"+++-------------------------------------------------------------------------------+-- | Only parses a fragment if the # signifiier is there+mFragmentParser :: URIParser (Maybe ByteString)+mFragmentParser = word8' hash `thenJust` fragmentParser+++-------------------------------------------------------------------------------+-- | The final piece of a uri, e.g. #fragment, minus the #.+fragmentParser :: URIParser ByteString+fragmentParser = A.takeWhile1 validFragmentWord `orFailWith` MalformedFragment+  where+    validFragmentWord = inClass ('?':'/':pchar)+++-------------------------------------------------------------------------------+-- | Grammar Components+-------------------------------------------------------------------------------+++-------------------------------------------------------------------------------+hexDigit :: Word8 -> Bool+hexDigit = inClass "0-9a-fA-F"+++-------------------------------------------------------------------------------+isAlpha :: Word8 -> Bool+isAlpha = inClass alpha+++-------------------------------------------------------------------------------+isDigit :: Word8 -> Bool+isDigit = inClass digit+++-------------------------------------------------------------------------------+pchar :: String+pchar = pctEncoded ++ subDelims ++ ":@" ++ unreserved+++-------------------------------------------------------------------------------+-- Very important!  When concatenating this to other strings to make larger+-- character classes, you must put this at the end because the '-' character+-- is treated as a range unless it's at the beginning or end.+unreserved :: String+unreserved = alphaNum ++ "~._-"+++-------------------------------------------------------------------------------+unreserved8 :: [Word8]+unreserved8 = map ord8 unreserved+++-------------------------------------------------------------------------------+unreservedPath8 :: [Word8]+unreservedPath8 = unreserved8 ++ map ord8 ":@&=+$,"++-------------------------------------------------------------------------------+ord8 :: Char -> Word8+ord8 = fromIntegral . ord+++-------------------------------------------------------------------------------+-- | pc-encoded technically is % HEXDIG HEXDIG but that's handled by+-- the previous alphaNum constraint. May need to double back with a+-- parser to ensure pct-encoded never exceeds 2 hexdigs after+pctEncoded :: String+pctEncoded = "%"+++-------------------------------------------------------------------------------+subDelims :: String+subDelims = "!$&'()*+,;="+++-------------------------------------------------------------------------------+alphaNum :: String+alphaNum = alpha ++ digit+++-------------------------------------------------------------------------------+alpha :: String+alpha = "a-zA-Z"+++-------------------------------------------------------------------------------+digit :: String+digit = "0-9"+++-------------------------------------------------------------------------------+colon :: Word8+colon = 58+++-------------------------------------------------------------------------------+oBracket :: Word8+oBracket = 91+++-------------------------------------------------------------------------------+cBracket :: Word8+cBracket = 93+++-------------------------------------------------------------------------------+equals :: Word8+equals = 61+++-------------------------------------------------------------------------------+question :: Word8+question = 63+++-------------------------------------------------------------------------------+ampersand :: Word8+ampersand = 38+++-------------------------------------------------------------------------------+hash :: Word8+hash = 35+++-------------------------------------------------------------------------------+period :: Word8+period = 46+++-------------------------------------------------------------------------------+slash :: Word8+slash = 47+++-------------------------------------------------------------------------------+-- | ByteString Utilities+-------------------------------------------------------------------------------++-- FIXME: theres probably a much better way to do this++-------------------------------------------------------------------------------+-- | Convert a bytestring into an int representation. Assumes the+-- entire string is comprised of 0-9 digits.+bsToNum :: ByteString -> Int+bsToNum s = sum $ zipWith (*) (reverse ints) [10 ^ x | x <- [0..] :: [Int]]+  where+    w2i w = fromEnum $ w - 48+    ints  = map w2i . BS.unpack $ s+++-------------------------------------------------------------------------------+-- | Decoding specifically for the query string, which decodes + as+-- space.+urlDecodeQuery :: ByteString -> ByteString+urlDecodeQuery = urlDecode plusToSpace+  where+    plusToSpace = True+++-------------------------------------------------------------------------------+-- | Decode any part of the URL besides the query, which decodes + as+-- space.+urlDecode' :: ByteString -> ByteString+urlDecode' = urlDecode plusToSpace+  where+    plusToSpace = False+++-------------------------------------------------------------------------------+-- | Parsing with Strongly-Typed Errors+-------------------------------------------------------------------------------+++-- | A parser with a specific error type. Attoparsec unfortunately+-- throws all errors into strings, which cannot be handled well+-- programmatically without doing something silly like parsing error+-- messages. This wrapper attempts to concentrate these errors into+-- one type.+newtype Parser' e a = Parser' (Parser a)+                    deriving ( Functor+                             , Applicative+                             , Alternative+                             , Monad+                             , MonadPlus+                             , Monoid)+++-------------------------------------------------------------------------------+-- | Use with caution. Catch a parser failing and return Nothing.+mParse :: Parser' e a -> Parser' e (Maybe a)+mParse p = option Nothing (Just <$> p)+++-------------------------------------------------------------------------------+-- | If the first parser succeeds, discard the result and use the+-- second parser (which may fail). If the first parser fails, return+-- Nothing. This is used to check a benign precondition that indicates+-- the presence of a parsible token, i.e. ? preceeding a query.+thenJust :: Parser' e a -> Parser' e b -> Parser' e (Maybe b)+thenJust p1 p2 = p1 *> (Just <$> p2) <|> pure Nothing+++-------------------------------------------------------------------------------+-- | Lift a word8 Parser into a strongly error typed parser. This will+-- generate a "stringy" error message if it fails, so you should+-- probably be prepared to exit with a nicer error further up.+word8' :: Word8 -> Parser' e Word8+word8' = Parser' . word8+++-------------------------------------------------------------------------------+-- | Skip exactly 1 character. Fails if the character isn't+-- there. Generates a "stringy" error.+skip' :: Int -> Parser' e ()+skip' = Parser' . void . A.take+++-------------------------------------------------------------------------------+-- | Lifted version of the string token parser. Same caveats about+-- "stringy" errors apply.+string' :: ByteString -> Parser' e ByteString+string' = Parser' . string+++-------------------------------------------------------------------------------+-- | Combinator for tunnelling more specific error types through the+-- attoparsec machinery using read/show.+orFailWith :: (Show e, Read e) => Parser a -> e -> Parser' e a+orFailWith p e = Parser' p <|> fail' e+++-------------------------------------------------------------------------------+-- | Should be preferred to fail'+fail' :: (Show e, Read e) => e -> Parser' e a+fail' = fail . show+++-------------------------------------------------------------------------------+parseBetween :: (Alternative m, Monad m) => Int -> Int -> m a -> m [a]+parseBetween a b f = choice parsers+  where+    parsers = map (`count` f) $ reverse $ range (a, b)+++-------------------------------------------------------------------------------+-- | Stronger-typed variation of parseOnly'. Consumes all input.+parseOnly' :: (Read e, Show e)+              => (String -> e) -- ^ Fallback if we can't parse a failure message for the sake of totality.+              -> Parser' e a+              -> ByteString+              -> Either e a+parseOnly' noParse (Parser' p) = fmapL readWithFallback . parseOnly p+  where+    readWithFallback s = fromMaybe (noParse s) (readMaybe . stripAttoparsecGarbage $ s)++-------------------------------------------------------------------------------+-- | Our pal Control.Monad.fail is how attoparsec propagates+-- errors. If you throw an error string with fail (your only choice),+-- it will *always* prepend it with "Failed reading: ". At least in+-- this version. That may change to something else and break this workaround.+stripAttoparsecGarbage :: String -> String+stripAttoparsecGarbage = stripPrefix' "Failed reading: "+++-------------------------------------------------------------------------------+-- | stripPrefix where it is a noop if the prefix doesn't exist.+stripPrefix' :: Eq a => [a] -> [a] -> [a]+stripPrefix' pfx s = fromMaybe s $ stripPrefix pfx s+++-------------------------------------------------------------------------------+fmapL :: (a -> b) -> Either a r -> Either b r+fmapL f = either (Left . f) Right+++-------------------------------------------------------------------------------+-- | This function was extract from the @http-types@ package. The+-- license can be found in licenses/http-types/LICENSE+urlDecode+    :: Bool -- ^ Whether to decode '+' to ' '+    -> BS.ByteString+    -> BS.ByteString+urlDecode replacePlus z = fst $ BS.unfoldrN (BS.length z) go z+  where+    go bs' =+        case BS.uncons bs' of+            Nothing -> Nothing+            Just (43, ws) | replacePlus -> Just (32, ws) -- plus to space+            Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent+                (x, xs) <- BS.uncons ws+                x' <- hexVal x+                (y, ys) <- BS.uncons xs+                y' <- hexVal y+                Just (combine x' y', ys)+            Just (w, ws) -> Just (w, ws)+    hexVal w+        | 48 <= w && w <= 57  = Just $ w - 48 -- 0 - 9+        | 65 <= w && w <= 70  = Just $ w - 55 -- A - F+        | 97 <= w && w <= 102 = Just $ w - 87 -- a - f+        | otherwise = Nothing+    combine :: Word8 -> Word8 -> Word8+    combine a b = shiftL a 4 .|. b+++-------------------------------------------------------------------------------+--TODO: keep an eye on perf here. seems like a good use case for a DList. the word8 list could be a set/hashset+-- | Percent-encoding for URLs.+urlEncode' :: [Word8] -> ByteString -> Builder+urlEncode' extraUnreserved = mconcat . map encodeChar . BS.unpack+    where+      encodeChar ch | unreserved' ch = BB.word8 ch+                    | otherwise     = h2 ch++      unreserved' ch | ch >= 65 && ch <= 90  = True -- A-Z+                    | ch >= 97 && ch <= 122 = True -- a-z+                    | ch >= 48 && ch <= 57  = True -- 0-9+      unreserved' c = c `elem` extraUnreserved++      h2 v = let (a, b) = v `divMod` 16 in bs $ BS.pack [37, h a, h b] -- percent (%)+      h i | i < 10    = 48 + i -- zero (0)+          | otherwise = 65 + i - 10 -- 65: A+++-------------------------------------------------------------------------------+urlEncodeQuery :: ByteString -> Builder+urlEncodeQuery = urlEncode' unreserved8+++-------------------------------------------------------------------------------+urlEncodePath :: ByteString -> Builder+urlEncodePath = urlEncode' unreservedPath8

@@ -0,0 +1,11 @@+module Main (main) where++import Test.Tasty++import URI.ByteStringTests++main :: IO ()+main = defaultMain testSuite++testSuite :: TestTree+testSuite = testGroup "uri-bytestring" [URI.ByteStringTests.tests]

@@ -0,0 +1,76 @@+name:                uri-bytestring+version:             0.0.1+synopsis:            Haskell URI parsing as ByteStrings+description: uri-bytestring aims to be an RFC3986 compliant URI parser that uses efficient ByteStrings for parsing and representing the URI data.+license:             BSD3+license-files:       LICENSE+                   , licenses/http-types/LICENSE+author:              Doug Beardsley, Michael Xavier+maintainer:          Michael Xavier <michael.xavier@soostone.com>+copyright:           Soostone Inc.+category:            Web+build-type:          Simple+cabal-version:       >=1.16+homepage:            https://travis-ci.org/Soostone/uri-bytestring+bug-reports:         https://travis-ci.org/Soostone/uri-bytestring/issues+extra-source-files:+  README.md+  changelog.md+  bench/*.hs++flag lib-Werror+  default: False+  manual: True++library+  exposed-modules:+    URI.ByteString++  build-depends:++      attoparsec       >= 0.10    && < 0.13+    , base             >= 4.6     && < 4.8+    , bytestring       >= 0.10.2.0 && < 0.11++  hs-source-dirs:      src+  default-language:    Haskell2010++  if flag(lib-Werror)+    ghc-options: -Werror++  ghc-options: -Wall++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  build-depends:+      uri-bytestring+    , HUnit+    , QuickCheck+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , derive+    , attoparsec+    , base+    , bytestring+  default-language:    Haskell2010++benchmark bench+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: bench+  default-language:    Haskell2010+  build-depends:+      base+    , uri-bytestring+    , criterion+    , deepseq+    , deepseq-generics+    , network-uri+    , bytestring++source-repository head+  type:     git+  location: git://github.com/Soostone/uri-bytestring.git