1acc69e · typeable/bloodhound

git.iko.soy/typeable/bloodhound

Fix for bitemyapp/bloodhound#38

Utilize `Network.URI.escapeURIString` to escape characters before parsing a string into an URI

commit1acc69e62b06fd52f2f3ef7bfb20a0f238d18ff5 authorJan-Philip Loos <maxdaten@gmail.com> dateWed 7 Oct 2015, 11:30 (11 years ago) parentd387749

6 files changed+8−35

compare with master

unifiedsplit

README.md+1 bloodhound.cabal+1−1 src/Database/Bloodhound/Client.hs+2−28 stack-7.10.yaml−1 stack.yaml−1 tests/tests.hs+4−4

README.md+1

@@ -886,6 +886,7 @@ Contributors

886886* [Maximilian Tagher](https://github.com/MaxGabriel)

887887* [Anna Kopp](https://github.com/annakopp)

888888* [Matvey B. Aksenov](https://github.com/supki)

889+* [Jan-Philip Loos](https://github.com/MaxDaten)

889890

890891Possible future functionality

891892=============================

bloodhound.cabal+1−1

@@ -28,6 +28,7 @@ library

2828 containers >= 0.5.0.0 && <0.6,

2929 aeson >= 0.7 && <0.10,

3030 http-client >= 0.3 && <0.5,

31+ network-uri >= 2.6 && <2.7,

3132 semigroups >= 0.15 && <0.18,

3233 time >= 1.4 && <1.6,

3334 text >= 0.11 && <1.3,

@@ -35,7 +36,6 @@ library

3536 transformers >= 0.2 && <0.5,

3637 http-types >= 0.8 && <0.9,

3738 vector >= 0.10.9 && <0.12,

38− uri-bytestring >= 0.1 && <0.2,

3939 exceptions,

4040 data-default-class,

4141 blaze-builder,

src/Database/Bloodhound/Client.hs+2−28

@@ -66,7 +66,6 @@ import Control.Monad.IO.Class

6666import Data.Aeson

6767import Data.ByteString.Lazy.Builder

6868import qualified Data.ByteString.Lazy.Char8 as L

69−import Data.Default.Class

7069import Data.Ix

7170import qualified Data.List as LS (filter)

7271import Data.Maybe (fromMaybe, isJust)

@@ -79,8 +78,8 @@ import Network.HTTP.Client

7978import qualified Network.HTTP.Types.Method as NHTM

8079import qualified Network.HTTP.Types.Status as NHTS

8180import qualified Network.HTTP.Types.URI as NHTU

81+import qualified Network.URI as URI

8282import Prelude hiding (filter, head)

83−import URI.ByteString hiding (Query)

8483

8584import Database.Bloodhound.Types

8685

@@ -631,32 +630,7 @@ pageSearch :: From -- ^ The result offset

631630pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }

632631

633632parseUrl' :: MonadThrow m => Text -> m Request

634−parseUrl' t =

635− case parseURI laxURIParserOptions (T.encodeUtf8 t) of

636− Right uri -> setURI def uri

637− Left e -> throwM $ InvalidUrlException (T.unpack t) ("Invalid URL: " ++ show e)

638−

639−setURI :: MonadThrow m => Request -> URI -> m Request

640−setURI req URI{..} = do

641− Authority {..} <- maybe missingUA return uriAuthority

642− let req' = req { secure = isSecure

643− , host = hostBS authorityHost

644− , port = thePort

645− , path = uriPath

646− }

647− thePort = maybe defPort portNumber authorityPort

648− addAuth = maybe id addAuth' authorityUserInfo

649− return $ setQueryString theQueryString $ addAuth req'

650− where

651− missingUA = throwM $ InvalidUrlException "N/A" "Missing URI host/port"

652− addAuth' UserInfo {..} = applyBasicProxyAuth uiUsername uiPassword

653− defPort

654− | isSecure = 443

655− | otherwise = 80

656− isSecure = case uriScheme of

657− Scheme "https" -> True

658− _ -> False

659− theQueryString = [(k , Just v) | (k, v) <- queryPairs uriQuery]

633+parseUrl' t = parseUrl (URI.escapeURIString URI.isAllowedInURI (T.unpack t))

660634

661635-- | Was there an optimistic concurrency control conflict when

662636-- indexing a document?

stack-7.10.yaml−1

@@ -5,5 +5,4 @@ extra-deps:

55- doctest-0.10.1

66- doctest-prop-0.2.0.1

77- quickcheck-properties-0.1

8−- uri-bytestring-0.1.2

98resolver: lts-3.1

stack.yaml−1

@@ -5,5 +5,4 @@ extra-deps:

55- doctest-0.10.1

66- doctest-prop-0.2.0.1

77- quickcheck-properties-0.1

8−- uri-bytestring-0.1.2

98resolver: lts-2.18

tests/tests.hs+4−4

@@ -187,9 +187,9 @@ insertOther = do

187187 _ <- refreshIndex testIndex

188188 return ()

189189

190−insertOtherWithSpaceInId :: BH IO ()

191−insertOtherWithSpaceInId = do

192− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "Hello World")

190+insertWithSpaceInId :: BH IO ()

191+insertWithSpaceInId = do

192+ _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")

193193 _ <- refreshIndex testIndex

194194 return ()

195195

@@ -336,7 +336,7 @@ main = hspec $ do

336336 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))

337337

338338 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do

339− _ <- insertOtherWithSpaceInId

339+ _ <- insertWithSpaceInId

340340 docInserted <- getDocument testIndex testMapping (DocId "Hello World")

341341 let newTweet = eitherDecode

342342 (responseBody docInserted) :: Either String (EsResult Tweet)