225f13a · typeable/bloodhound

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

@@ -12,6 +12,11 @@ category: Database, Search

1212build-type: Custom

1313cabal-version: >=1.10

1414

15+extra-source-files:

16+ README.md

17+ changelog.md

18+

19+

1520source-repository head

1621 type: git

1722 location: https://github.com/bitemyapp/bloodhound.git

@@ -27,7 +32,9 @@ library

2732 bytestring >= 0.10.0 && <0.11,

2833 containers >= 0.5.0.0 && <0.6,

2934 aeson >= 0.7 && <0.11,

35+ aeson-extra >= 0.1 && <0.2,

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

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

3138 semigroups >= 0.15 && <0.18,

3239 time >= 1.4 && <1.6,

3340 text >= 0.11 && <1.3,

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

3542 transformers >= 0.2 && <0.5,

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

3744 vector >= 0.10.9 && <0.12,

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

3945 exceptions,

4046 data-default-class,

4147 blaze-builder,

src/Database/Bloodhound/Client.hs+11−34

@@ -66,9 +66,9 @@ 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

71−import Data.Maybe (fromMaybe)

70+import qualified Data.List as LS (filter)

71+import Data.Maybe (fromMaybe, isJust)

7272import Data.Monoid

7373import Data.Text (Text)

7474import qualified Data.Text as T

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

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

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

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

81+import qualified Network.URI as URI

8182import Prelude hiding (filter, head)

82−import URI.ByteString hiding (Query)

8383

8484import Database.Bloodhound.Types

8585

@@ -499,14 +499,16 @@ getDocument (IndexName indexName)

499499-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'

500500-- in IO

501501--

502−-- >>> exists <- runBH' $ documentExists testIndex testMapping (DocId "1")

502+-- >>> exists <- runBH' $ documentExists testIndex testMapping Nothing (DocId "1")

503503documentExists :: MonadBH m => IndexName -> MappingName

504− -> DocId -> m Bool

505−documentExists (IndexName indexName)

506− (MappingName mappingName) (DocId docId) = do

504+ -> Maybe DocumentParent -> DocId -> m Bool

505+documentExists (IndexName indexName) (MappingName mappingName)

506+ parent (DocId docId) = do

507507 (_, exists) <- existentialQuery =<< url

508508 return exists

509− where url = joinPath [indexName, mappingName, docId]

509+ where url = addQuery params <$> joinPath [indexName, mappingName, docId]

510+ parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent

511+ params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]

510512

511513dispatchSearch :: MonadBH m => Text -> Search -> m Reply

512514dispatchSearch url search = post url' (Just (encode search))

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

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

629631

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

631−parseUrl' t =

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

633− Right uri -> setURI def uri

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

635−

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

637−setURI req URI{..} = do

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

639− let req' = req { secure = isSecure

640− , host = hostBS authorityHost

641− , port = thePort

642− , path = uriPath

643− }

644− thePort = maybe defPort portNumber authorityPort

645− addAuth = maybe id addAuth' authorityUserInfo

646− return $ setQueryString theQueryString $ addAuth req'

647− where

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

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

650− defPort

651− | isSecure = 443

652− | otherwise = 80

653− isSecure = case uriScheme of

654− Scheme "https" -> True

655− _ -> False

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

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

657634

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

659636-- indexing a document?

src/Database/Bloodhound/Types.hs+18−5

@@ -61,6 +61,7 @@ module Database.Bloodhound.Types

6161 , Reply

6262 , EsResult(..)

6363 , EsResultFound(..)

64+ , EsError(..)

6465 , DocVersion

6566 , ExternalDocVersion(..)

6667 , VersionControl(..)

@@ -235,7 +236,8 @@ import Control.Monad.Except

235236import Control.Monad.Reader

236237import Control.Monad.State

237238import Control.Monad.Writer

238−import Data.Aeson

239+import Data.Aeson hiding ((.:?))

240+import Data.Aeson.Compat ((.:?))

239241import Data.Aeson.Types (Pair, emptyObject, parseMaybe)

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

241243import qualified Data.HashMap.Strict as HM (union)

@@ -416,13 +418,18 @@ data EsResult a = EsResult { _index :: Text

416418 , _id :: Text

417419 , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)

418420

419−

420421{-| 'EsResultFound' contains the document and its metadata inside of an

421422 'EsResult' when the document was successfully found.

422423-}

423424data EsResultFound a = EsResultFound { _version :: DocVersion

424425 , _source :: a } deriving (Eq, Show)

425426

427+{-| 'EsError' is the generic type that will be returned when there was a

428+ problem. If you can't parse the expected response, its a good idea to

429+ try parsing this.

430+-}

431+data EsError = EsError { errorStatus :: Int

432+ , errorMessage :: Text } deriving (Eq, Show)

426433

427434

428435{-| 'DocVersion' is an integer version number for a document between 1

@@ -756,7 +763,7 @@ data SearchType = SearchTypeQueryThenFetch

756763 deriving (Eq, Show)

757764

758765data Source =

759− NoSource

766+ NoSource

760767 | SourcePatterns PatternOrPatterns

761768 | SourceIncludeExclude Include Exclude

762769 deriving (Show, Eq)

@@ -1305,7 +1312,7 @@ data Hit a =

13051312 , hitType :: MappingName

13061313 , hitDocId :: DocId

13071314 , hitScore :: Score

1308− , hitSource :: a

1315+ , hitSource :: Maybe a

13091316 , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)

