diff --git a/.travis.yml b/.travis.yml index 685b15e..34d53b0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -15,6 +15,7 @@ env: - GHCVER=7.8 ESVER=1.4.1 - GHCVER=7.10 ESVER=1.5.2 - GHCVER=7.10 ESVER=1.6.0 + - GHCVER=7.10 ESVER=1.7.2 # services: # - elasticsearch diff --git a/README.md b/README.md index c83eb4f..d597550 100644 --- a/README.md +++ b/README.md @@ -886,6 +886,7 @@ Contributors * [Maximilian Tagher](https://github.com/MaxGabriel) * [Anna Kopp](https://github.com/annakopp) * [Matvey B. Aksenov](https://github.com/supki) +* [Jan-Philip Loos](https://github.com/MaxDaten) Possible future functionality ============================= diff --git a/bloodhound.cabal b/bloodhound.cabal index 7d97e98..cf81fef 100644 --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -12,6 +12,11 @@ category: Database, Search build-type: Custom cabal-version: >=1.10 +extra-source-files: + README.md + changelog.md + + source-repository head type: git location: https://github.com/bitemyapp/bloodhound.git @@ -27,7 +32,9 @@ library bytestring >= 0.10.0 && <0.11, containers >= 0.5.0.0 && <0.6, aeson >= 0.7 && <0.11, + aeson-extra >= 0.1 && <0.2, http-client >= 0.3 && <0.5, + network-uri >= 2.6 && <2.7, semigroups >= 0.15 && <0.18, time >= 1.4 && <1.6, text >= 0.11 && <1.3, @@ -35,7 +42,6 @@ library transformers >= 0.2 && <0.5, http-types >= 0.8 && <0.9, vector >= 0.10.9 && <0.12, - uri-bytestring >= 0.1 && <0.2, exceptions, data-default-class, blaze-builder, diff --git a/src/Database/Bloodhound/Client.hs b/src/Database/Bloodhound/Client.hs index 01813b1..18d6dda 100644 --- a/src/Database/Bloodhound/Client.hs +++ b/src/Database/Bloodhound/Client.hs @@ -66,9 +66,9 @@ import Control.Monad.IO.Class import Data.Aeson import Data.ByteString.Lazy.Builder import qualified Data.ByteString.Lazy.Char8 as L -import Data.Default.Class import Data.Ix -import Data.Maybe (fromMaybe) +import qualified Data.List as LS (filter) +import Data.Maybe (fromMaybe, isJust) import Data.Monoid import Data.Text (Text) import qualified Data.Text as T @@ -78,8 +78,8 @@ import Network.HTTP.Client import qualified Network.HTTP.Types.Method as NHTM import qualified Network.HTTP.Types.Status as NHTS import qualified Network.HTTP.Types.URI as NHTU +import qualified Network.URI as URI import Prelude hiding (filter, head) -import URI.ByteString hiding (Query) import Database.Bloodhound.Types @@ -499,14 +499,16 @@ getDocument (IndexName indexName) -- | 'documentExists' enables you to check if a document exists. Returns 'Bool' -- in IO -- --- >>> exists <- runBH' $ documentExists testIndex testMapping (DocId "1") +-- >>> exists <- runBH' $ documentExists testIndex testMapping Nothing (DocId "1") documentExists :: MonadBH m => IndexName -> MappingName - -> DocId -> m Bool -documentExists (IndexName indexName) - (MappingName mappingName) (DocId docId) = do + -> Maybe DocumentParent -> DocId -> m Bool +documentExists (IndexName indexName) (MappingName mappingName) + parent (DocId docId) = do (_, exists) <- existentialQuery =<< url return exists - where url = joinPath [indexName, mappingName, docId] + where url = addQuery params <$> joinPath [indexName, mappingName, docId] + parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent + params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)] dispatchSearch :: MonadBH m => Text -> Search -> m Reply dispatchSearch url search = post url' (Just (encode search)) @@ -628,32 +630,7 @@ pageSearch :: From -- ^ The result offset pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize } parseUrl' :: MonadThrow m => Text -> m Request -parseUrl' t = - case parseURI laxURIParserOptions (T.encodeUtf8 t) of - Right uri -> setURI def uri - Left e -> throwM $ InvalidUrlException (T.unpack t) ("Invalid URL: " ++ show e) - -setURI :: MonadThrow m => Request -> URI -> m Request -setURI req URI{..} = do - Authority {..} <- maybe missingUA return uriAuthority - let req' = req { secure = isSecure - , host = hostBS authorityHost - , port = thePort - , path = uriPath - } - thePort = maybe defPort portNumber authorityPort - addAuth = maybe id addAuth' authorityUserInfo - return $ setQueryString theQueryString $ addAuth req' - where - missingUA = throwM $ InvalidUrlException "N/A" "Missing URI host/port" - addAuth' UserInfo {..} = applyBasicProxyAuth uiUsername uiPassword - defPort - | isSecure = 443 - | otherwise = 80 - isSecure = case uriScheme of - Scheme "https" -> True - _ -> False - theQueryString = [(k , Just v) | (k, v) <- queryPairs uriQuery] +parseUrl' t = parseUrl (URI.escapeURIString URI.isAllowedInURI (T.unpack t)) -- | Was there an optimistic concurrency control conflict when -- indexing a document? diff --git a/src/Database/Bloodhound/Types.hs b/src/Database/Bloodhound/Types.hs index 0361d24..ae41064 100644 --- a/src/Database/Bloodhound/Types.hs +++ b/src/Database/Bloodhound/Types.hs @@ -61,6 +61,7 @@ module Database.Bloodhound.Types , Reply , EsResult(..) , EsResultFound(..) + , EsError(..) , DocVersion , ExternalDocVersion(..) , VersionControl(..) @@ -235,7 +236,8 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State import Control.Monad.Writer -import Data.Aeson +import Data.Aeson hiding ((.:?)) +import Data.Aeson.Compat ((.:?)) import Data.Aeson.Types (Pair, emptyObject, parseMaybe) import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.HashMap.Strict as HM (union) @@ -416,13 +418,18 @@ data EsResult a = EsResult { _index :: Text , _id :: Text , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show) - {-| 'EsResultFound' contains the document and its metadata inside of an 'EsResult' when the document was successfully found. -} data EsResultFound a = EsResultFound { _version :: DocVersion , _source :: a } deriving (Eq, Show) +{-| 'EsError' is the generic type that will be returned when there was a + problem. If you can't parse the expected response, its a good idea to + try parsing this. +-} +data EsError = EsError { errorStatus :: Int + , errorMessage :: Text } deriving (Eq, Show) {-| 'DocVersion' is an integer version number for a document between 1 @@ -756,7 +763,7 @@ data SearchType = SearchTypeQueryThenFetch deriving (Eq, Show) data Source = - NoSource + NoSource | SourcePatterns PatternOrPatterns | SourceIncludeExclude Include Exclude deriving (Show, Eq) @@ -1305,7 +1312,7 @@ data Hit a = , hitType :: MappingName , hitDocId :: DocId , hitScore :: Score - , hitSource :: a + , hitSource :: Maybe a , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show) data ShardResult = @@ -2133,6 +2140,12 @@ instance (FromJSON a) => FromJSON (EsResultFound a) where v .: "_source" parseJSON _ = empty +instance FromJSON EsError where + parseJSON (Object v) = EsError <$> + v .: "status" <*> + v .: "error" + parseJSON _ = empty + instance ToJSON Search where toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) = omitNulls [ "query" .= query @@ -2400,7 +2413,7 @@ instance (FromJSON a) => FromJSON (Hit a) where v .: "_type" <*> v .: "_id" <*> v .: "_score" <*> - v .: "_source" <*> + v .:? "_source" <*> v .:? "highlight" parseJSON _ = empty diff --git a/stack-7.10.yaml b/stack-7.10.yaml index b0908a3..3ee81f8 100644 --- a/stack-7.10.yaml +++ b/stack-7.10.yaml @@ -3,8 +3,8 @@ packages: - '.' extra-deps: - aeson-0.10.0.0 +- aeson-extra-0.1.0.0 - attoparsec-0.13.0.1 -- time-1.5.0.1 - doctest-0.10.1 - doctest-prop-0.2.0.1 - quickcheck-properties-0.1 diff --git a/stack-7.8.yaml b/stack-7.8.yaml deleted file mode 120000 index 2df91e0..0000000 --- a/stack-7.8.yaml +++ /dev/null @@ -1 +0,0 @@ -stack.yaml \ No newline at end of file diff --git a/stack-7.8.yaml b/stack-7.8.yaml new file mode 100644 index 0000000..2fa845d --- /dev/null +++ b/stack-7.8.yaml @@ -0,0 +1,8 @@ +flags: {} +packages: +- '.' +extra-deps: +- doctest-0.10.1 +- doctest-prop-0.2.0.1 +- quickcheck-properties-0.1 +resolver: lts-2.18 diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 index 461318f..0000000 --- a/stack.yaml +++ /dev/null @@ -1,12 +0,0 @@ -flags: {} -packages: -- '.' -extra-deps: -- aeson-0.10.0.0 -- attoparsec-0.13.0.1 -- time-1.5.0.1 -- doctest-0.10.1 -- doctest-prop-0.2.0.1 -- quickcheck-properties-0.1 -- uri-bytestring-0.1.9 -resolver: lts-2.18 diff --git a/stack.yaml b/stack.yaml new file mode 120000 index 0000000..177aa94 --- /dev/null +++ b/stack.yaml @@ -0,0 +1 @@ +stack-7.10.yaml \ No newline at end of file diff --git a/tests/tests.hs b/tests/tests.hs index 9cafb42..42a3ddb 100644 --- a/tests/tests.hs +++ b/tests/tests.hs @@ -116,6 +116,20 @@ instance FromJSON Tweet instance ToJSON Location instance FromJSON Location +data ParentMapping = ParentMapping deriving (Eq, Show) + +instance ToJSON ParentMapping where + toJSON ParentMapping = + object ["parent" .= Null ] + +data ChildMapping = ChildMapping deriving (Eq, Show) + +instance ToJSON ChildMapping where + toJSON ChildMapping = + object ["child" .= + object ["_parent" .= object ["type" .= ("parent" :: Text)]] + ] + data TweetMapping = TweetMapping deriving (Eq, Show) instance ToJSON TweetMapping where @@ -173,11 +187,17 @@ insertOther = do _ <- refreshIndex testIndex return () +insertWithSpaceInId :: BH IO () +insertWithSpaceInId = do + _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World") + _ <- refreshIndex testIndex + return () + searchTweet :: Search -> BH IO (Either String Tweet) searchTweet search = do result <- searchTweets search let myTweet = fmap (hitSource . head . hits . searchHits) result - return myTweet + return (either (Left "myTweet was Nothing") id myTweet) searchTweets :: Search -> BH IO (Either String (SearchResult Tweet)) searchTweets search = eitherDecode . responseBody <$> searchByIndex testIndex search @@ -228,6 +248,7 @@ searchExpectSource src expected = do reply <- searchAll search let result = eitherDecode (responseBody reply) :: Either String (SearchResult Value) let value = fmap (hitSource . head . hits . searchHits) result + liftIO (print value) liftIO $ value `shouldBe` expected @@ -315,6 +336,13 @@ main = hspec $ do (responseBody docInserted) :: Either String (EsResult Tweet) liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet)) + it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do + _ <- insertWithSpaceInId + docInserted <- getDocument testIndex testMapping (DocId "Hello World") + let newTweet = eitherDecode + (responseBody docInserted) :: Either String (EsResult Tweet) + liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet)) + it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do doc <- getDocument testIndex testMapping (DocId "bogus") let noTweet = eitherDecode @@ -330,6 +358,18 @@ main = hspec $ do res' <- insertData' cfg liftIO $ isVersionConflict res' `shouldBe` True + it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do + resetIndex + _ <- putMapping testIndex (MappingName "parent") ParentMapping + _ <- putMapping testIndex (MappingName "child") ChildMapping + _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1") + let parent = (Just . DocumentParent . DocId) "1" + ids = IndexDocumentSettings NoVersionControl parent + _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2") + _ <- refreshIndex testIndex + exists <- documentExists testIndex (MappingName "child") parent (DocId "2") + liftIO $ exists `shouldBe` True + describe "template API" $ do it "can create a template" $ withTestEnv $ do let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping] @@ -808,6 +848,6 @@ main = hspec $ do scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet] let scan_search = map hitSource scan_search' liftIO $ - regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored + regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored liftIO $ scan_search `shouldMatchList` [exampleTweet, otherTweet]