b5f73f2 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

Merge pull request #73 from MaxDaten/master

Fix for #38

commitb5f73f29628c4f2bdbb8e5887a19a3ec15eb363d authorChris Allen <cma@bitemyapp.com> dateThu 8 Oct 2015, 20:45 (11 years ago) parent08b36be a2da055

7 files changed+19−32

compare with master

unifiedsplit

.travis.yml+1 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+14−1

.travis.yml+1

@@ -15,6 +15,7 @@ env:

1515 - GHCVER=7.8 ESVER=1.4.1

1616 - GHCVER=7.10 ESVER=1.5.2

1717 - GHCVER=7.10 ESVER=1.6.0

18+ - GHCVER=7.10 ESVER=1.7.2

1819

1920# services:

2021# - elasticsearch

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+14−1

@@ -187,6 +187,12 @@ insertOther = do

187187 _ <- refreshIndex testIndex

188188 return ()

189189

190+insertWithSpaceInId :: BH IO ()

191+insertWithSpaceInId = do

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

193+ _ <- refreshIndex testIndex

194+ return ()

195+

190196searchTweet :: Search -> BH IO (Either String Tweet)

191197searchTweet search = do

192198 result <- searchTweets search

@@ -329,6 +335,13 @@ main = hspec $ do

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

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

331337

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

339+ _ <- insertWithSpaceInId

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

341+ let newTweet = eitherDecode

342+ (responseBody docInserted) :: Either String (EsResult Tweet)

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

344+

332345 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do

333346 doc <- getDocument testIndex testMapping (DocId "bogus")

334347 let noTweet = eitherDecode

@@ -834,6 +847,6 @@ main = hspec $ do

834847 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]

835848 let scan_search = map hitSource scan_search'

836849 liftIO $

837− regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored

850+ regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored

838851 liftIO $

839852 scan_search `shouldMatchList` [exampleTweet, otherTweet]