13101317

13111318data ShardResult =

@@ -2133,6 +2140,12 @@ instance (FromJSON a) => FromJSON (EsResultFound a) where

21332140 v .: "_source"

21342141 parseJSON _ = empty

21352142

2143+instance FromJSON EsError where

2144+ parseJSON (Object v) = EsError <$>

2145+ v .: "status" <*>

2146+ v .: "error"

2147+ parseJSON _ = empty

2148+

21362149instance ToJSON Search where

21372150 toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =

21382151 omitNulls [ "query" .= query

@@ -2400,7 +2413,7 @@ instance (FromJSON a) => FromJSON (Hit a) where

24002413 v .: "_type" <*>

24012414 v .: "_id" <*>

24022415 v .: "_score" <*>

2403− v .: "_source" <*>

2416+ v .:? "_source" <*>

24042417 v .:? "highlight"

24052418 parseJSON _ = empty

24062419

stack-7.10.yaml+1−1

@@ -3,8 +3,8 @@ packages:

33- '.'

44extra-deps:

55- aeson-0.10.0.0

6+- aeson-extra-0.1.0.0

67- attoparsec-0.13.0.1

7−- time-1.5.0.1

88- doctest-0.10.1

99- doctest-prop-0.2.0.1

1010- quickcheck-properties-0.1

stack-7.8.yamlmode 120000 → 100644+8−1

@@ -1 +0,0 @@

1−stack.yaml

@@ -0,0 +1,8 @@

1+flags: {}

2+packages:

3+- '.'

4+extra-deps:

5+- doctest-0.10.1

6+- doctest-prop-0.2.0.1

7+- quickcheck-properties-0.1

8+resolver: lts-2.18

stack.yamlmode 100644 → 120000+1−12

@@ -1,12 +0,0 @@

1−flags: {}

2−packages:

3−- '.'

4−extra-deps:

5−- aeson-0.10.0.0

6−- attoparsec-0.13.0.1

7−- time-1.5.0.1

8−- doctest-0.10.1

9−- doctest-prop-0.2.0.1

10−- quickcheck-properties-0.1

11−- uri-bytestring-0.1.9

12−resolver: lts-2.18

@@ -0,0 +1 @@

1+stack-7.10.yaml

tests/tests.hs+42−2

@@ -116,6 +116,20 @@ instance FromJSON Tweet

116116instance ToJSON Location

117117instance FromJSON Location

118118

119+data ParentMapping = ParentMapping deriving (Eq, Show)

120+

121+instance ToJSON ParentMapping where

122+ toJSON ParentMapping =

123+ object ["parent" .= Null ]

124+

125+data ChildMapping = ChildMapping deriving (Eq, Show)

126+

127+instance ToJSON ChildMapping where

128+ toJSON ChildMapping =

129+ object ["child" .=

130+ object ["_parent" .= object ["type" .= ("parent" :: Text)]]

131+ ]

132+

119133data TweetMapping = TweetMapping deriving (Eq, Show)

120134

121135instance ToJSON TweetMapping where

@@ -173,11 +187,17 @@ insertOther = do

173187 _ <- refreshIndex testIndex

174188 return ()

175189

190+insertWithSpaceInId :: BH IO ()

191+insertWithSpaceInId = do

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

193+ _ <- refreshIndex testIndex

194+ return ()

195+

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

177197searchTweet search = do

178198 result <- searchTweets search

179199 let myTweet = fmap (hitSource . head . hits . searchHits) result

180− return myTweet

200+ return (either (Left "myTweet was Nothing") id myTweet)

181201

182202searchTweets :: Search -> BH IO (Either String (SearchResult Tweet))

183203searchTweets search = eitherDecode . responseBody <$> searchByIndex testIndex search

@@ -228,6 +248,7 @@ searchExpectSource src expected = do

228248 reply <- searchAll search

229249 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Value)

230250 let value = fmap (hitSource . head . hits . searchHits) result

251+ liftIO (print value)

231252 liftIO $

232253 value `shouldBe` expected

233254

@@ -315,6 +336,13 @@ main = hspec $ do

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

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

317338

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

340+ _ <- insertWithSpaceInId

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

342+ let newTweet = eitherDecode

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

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

345+

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

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

320348 let noTweet = eitherDecode

@@ -330,6 +358,18 @@ main = hspec $ do

330358 res' <- insertData' cfg

331359 liftIO $ isVersionConflict res' `shouldBe` True

332360

361+ it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do

362+ resetIndex

363+ _ <- putMapping testIndex (MappingName "parent") ParentMapping

364+ _ <- putMapping testIndex (MappingName "child") ChildMapping

365+ _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")

366+ let parent = (Just . DocumentParent . DocId) "1"

367+ ids = IndexDocumentSettings NoVersionControl parent

368+ _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")

369+ _ <- refreshIndex testIndex

370+ exists <- documentExists testIndex (MappingName "child") parent (DocId "2")

371+ liftIO $ exists `shouldBe` True

372+

333373 describe "template API" $ do

334374 it "can create a template" $ withTestEnv $ do

335375 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]

@@ -808,6 +848,6 @@ main = hspec $ do

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

809849 let scan_search = map hitSource scan_search'

810850 liftIO $

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

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

812852 liftIO $

813853 scan_search `shouldMatchList` [exampleTweet, otherTweet]