Documents.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.Documents where

import Test.Common
import Test.Import

spec :: Spec
spec =
  describe "document API" $ do
    it "indexes, updates, gets, and then deletes the generated document" $
      withTestEnv $ do
        _ <- insertData
        _ <- updateData
        docInserted <- getDocument testIndex (DocId "1")
        let newTweet =
              eitherDecodeResponse docInserted ::
                Either String (EsResult Tweet)
        liftIO $ fmap getSource newTweet `shouldBe` Right (Just patchedTweet)

    it "indexes, gets, and then deletes the generated document with a DocId containing a space" $
      withTestEnv $ do
        _ <- insertWithSpaceInId
        docInserted <- getDocument testIndex (DocId "Hello World")
        let newTweet =
              eitherDecodeResponse 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 (DocId "bogus")
        let noTweet =
              eitherDecodeResponse doc ::
                Either String (EsResult Tweet)
        liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing

    it "can use optimistic concurrency control" $
      withTestEnv $ do
        let ev = ExternalDocVersion minBound
        let cfg = defaultIndexDocumentSettings {idsVersionControl = ExternalGT ev}
        resetIndex
        res <- insertData' cfg
        liftIO $ isCreated res `shouldBe` True
        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 ConversationMapping

        let parentSettings = defaultIndexDocumentSettings {idsJoinRelation = Just (ParentDocument (FieldName "reply_join") (RelationName "message"))}
        let childSettings = defaultIndexDocumentSettings {idsJoinRelation = Just (ChildDocument (FieldName "reply_join") (RelationName "reply") (DocId "1"))}

        _ <- indexDocument testIndex parentSettings exampleTweet (DocId "1")
        _ <- indexDocument testIndex childSettings otherTweet (DocId "2")

        _ <- refreshIndex testIndex

        let query = QueryHasParentQuery $ HasParentQuery (RelationName "message") (MatchAllQuery Nothing) Nothing Nothing
        let search = mkSearch (Just query) Nothing

        resp <- searchByIndex testIndex search
        parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))

        liftIO $ fmap (hitsTotal . searchHits) parsed `shouldBe` Right (HitsTotal 1 HTR_EQ)