typeable/bloodhound
1
0
Fork 0
mirror of https://github.com/typeable/bloodhound.git synced 2024-12-03 23:15:14 +03:00
Code Issues Projects Releases Wiki Activity

what in the sam hell

Browse Source
This commit is contained in:
Chris Allen 2015-10-15 16:41:17 -05:00
commit 225f13abc0
9 changed files with 90 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.travis.yml
View File

@ -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

1
README.md
View File

@ -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
=============================

8
bloodhound.cabal
View File

@ -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,

45
src/Database/Bloodhound/Client.hs
View File

@ -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?

23
src/Database/Bloodhound/Types.hs
View File

@ -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

2
stack-7.10.yaml
View File

@ -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

1
stack-7.8.yaml
View File

@ -1 +0,0 @@
stack.yaml

8
stack-7.8.yaml Normal file
View File

@ -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

12
stack.yaml
View File

@ -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

1
stack.yaml Symbolic link
View File

@ -0,0 +1 @@
stack-7.10.yaml

44
tests/tests.hs
View File

@ -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]