bloodhound-1.0.0.0: tests/Test/PointInTimeSpec.hs
module Test.PointInTimeSpec (spec) where
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text qualified as Text
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Database.Bloodhound.ElasticSearch7.Client qualified as ClientES7
import Database.Bloodhound.ElasticSearch7.Requests qualified as ES7Requests
import Database.Bloodhound.ElasticSearch8.Client qualified as ClientES8
import Database.Bloodhound.ElasticSearch9.Client qualified as ClientES9
import Database.Bloodhound.ElasticSearch9.Requests qualified as ES9Requests
import Database.Bloodhound.ElasticSearch9.Types qualified as ES9Types
import Database.Bloodhound.OpenSearch2.Client qualified as ClientOS2
import Database.Bloodhound.OpenSearch2.Requests qualified as OS2Requests
import Database.Bloodhound.OpenSearch2.Types qualified as OS2Types
import Database.Bloodhound.OpenSearch3.Client qualified as ClientOS3
import Database.Bloodhound.OpenSearch3.Requests qualified as OS3Requests
import Database.Bloodhound.OpenSearch3.Types qualified as OS3Types
import Optics (set, view)
import TestsUtils.Common
import TestsUtils.Import
import Prelude
-- | The single 'testIndex' lifted into an 'IndexPattern', for the
-- 'openPointInTimeWith' / 'openPointInTimeWithBody' call sites that now
-- take an 'IndexPattern' target.
testPattern :: IndexPattern
testPattern = IndexPattern (unIndexName testIndex)
spec :: Spec
spec = do
describe "KeepAlive rendering" $ do
it "renders a single-minute value as <n>m" $
keepAliveToText (keepAliveMinutes 1) `shouldBe` "1m"
it "renders every supported unit suffix" $ do
keepAliveToText (keepAliveDays 1) `shouldBe` "1d"
keepAliveToText (keepAliveHours 1) `shouldBe` "1h"
keepAliveToText (keepAliveMinutes 1) `shouldBe` "1m"
keepAliveToText (keepAliveSeconds 30) `shouldBe` "30s"
keepAliveToText (keepAliveMilliseconds 500) `shouldBe` "500ms"
keepAliveToText (keepAliveMicroseconds 5) `shouldBe` "5micros"
keepAliveToText (keepAliveNanoseconds 7) `shouldBe` "7nanos"
it "Show instance matches the wire format" $
show (keepAliveSeconds 30) `shouldBe` "30s"
describe "KeepAlive JSON" $ do
it "encodes as a JSON string in <n><unit> form" $
decode (encode (keepAliveMinutes 1)) `shouldBe` Just ("1m" :: Text.Text)
it "decodes a plain @1m@ string back to KeepAlive" $
decode (encode ("1m" :: Text.Text)) `shouldBe` Just (keepAliveMinutes 1)
it "round-trips through ToJSON/FromJSON for every unit" $
mapM_
(\ka -> (decode . encode) ka `shouldBe` Just ka)
[ keepAliveDays 2,
keepAliveHours 12,
keepAliveMinutes 1,
keepAliveSeconds 45,
keepAliveMilliseconds 250,
keepAliveMicroseconds 9,
keepAliveNanoseconds 3
]
it "rejects malformed input (no magnitude)" $
decode (encode ("" :: Text.Text)) `shouldBe` (Nothing :: Maybe KeepAlive)
it "rejects malformed input (bad unit)" $
decode (encode ("1x" :: Text.Text)) `shouldBe` (Nothing :: Maybe KeepAlive)
it "rejects magnitudes that overflow Word32" $
decode (encode ("4294967296s" :: Text.Text)) `shouldBe` (Nothing :: Maybe KeepAlive)
it "accepts leading zeros in the magnitude" $
decode (encode ("01s" :: Text.Text)) `shouldBe` Just (keepAliveSeconds 1)
it "forwards zero durations as-is (the server will reject them)" $ do
keepAliveToText (keepAliveSeconds 0) `shouldBe` "0s"
getRawEndpointQueries
(bhRequestEndpoint (ES7Requests.openPointInTime testIndex (keepAliveSeconds 0)))
`shouldBe` [("keep_alive", Just "0s")]
describe "PointInTime JSON" $ do
it "encodes to the wire object {\"id\",\"keep_alive\"} with KeepAlive rendered as <n><unit>" $
encode (PointInTime "pit-id" (Just (keepAliveMinutes 1)))
`shouldBe` "{\"id\":\"pit-id\",\"keep_alive\":\"1m\"}"
it "round-trips a PointInTime through ToJSON/FromJSON" $ do
let pit = PointInTime "pit-id" (Just (keepAliveMinutes 1))
(decode . encode) pit `shouldBe` Just pit
it "round-trips through ToJSON/FromJSON for every KeepAlive unit" $
mapM_
( \ka -> do
let pit = PointInTime "pit-id" (Just ka)
(decode . encode) pit `shouldBe` Just pit
)
[ keepAliveDays 2,
keepAliveHours 12,
keepAliveMinutes 1,
keepAliveSeconds 45,
keepAliveMilliseconds 250,
keepAliveMicroseconds 9,
keepAliveNanoseconds 3
]
it "decodes a well-formed wire object into PointInTime" $
decode "{\"id\":\"pit-id\",\"keep_alive\":\"1m\"}"
`shouldBe` Just (PointInTime "pit-id" (Just (keepAliveMinutes 1)))
it "rejects malformed keep_alive values in the wire object" $
decode "{\"id\":\"pit-id\",\"keep_alive\":\"1x\"}"
`shouldBe` (Nothing :: Maybe PointInTime)
it "decodes a payload missing keep_alive (optional per spec) as Nothing" $
decode "{\"id\":\"pit-id\"}"
`shouldBe` Just (PointInTime "pit-id" Nothing)
it "pointInTimeKeepAliveLens round-trips a KeepAlive" $ do
let pit = PointInTime "pit-id" (Just (keepAliveMinutes 1))
pit' = set pointInTimeKeepAliveLens (Just (keepAliveSeconds 30)) pit
view pointInTimeKeepAliveLens pit' `shouldBe` Just (keepAliveSeconds 30)
describe "openPointInTime endpoint shape" $ do
-- Pure checks against the BHRequest shape; no live backend needed.
it "ES7 emits /{index}/_pit with keep_alive as a query param (not in the path)" $ do
let req = ES7Requests.openPointInTime testIndex (keepAliveSeconds 30)
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` [unIndexName testIndex, "_pit"]
getRawEndpointQueries (bhRequestEndpoint req)
`shouldBe` [("keep_alive", Just "30s")]
it "OS3 emits /{index}/_search/point_in_time with keep_alive as a query param" $ do
let req = OS3Requests.openPointInTime testIndex (keepAliveMinutes 5)
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` [unIndexName testIndex, "_search", "point_in_time"]
getRawEndpointQueries (bhRequestEndpoint req)
`shouldBe` [("keep_alive", Just "5m")]
describe "listAllPITs endpoint shape" $ do
-- ES7/ES8/ES9 have no list-all-PITs endpoint: @GET /_pit@ returns
-- @405@ on every ES version (bloodhound-cfv). Only OpenSearch 2/3
-- expose one, at @GET /_search/point_in_time/_all@.
it "OS2 emits GET /_search/point_in_time/_all with no query params" $ do
let req = OS2Requests.listAllPITs
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_search", "point_in_time", "_all"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
it "OS3 emits GET /_search/point_in_time/_all with no query params" $ do
let req = OS3Requests.listAllPITs
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_search", "point_in_time", "_all"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
describe "deleteAllPITs endpoint shape" $ do
-- Pure checks against the BHRequest shape; no live backend needed.
-- deleteAllPITs is bodyless (unlike closePointInTime, which is the
-- delete-by-ID endpoint carrying a ClosePointInTime body).
it "OS2 emits DELETE /_search/point_in_time/_all with no body and no query params" $ do
let req = OS2Requests.deleteAllPITs
bhRequestMethod req `shouldBe` "DELETE"
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_search", "point_in_time", "_all"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Nothing
it "OS3 emits DELETE /_search/point_in_time/_all with no body and no query params" $ do
let req = OS3Requests.deleteAllPITs
bhRequestMethod req `shouldBe` "DELETE"
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_search", "point_in_time", "_all"]
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` []
bhRequestBody req `shouldBe` Nothing
it "OS2 deleteAllPITs and closePointInTime hit different paths" $ do
let allReq = OS2Requests.deleteAllPITs
byIdReq = OS2Requests.closePointInTime (OS2Types.ClosePointInTime ["x"])
getRawEndpoint (bhRequestEndpoint allReq)
`shouldBe` ["_search", "point_in_time", "_all"]
getRawEndpoint (bhRequestEndpoint byIdReq)
`shouldBe` ["_search", "point_in_time"]
bhRequestBody allReq `shouldBe` Nothing
bhRequestBody byIdReq `shouldNotBe` Nothing
it "OS3 deleteAllPITs and closePointInTime hit different paths" $ do
let allReq = OS3Requests.deleteAllPITs
byIdReq = OS3Requests.closePointInTime (OS3Types.ClosePointInTime ["x"])
getRawEndpoint (bhRequestEndpoint allReq)
`shouldBe` ["_search", "point_in_time", "_all"]
getRawEndpoint (bhRequestEndpoint byIdReq)
`shouldBe` ["_search", "point_in_time"]
bhRequestBody allReq `shouldBe` Nothing
bhRequestBody byIdReq `shouldNotBe` Nothing
describe "deleteAllPITs JSON (OpenSearch 2)" $
-- deleteAllPITs reuses the ClosePointInTimeResponse envelope
-- (@{\"pits\":[{successful,pit_id}]}@): the Delete All PITs API
-- processes each PIT individually and reports one result per PIT,
-- so the wire shape is shared with the delete-by-ID endpoint
-- (closePointInTime). This pins the decode of a multi-PIT
-- delete-all-style response through the shared type.
it "decodes a {pits:[{successful,pit_id}]} payload via ClosePointInTimeResponse" $
decode
"{\"pits\":[{\"successful\":true,\"pit_id\":\"pit-1\"},{\"successful\":false,\"pit_id\":\"pit-2\"}]}"
`shouldBe` Just
( OS2Types.ClosePointInTimeResponse
[ OS2Types.ClosePointInTimeResult True "pit-1",
OS2Types.ClosePointInTimeResult False "pit-2"
]
)
describe "deleteAllPITs JSON (OpenSearch 3)" $
it "decodes a {pits:[{successful,pit_id}]} payload via ClosePointInTimeResponse" $
decode
"{\"pits\":[{\"successful\":true,\"pit_id\":\"pit-1\"},{\"successful\":false,\"pit_id\":\"pit-2\"}]}"
`shouldBe` Just
( OS3Types.ClosePointInTimeResponse
[ OS3Types.ClosePointInTimeResult True "pit-1",
OS3Types.ClosePointInTimeResult False "pit-2"
]
)
describe "deleteAllPITs empty response" $ do
-- Edge case: deleting all PITs when none are open yields an empty
-- pits array. The shared ClosePointInTimeResponse codec must accept
-- it (the cluster reported zero PITs to delete).
it "OS2 decodes an empty {pits:[]} payload" $
decode "{\"pits\":[]}"
`shouldBe` Just (OS2Types.ClosePointInTimeResponse [])
it "OS3 decodes an empty {pits:[]} payload" $
decode "{\"pits\":[]}"
`shouldBe` Just (OS3Types.ClosePointInTimeResponse [])
describe "OpenPointInTimeResponse JSON (OpenSearch 2)" $ do
-- creation_time is a POSIXMS millisecond count on the wire (a JSON
-- number); POSIXMS's codec is asymmetric (ToJSON renders the underlying
-- UTCTime as an ISO-8601 string, FromJSON expects a numeric ms count),
-- so we verify the decode direction with a millisecond payload and check
-- the parsed creation_time via its accessor rather than round-tripping.
-- Regression for bloodhound-8v0: the field was previously POSIXTime
-- (seconds), so a real ms value like 1658146050064 decoded to a date
-- off by 1000x.
it "decodes a create response with a millisecond creation_time" $ do
let decoded =
decode
"{\"pit_id\":\"pit-1\",\"_shards\":{\"total\":3,\"successful\":2,\"skipped\":1,\"failed\":0},\"creation_time\":1658146050064}" ::
Maybe OS2Types.OpenPointInTimeResponse
case decoded of
Just resp -> do
OS2Types.oos2PitId resp `shouldBe` "pit-1"
OS2Types.oos2Shards resp `shouldBe` ShardResult 3 2 1 0
OS2Types.oos2CreationTime resp `shouldBe` posixMSFromMillis 1658146050064
Nothing -> expectationFailure "expected a decoded OpenPointInTimeResponse"
it "rejects a non-numeric creation_time" $
decode
"{\"pit_id\":\"pit-1\",\"_shards\":{\"total\":3,\"successful\":2,\"skipped\":1,\"failed\":0},\"creation_time\":\"not-a-number\"}"
`shouldBe` (Nothing :: Maybe OS2Types.OpenPointInTimeResponse)
describe "listAllPITs JSON (OpenSearch 2)" $ do
-- Note: PITInfo's keep_alive codec is asymmetric by design — FromJSON
-- parses the wire millisecond count (a bare JSON number), while ToJSON
-- re-renders it as a KeepAlive "<n>ms" string. creation_time is a
-- POSIXMS millisecond count on the wire (mirroring OpenSearch 3), and
-- POSIXMS's ToJSON renders the underlying UTCTime as an ISO-8601 string
-- while FromJSON expects a numeric millisecond count, so both fields'
-- codecs are asymmetric by design. We only verify the decode direction
-- (the way a response flows off the wire), and check the pit_id /
-- keep_alive fields rather than reconstructing the POSIXMS value for
-- the field-match cases (avoids duplicating the parser's truncation
-- arithmetic here).
it "decodes a well-formed {\"pits\":[{\"pit_id\",\"creation_time\",\"keep_alive\"}]} payload" $
decode
"{\"pits\":[{\"pit_id\":\"pit-1\",\"creation_time\":1700000000000,\"keep_alive\":60000}]}"
`shouldBe` Just
( OS2Types.ListPITsResponse
[ OS2Types.PITInfo "pit-1" (posixMSFromMillis 1700000000000) (keepAliveMilliseconds 60000)
]
)
it "the decoded pit_id and keep_alive match the wire payload" $ do
let decoded =
decode
"{\"pits\":[{\"pit_id\":\"pit-99\",\"creation_time\":1.0,\"keep_alive\":5000}]}" ::
Maybe OS2Types.ListPITsResponse
case decoded of
Just (OS2Types.ListPITsResponse [p]) -> do
OS2Types.pitInfoId p `shouldBe` "pit-99"
OS2Types.pitInfoKeepAlive p `shouldBe` keepAliveMilliseconds 5000
_ -> expectationFailure "expected a single-element ListPITsResponse"
it "decodes an empty pits array" $
decode "{\"pits\":[]}"
`shouldBe` Just (OS2Types.ListPITsResponse [])
it "rejects a missing pits field" $
decode "{\"pit_id\":\"pit-1\"}"
`shouldBe` (Nothing :: Maybe OS2Types.ListPITsResponse)
it "rejects a malformed pit_id in a pits element" $
decode
"{\"pits\":[{\"pit_id\":42,\"creation_time\":1.0,\"keep_alive\":5000}]}"
`shouldBe` (Nothing :: Maybe OS2Types.ListPITsResponse)
it "rejects a pits element that omits keep_alive (regression: old code required _shards instead)" $
decode
"{\"pits\":[{\"pit_id\":\"pit-1\",\"creation_time\":1.0}]}"
`shouldBe` (Nothing :: Maybe OS2Types.ListPITsResponse)
describe "listAllPITs JSON (OpenSearch 3)" $ do
-- Note: PITInfo's keep_alive codec is asymmetric (see OpenSearch 2
-- note above), and POSIXMS's ToJSON renders the underlying UTCTime as
-- an ISO-8601 string while FromJSON expects a numeric millisecond
-- count, so both fields' codecs are asymmetric by design. We only
-- verify the decode direction, which is the direction a response flows
-- off the wire, and check the pit_id / keep_alive fields rather than
-- reconstructing the POSIXMS value (avoids duplicating the parser's
-- truncation arithmetic here).
it "decodes a well-formed {\"pits\":[{\"pit_id\",\"creation_time\",\"keep_alive\"}]} payload" $
decode
"{\"pits\":[{\"pit_id\":\"pit-1\",\"creation_time\":1700000000123,\"keep_alive\":60000}]}"
`shouldBe` Just
( OS3Types.ListPITsResponse
[ OS3Types.PITInfo
"pit-1"
(posixMSFromMillis 1700000000123)
(keepAliveMilliseconds 60000)
]
)
it "the decoded pit_id and keep_alive match the wire payload" $ do
let decoded =
decode
"{\"pits\":[{\"pit_id\":\"pit-99\",\"creation_time\":1700000000000,\"keep_alive\":5000}]}" ::
Maybe OS3Types.ListPITsResponse
case decoded of
Just (OS3Types.ListPITsResponse [p]) -> do
OS3Types.pitInfoId p `shouldBe` "pit-99"
OS3Types.pitInfoKeepAlive p `shouldBe` keepAliveMilliseconds 5000
_ -> expectationFailure "expected a single-element ListPITsResponse"
it "decodes an empty pits array" $
decode "{\"pits\":[]}"
`shouldBe` Just (OS3Types.ListPITsResponse [])
it "rejects a missing pits field" $
decode "{\"pit_id\":\"pit-1\"}"
`shouldBe` (Nothing :: Maybe OS3Types.ListPITsResponse)
it "rejects a malformed pit_id in a pits element" $
decode
"{\"pits\":[{\"pit_id\":42,\"creation_time\":1700000000123,\"keep_alive\":60000}]}"
`shouldBe` (Nothing :: Maybe OS3Types.ListPITsResponse)
it "rejects a pits element that omits keep_alive (regression: old code required _shards instead)" $
decode
"{\"pits\":[{\"pit_id\":\"pit-1\",\"creation_time\":1700000000123}]}"
`shouldBe` (Nothing :: Maybe OS3Types.ListPITsResponse)
describe "closePointInTime JSON (OpenSearch 2)" $ do
it "encodes ClosePointInTime as {pit_id: [...]} (not the ES {id: ...})" $
encode (OS2Types.ClosePointInTime ["pit-id-xyz"])
`shouldBe` encode (object ["pit_id" .= (["pit-id-xyz"] :: [Text.Text])])
it "round-trips ClosePointInTime through ToJSON/FromJSON" $ do
let cpit = OS2Types.ClosePointInTime ["pit-id-xyz", "pit-id-2"]
decode (encode cpit) `shouldBe` Just cpit
it "round-trips an empty ClosePointInTime (empty pit_id array)" $ do
let cpit = OS2Types.ClosePointInTime []
decode (encode cpit) `shouldBe` Just cpit
it "round-trips ClosePointInTimeResponse through ToJSON/FromJSON" $ do
let resp =
OS2Types.ClosePointInTimeResponse
[OS2Types.ClosePointInTimeResult True "pit-id-xyz"]
decode (encode resp) `shouldBe` Just resp
it "decodes the documented {pits:[{successful,pit_id}]} payload" $
decode "{\"pits\":[{\"successful\":true,\"pit_id\":\"pit-1\"}]}"
`shouldBe` Just
( OS2Types.ClosePointInTimeResponse
[OS2Types.ClosePointInTimeResult True "pit-1"]
)
it "rejects the Elasticsearch {succeeded,num_freed} shape (regression)" $
decode "{\"succeeded\":true,\"num_freed\":1}"
`shouldBe` (Nothing :: Maybe OS2Types.ClosePointInTimeResponse)
describe "closePointInTime JSON (OpenSearch 3)" $ do
it "encodes ClosePointInTime as {pit_id: [...]} (not the ES {id: ...})" $
encode (OS3Types.ClosePointInTime ["pit-id-xyz"])
`shouldBe` encode (object ["pit_id" .= (["pit-id-xyz"] :: [Text.Text])])
it "round-trips ClosePointInTime through ToJSON/FromJSON" $ do
let cpit = OS3Types.ClosePointInTime ["pit-id-xyz", "pit-id-2"]
decode (encode cpit) `shouldBe` Just cpit
it "round-trips an empty ClosePointInTime (empty pit_id array)" $ do
let cpit = OS3Types.ClosePointInTime []
decode (encode cpit) `shouldBe` Just cpit
it "round-trips ClosePointInTimeResponse through ToJSON/FromJSON" $ do
let resp =
OS3Types.ClosePointInTimeResponse
[OS3Types.ClosePointInTimeResult True "pit-id-xyz"]
decode (encode resp) `shouldBe` Just resp
it "decodes the documented {pits:[{successful,pit_id}]} payload" $
decode "{\"pits\":[{\"successful\":true,\"pit_id\":\"pit-1\"}]}"
`shouldBe` Just
( OS3Types.ClosePointInTimeResponse
[OS3Types.ClosePointInTimeResult True "pit-1"]
)
it "rejects the Elasticsearch {succeeded,num_freed} shape (regression)" $
decode "{\"succeeded\":true,\"num_freed\":1}"
`shouldBe` (Nothing :: Maybe OS3Types.ClosePointInTimeResponse)
describe "PITOptions renderer" $ do
it "defaultPITOptions emits no pairs (no overhead beyond keep_alive)" $
pitOptionsParams defaultPITOptions `shouldBe` []
it "osPITOptionsParams with defaultPITOptions emits no pairs" $
osPITOptionsParams defaultPITOptions `shouldBe` []
it "pitOptionsParams renders routing, preference, expand_wildcards" $ do
let opts =
defaultPITOptions
{ pitoRouting = Just "user-1",
pitoPreference = Just "_local",
pitoExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsHidden])
}
-- The order is stable but unspecified; compare as a set via sorting.
-- The renderer emits exactly these three pairs.
sortPairs (pitOptionsParams opts)
`shouldBe` sortPairs
[ ("expand_wildcards", Just "open,hidden"),
("preference", Just "_local"),
("routing", Just "user-1")
]
it "pitOptionsParams drops OS-only allow_partial_pit_creation" $ do
let opts =
defaultPITOptions
{ pitoAllowPartialPITCreation = Just True
}
pitOptionsParams opts `shouldBe` []
it "osPITOptionsParams renders all four fields when set" $ do
let opts =
defaultPITOptions
{ pitoRouting = Just "user-1",
pitoPreference = Just "_local",
pitoExpandWildcards = Just (ExpandWildcardsClosed :| []),
pitoAllowPartialPITCreation = Just True
}
sortPairs (osPITOptionsParams opts)
`shouldBe` sortPairs
[ ("routing", Just "user-1"),
("preference", Just "_local"),
("expand_wildcards", Just "closed"),
("allow_partial_pit_creation", Just "true")
]
it "osPITOptionsParams renders allow_partial_pit_creation=false when set to False" $ do
let opts = defaultPITOptions {pitoAllowPartialPITCreation = Just False}
osPITOptionsParams opts
`shouldBe` [("allow_partial_pit_creation", Just "false")]
it "pitoRoutingLens round-trips" $ do
let opts = set pitoRoutingLens (Just "abc") defaultPITOptions
view pitoRoutingLens opts `shouldBe` Just "abc"
it "pitoPreferenceLens round-trips" $ do
let opts = set pitoPreferenceLens (Just "_local") defaultPITOptions
view pitoPreferenceLens opts `shouldBe` Just "_local"
it "pitoExpandWildcardsLens round-trips" $ do
let opts = set pitoExpandWildcardsLens (Just (ExpandWildcardsOpen :| [])) defaultPITOptions
view pitoExpandWildcardsLens opts `shouldBe` Just (ExpandWildcardsOpen :| [])
it "pitoAllowPartialPITCreationLens round-trips" $ do
let opts = set pitoAllowPartialPITCreationLens (Just True) defaultPITOptions
view pitoAllowPartialPITCreationLens opts `shouldBe` Just True
it "pitOptionsParams renders the ES-only ignore_unavailable, allow_partial_search_results, max_concurrent_shard_requests" $ do
let opts =
defaultPITOptions
{ pitoIgnoreUnavailable = Just True,
pitoAllowPartialSearchResults = Just False,
pitoMaxConcurrentShardRequests = Just 16
}
sortPairs (pitOptionsParams opts)
`shouldBe` sortPairs
[ ("ignore_unavailable", Just "true"),
("allow_partial_search_results", Just "false"),
("max_concurrent_shard_requests", Just "16")
]
it "pitOptionsParams emits a single ES-only param when only one is set" $
pitOptionsParams (defaultPITOptions {pitoIgnoreUnavailable = Just True})
`shouldBe` [("ignore_unavailable", Just "true")]
it "osPITOptionsParams does NOT emit the ES-only params" $ do
let opts =
defaultPITOptions
{ pitoIgnoreUnavailable = Just True,
pitoAllowPartialSearchResults = Just False,
pitoMaxConcurrentShardRequests = Just 16
}
osPITOptionsParams opts `shouldBe` []
it "pitoIgnoreUnavailableLens round-trips" $ do
let opts = set pitoIgnoreUnavailableLens (Just True) defaultPITOptions
view pitoIgnoreUnavailableLens opts `shouldBe` Just True
it "pitoAllowPartialSearchResultsLens round-trips" $ do
let opts = set pitoAllowPartialSearchResultsLens (Just False) defaultPITOptions
view pitoAllowPartialSearchResultsLens opts `shouldBe` Just False
it "pitoMaxConcurrentShardRequestsLens round-trips" $ do
let opts = set pitoMaxConcurrentShardRequestsLens (Just 5) defaultPITOptions
view pitoMaxConcurrentShardRequestsLens opts `shouldBe` Just 5
describe "openPointInTimeWith endpoint shape" $ do
-- Pure checks against the BHRequest shape; no live backend needed.
it "ES7 with defaultPITOptions is byte-identical to openPointInTime" $ do
let simpleReq = ES7Requests.openPointInTime testIndex (keepAliveSeconds 30)
withReq = ES7Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) defaultPITOptions
getRawEndpoint (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpoint (bhRequestEndpoint withReq)
getRawEndpointQueries (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpointQueries (bhRequestEndpoint withReq)
it "ES7 forwards routing/preference/expand_wildcards (3 params)" $ do
let opts =
defaultPITOptions
{ pitoRouting = Just "user-1",
pitoPreference = Just "_local",
pitoExpandWildcards = Just (ExpandWildcardsOpen :| [ExpandWildcardsHidden])
}
req = ES7Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) opts
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` [unIndexName testIndex, "_pit"]
-- The endpoint's queries carry keep_alive first (always), then the
-- three ES-recognized params. OS-only fields are NOT emitted.
sortPairs (getRawEndpointQueries (bhRequestEndpoint req))
`shouldBe` sortPairs
[ ("keep_alive", Just "30s"),
("routing", Just "user-1"),
("preference", Just "_local"),
("expand_wildcards", Just "open,hidden")
]
it "ES7 does NOT emit OpenSearch-only allow_partial_pit_creation" $ do
let opts =
defaultPITOptions
{ pitoAllowPartialPITCreation = Just True
}
req = ES7Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) opts
-- Only keep_alive is present; the OS-only fields are silently dropped.
getRawEndpointQueries (bhRequestEndpoint req)
`shouldBe` [("keep_alive", Just "30s")]
it "ES9 forwards routing/preference/expand_wildcards (3 params, uses local ES9 builder)" $ do
let opts =
defaultPITOptions
{ pitoRouting = Just "user-9",
pitoPreference = Just "_only_local",
pitoExpandWildcards = Just (ExpandWildcardsClosed :| [])
}
req = ES9Requests.openPointInTimeWith testPattern (keepAliveMinutes 2) opts
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` [unIndexName testIndex, "_pit"]
sortPairs (getRawEndpointQueries (bhRequestEndpoint req))
`shouldBe` sortPairs
[ ("keep_alive", Just "2m"),
("routing", Just "user-9"),
("preference", Just "_only_local"),
("expand_wildcards", Just "closed")
]
it "ES9 does NOT emit OpenSearch-only allow_partial_pit_creation" $ do
let opts =
defaultPITOptions
{ pitoAllowPartialPITCreation = Just True
}
req = ES9Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) opts
getRawEndpointQueries (bhRequestEndpoint req)
`shouldBe` [("keep_alive", Just "30s")]
it "ES7 forwards the ES-only ignore_unavailable, allow_partial_search_results, max_concurrent_shard_requests" $ do
let opts =
defaultPITOptions
{ pitoIgnoreUnavailable = Just True,
pitoAllowPartialSearchResults = Just False,
pitoMaxConcurrentShardRequests = Just 16
}
req = ES7Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) opts
sortPairs (getRawEndpointQueries (bhRequestEndpoint req))
`shouldBe` sortPairs
[ ("keep_alive", Just "30s"),
("ignore_unavailable", Just "true"),
("allow_partial_search_results", Just "false"),
("max_concurrent_shard_requests", Just "16")
]
it "ES9 forwards the ES-only params" $ do
let opts =
defaultPITOptions
{ pitoIgnoreUnavailable = Just False,
pitoMaxConcurrentShardRequests = Just 8
}
req = ES9Requests.openPointInTimeWith testPattern (keepAliveMinutes 2) opts
sortPairs (getRawEndpointQueries (bhRequestEndpoint req))
`shouldBe` sortPairs
[ ("keep_alive", Just "2m"),
("ignore_unavailable", Just "false"),
("max_concurrent_shard_requests", Just "8")
]
it "OS2 does NOT emit the ES-only params" $ do
let opts =
defaultPITOptions
{ pitoIgnoreUnavailable = Just True,
pitoAllowPartialSearchResults = Just False,
pitoMaxConcurrentShardRequests = Just 16
}
req = OS2Requests.openPointInTimeWith testPattern (keepAliveMinutes 1) opts
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` [("keep_alive", Just "1m")]
it "OS3 does NOT emit the ES-only params" $ do
let opts =
defaultPITOptions
{ pitoIgnoreUnavailable = Just True,
pitoMaxConcurrentShardRequests = Just 16
}
req = OS3Requests.openPointInTimeWith testPattern (keepAliveMinutes 1) opts
getRawEndpointQueries (bhRequestEndpoint req) `shouldBe` [("keep_alive", Just "1m")]
it "OS2 forwards all four params (including allow_partial_pit_creation)" $ do
let opts =
defaultPITOptions
{ pitoRouting = Just "user-2",
pitoPreference = Just "_local",
pitoExpandWildcards = Just (ExpandWildcardsOpen :| []),
pitoAllowPartialPITCreation = Just True
}
req = OS2Requests.openPointInTimeWith testPattern (keepAliveMinutes 1) opts
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` [unIndexName testIndex, "_search", "point_in_time"]
sortPairs (getRawEndpointQueries (bhRequestEndpoint req))
`shouldBe` sortPairs
[ ("keep_alive", Just "1m"),
("routing", Just "user-2"),
("preference", Just "_local"),
("expand_wildcards", Just "open"),
("allow_partial_pit_creation", Just "true")
]
it "OS3 forwards all four params (including allow_partial_pit_creation)" $ do
let opts =
defaultPITOptions
{ pitoRouting = Just "user-3",
pitoPreference = Just "_local",
pitoExpandWildcards = Just (ExpandWildcardsOpen :| []),
pitoAllowPartialPITCreation = Just False
}
req = OS3Requests.openPointInTimeWith testPattern (keepAliveMinutes 1) opts
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` [unIndexName testIndex, "_search", "point_in_time"]
sortPairs (getRawEndpointQueries (bhRequestEndpoint req))
`shouldBe` sortPairs
[ ("keep_alive", Just "1m"),
("routing", Just "user-3"),
("preference", Just "_local"),
("expand_wildcards", Just "open"),
("allow_partial_pit_creation", Just "false")
]
it "OS2 with defaultPITOptions is byte-identical to openPointInTime" $ do
let simpleReq = OS2Requests.openPointInTime testIndex (keepAliveMinutes 5)
withReq = OS2Requests.openPointInTimeWith testPattern (keepAliveMinutes 5) defaultPITOptions
getRawEndpoint (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpoint (bhRequestEndpoint withReq)
getRawEndpointQueries (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpointQueries (bhRequestEndpoint withReq)
it "OS3 with defaultPITOptions is byte-identical to openPointInTime" $ do
let simpleReq = OS3Requests.openPointInTime testIndex (keepAliveMinutes 5)
withReq = OS3Requests.openPointInTimeWith testPattern (keepAliveMinutes 5) defaultPITOptions
getRawEndpoint (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpoint (bhRequestEndpoint withReq)
getRawEndpointQueries (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpointQueries (bhRequestEndpoint withReq)
describe "openPointInTimeWith multi-target (IndexPattern)" $ do
-- Pure checks that a comma-list or wildcard IndexPattern is rendered
-- verbatim as the first URL path segment. No live backend needed.
-- See bloodhound-6pcg: mkIndexName rejects '*' and ',', so the only
-- way to target multiple indices or a wildcard is via IndexPattern.
--
-- These tests satisfy bloodhound-o8dc's wildcard-rendering
-- acceptance criterion: a wildcard target built without going
-- through mkIndexName (here: a literal IndexPattern "logs-*")
-- survives the renderer unchanged on every backend.
let commaPattern = IndexPattern "logs-2024,logs-2025"
wildcardPattern = IndexPattern "logs-*"
it "ES7 renders a comma-joined IndexPattern as one path segment" $ do
let req = ES7Requests.openPointInTimeWith commaPattern (keepAliveSeconds 30) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs-2024,logs-2025", "_pit"]
it "ES7 renders a wildcard IndexPattern as one path segment" $ do
let req = ES7Requests.openPointInTimeWith wildcardPattern (keepAliveMinutes 1) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs-*", "_pit"]
it "ES9 renders a comma-joined IndexPattern as one path segment" $ do
let req = ES9Requests.openPointInTimeWith commaPattern (keepAliveSeconds 30) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs-2024,logs-2025", "_pit"]
it "ES9 renders a wildcard IndexPattern as one path segment" $ do
let req = ES9Requests.openPointInTimeWith wildcardPattern (keepAliveMinutes 1) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs-*", "_pit"]
it "OS2 renders a comma-joined IndexPattern as one path segment" $ do
let req = OS2Requests.openPointInTimeWith commaPattern (keepAliveMinutes 1) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["logs-2024,logs-2025", "_search", "point_in_time"]
it "OS2 renders a wildcard IndexPattern as one path segment" $ do
let req = OS2Requests.openPointInTimeWith wildcardPattern (keepAliveMinutes 1) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["logs-*", "_search", "point_in_time"]
it "OS3 renders a comma-joined IndexPattern as one path segment" $ do
let req = OS3Requests.openPointInTimeWith commaPattern (keepAliveMinutes 1) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["logs-2024,logs-2025", "_search", "point_in_time"]
it "OS3 renders a wildcard IndexPattern as one path segment" $ do
let req = OS3Requests.openPointInTimeWith wildcardPattern (keepAliveMinutes 1) defaultPITOptions
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["logs-*", "_search", "point_in_time"]
it "ES7 openPointInTimeWithBody renders a wildcard IndexPattern target" $ do
let req = ES7Requests.openPointInTimeWithBody wildcardPattern (keepAliveMinutes 1) defaultOpenPointInTimeBody defaultPITOptions
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs-*", "_pit"]
it "ES9 openPointInTimeWithBody renders a comma-joined IndexPattern target" $ do
let req = ES9Requests.openPointInTimeWithBody commaPattern (keepAliveMinutes 1) defaultOpenPointInTimeBody defaultPITOptions
getRawEndpoint (bhRequestEndpoint req) `shouldBe` ["logs-2024,logs-2025", "_pit"]
it "openPointInTime convenience lifts a single IndexName into the path" $ do
-- Regression guard: openPointInTime (IndexName) must render the same
-- first path segment as openPointInTimeWith (IndexPattern ...) with the
-- lifted pattern.
let simpleReq = ES7Requests.openPointInTime testIndex (keepAliveSeconds 30)
withReq = ES7Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) defaultPITOptions
getRawEndpoint (bhRequestEndpoint simpleReq)
`shouldBe` getRawEndpoint (bhRequestEndpoint withReq)
describe "pitSearchWith export and reachability" $ do
-- Compile-time reachability guards: referencing the identifier at each
-- backend's Client surface + the dynamic dispatch forces the exporters
-- to ship it. Mirrors the closePointInTime ES8 guard above.
-- Instantiated at @BH IO [Hit Value]@ to resolve the FromJSON result
-- type; the action is built but never executed.
it "ES7 pitSearchWith is reachable through the Client API" $
let guardExport :: BH IO ()
guardExport =
void
( ClientES7.pitSearchWith testPattern (keepAliveMinutes 1) (mkSearch Nothing Nothing) ::
BH IO [Hit Value]
)
in guardExport `seq` (True `shouldBe` True)
it "ES8 pitSearchWith is reachable through the Client API" $
let guardExport :: BH IO ()
guardExport =
void
( ClientES8.pitSearchWith testPattern (keepAliveMinutes 1) (mkSearch Nothing Nothing) ::
BH IO [Hit Value]
)
in guardExport `seq` (True `shouldBe` True)
it "ES9 pitSearchWith is reachable through the Client API" $
let guardExport :: BH IO ()
guardExport =
void
( ClientES9.pitSearchWith testPattern (keepAliveMinutes 1) (mkSearch Nothing Nothing) ::
BH IO [Hit Value]
)
in guardExport `seq` (True `shouldBe` True)
it "OS2 pitSearchWith is reachable through the Client API" $
let guardExport :: BH IO ()
guardExport =
void
( ClientOS2.pitSearchWith testPattern (keepAliveMinutes 1) (mkSearch Nothing Nothing) ::
BH IO [Hit Value]
)
in guardExport `seq` (True `shouldBe` True)
it "OS3 pitSearchWith is reachable through the Client API" $
let guardExport :: BH IO ()
guardExport =
void
( ClientOS3.pitSearchWith testPattern (keepAliveMinutes 1) (mkSearch Nothing Nothing) ::
BH IO [Hit Value]
)
in guardExport `seq` (True `shouldBe` True)
describe "OpenPointInTimeBody" $ do
it "defaultOpenPointInTimeBody encodes to {}" $
encode defaultOpenPointInTimeBody `shouldBe` "{}"
it "encodes an index_filter query and omits it when absent" $ do
let body = defaultOpenPointInTimeBody {pitBodyIndexFilter = Just (MatchAllQuery Nothing)}
decode (encode body)
`shouldBe` Just (object ["index_filter" .= MatchAllQuery Nothing])
it "pitBodyIndexFilterLens round-trips" $ do
let body = set pitBodyIndexFilterLens (Just (MatchAllQuery Nothing)) defaultOpenPointInTimeBody
view pitBodyIndexFilterLens body `shouldBe` Just (MatchAllQuery Nothing)
it "ES7 openPointInTimeWithBody sends the body and reuses the openPointInTimeWith endpoint/queries" $ do
let opts = defaultPITOptions {pitoIgnoreUnavailable = Just True}
body = defaultOpenPointInTimeBody {pitBodyIndexFilter = Just (MatchAllQuery Nothing)}
reqBody = ES7Requests.openPointInTimeWithBody testPattern (keepAliveSeconds 30) body opts
reqNoBody = ES7Requests.openPointInTimeWith testPattern (keepAliveSeconds 30) opts
bhRequestBody reqBody `shouldBe` Just (encode body)
getRawEndpoint (bhRequestEndpoint reqBody)
`shouldBe` getRawEndpoint (bhRequestEndpoint reqNoBody)
sortPairs (getRawEndpointQueries (bhRequestEndpoint reqBody))
`shouldBe` sortPairs (getRawEndpointQueries (bhRequestEndpoint reqNoBody))
it "ES7 openPointInTimeWithBody with defaultOpenPointInTimeBody sends {}" $ do
let req = ES7Requests.openPointInTimeWithBody testPattern (keepAliveMinutes 1) defaultOpenPointInTimeBody defaultPITOptions
bhRequestBody req `shouldBe` Just "{}"
it "ES9 openPointInTimeWithBody sends the body to the local ES9 endpoint" $ do
let body = defaultOpenPointInTimeBody {pitBodyIndexFilter = Just (MatchAllQuery Nothing)}
req = ES9Requests.openPointInTimeWithBody testPattern (keepAliveMinutes 1) body defaultPITOptions
bhRequestBody req `shouldBe` Just (encode body)
getRawEndpoint (bhRequestEndpoint req) `shouldBe` [unIndexName testIndex, "_pit"]
describe "closePointInTime export (ElasticSearch 8)" $
-- Regression: closePointInTime was defined and documented but absent
-- from the ES8 Client export list, making it unreachable for users
-- even though pitSearch and openPointInTime Haddocks point readers at
-- it. Every sibling backend (ES7, ES9, OS2, OS3) exports it.
-- Referencing the identifier here guards the export at compile time:
-- dropping it from the export list again breaks this module's build.
-- Instantiating at @BH IO@ satisfies both the 'MonadBH' and
-- 'WithBackend' constraints ('Backend (BH IO) = 'Dynamic' bypasses the
-- backend check); the action is built but never executed.
it "is reachable through the ES8 Client API" $
let guardExport :: BH IO ()
guardExport = void (ClientES8.closePointInTime (ClosePointInTime "never-run"))
in guardExport `seq` (True `shouldBe` True)
describe "Point in time (PIT) API (ElasticSearch 7)" $ do
it' <- runIO esOnlyIT
it' "returns a single document using the point in time (PIT) API" $
withTestEnv $ do
_ <- insertData
_ <- insertOther
let search =
( mkSearch
(Just $ MatchAllQuery Nothing)
Nothing
)
{ size = Size 1
}
regular_search <- searchTweet search
pit_search' <- pitSearch testIndex (keepAliveMinutes 1) search :: BH IO [Hit Tweet]
let pit_search = map hitSource pit_search'
liftIO $
regular_search `shouldBe` Right exampleTweet -- Check that the size restriction is being honored
liftIO $
pit_search `shouldMatchList` [Just exampleTweet]
it' "returns many documents using the point in time (PIT) API" $
withTestEnv $ do
resetIndex
let ids = [1 .. 1000]
let docs = map exampleTweetWithAge ids
let docIds = map (Text.pack . show) ids
mapM_ (uncurry insertTweetWithDocId) (docs `zip` docIds)
let sort = mkSort (FieldName "postDate") Ascending
let search =
( mkSearch
(Just $ MatchAllQuery Nothing)
Nothing
)
{ sortBody = Just [DefaultSortSpec sort]
}
scan_search' <- scanSearch testIndex search :: BH IO [Hit Tweet]
let scan_search = map hitSource scan_search'
pit_search' <- pitSearch testIndex (keepAliveMinutes 1) search :: BH IO [Hit Tweet]
let pit_search = map hitSource pit_search'
let expectedHits = map Just docs
liftIO $
scan_search `shouldMatchList` expectedHits
liftIO $
pit_search `shouldMatchList` expectedHits
describe "Point in time (PIT) API (ElasticSearch 9)" $ do
it "round-trips OpenPointInTimeResponse through ToJSON/FromJSON" $ do
let resp =
ES9Types.OpenPointInTimeResponse
"pit-id-xyz"
(ShardResult 2 2 0 0)
decode (encode resp) `shouldBe` Just resp
it "OpenPointInTimeResponse always emits _shards (Required per docs)" $ do
let resp = ES9Types.OpenPointInTimeResponse "pit-id-xyz" (ShardResult 2 2 0 0)
encode resp
`shouldBe` encode
( object
[ "id" .= ("pit-id-xyz" :: Text),
"_shards" .= object ["total" .= (2 :: Int), "successful" .= (2 :: Int), "skipped" .= (0 :: Int), "failed" .= (0 :: Int)]
]
)
it "decodes an OpenPointInTimeResponse with a _shards summary" $
decode
"{\"id\":\"pit-1\",\"_shards\":{\"total\":3,\"successful\":2,\"skipped\":1,\"failed\":0}}"
`shouldBe` Just
( ES9Types.OpenPointInTimeResponse
"pit-1"
(ShardResult 3 2 1 0)
)
it "rejects an OpenPointInTimeResponse that omits _shards (Required per docs)" $
decode "{\"id\":\"pit-1\"}"
`shouldBe` (Nothing :: Maybe ES9Types.OpenPointInTimeResponse)
it "rejects a malformed _shards value in OpenPointInTimeResponse" $
decode "{\"id\":\"pit-1\",\"_shards\":\"not-an-object\"}"
`shouldBe` (Nothing :: Maybe ES9Types.OpenPointInTimeResponse)
it "round-trips ClosePointInTime through ToJSON/FromJSON" $ do
let cpit = ES9Types.ClosePointInTime "pit-id-xyz"
decode (encode cpit) `shouldBe` Just cpit
it "round-trips ClosePointInTimeResponse through ToJSON/FromJSON" $ do
let resp = ES9Types.ClosePointInTimeResponse True 5
decode (encode resp) `shouldBe` Just resp
it' <- runIO es9OnlyIT
it' "uses the ES9 local PointInTime types (not the ES7 inherited ones)" $
withTestEnv $ do
_ <- insertData
let search =
( mkSearch
(Just $ MatchAllQuery Nothing)
Nothing
)
{ size = Size 1
}
-- This exercises the ES9 client's pitSearch which uses OpenPointInTimeResponse { oes9PitId }
-- rather than the ES7 inherited field name oPitId.
pit_search' <- ClientES9.pitSearch testIndex (keepAliveMinutes 1) search :: BH IO [Hit Tweet]
let pit_search = map hitSource pit_search'
liftIO $
pit_search `shouldMatchList` [Just exampleTweet]
xdescribe "Point in time (PIT) API (OpenSearch 2)" $ do
it' <- runIO os2OnlyIT
it' "returns a single document using the point in time (PIT) API" $
withTestEnv $ do
_ <- insertData
_ <- insertOther
let search =
( mkSearch
(Just $ MatchAllQuery Nothing)
Nothing
)
{ size = Size 1
}
regular_search <- searchTweet search
pit_search' <- ClientOS2.pitSearch testIndex (keepAliveMinutes 1) search :: BH IO [Hit Tweet]
let pit_search = map hitSource pit_search'
liftIO $
regular_search `shouldBe` Right exampleTweet -- Check that the size restriction is being honored
liftIO $
pit_search `shouldMatchList` [Just exampleTweet]
it' "returns many documents using the point in time (PIT) API" $
withTestEnv $ do
resetIndex
let ids = [1 .. 1000]
let docs = map exampleTweetWithAge ids
let docIds = map (Text.pack . show) ids
mapM_ (uncurry insertTweetWithDocId) (docs `zip` docIds)
let sort = mkSort (FieldName "postDate") Ascending
let search =
( mkSearch
(Just $ MatchAllQuery Nothing)
Nothing
)
{ sortBody = Just [DefaultSortSpec sort]
}
scan_search' <- scanSearch testIndex search :: BH IO [Hit Tweet]
let scan_search = map hitSource scan_search'
pit_search' <- ClientOS2.pitSearch testIndex (keepAliveMinutes 1) search :: BH IO [Hit Tweet]
let pit_search = map hitSource pit_search'
let expectedHits = map Just docs
liftIO $
scan_search `shouldMatchList` expectedHits
liftIO $
pit_search `shouldMatchList` expectedHits
-- | Build a 'POSIXMS' from a millisecond count, mirroring the
-- 'FromJSON' instance's truncating behaviour so the expected value in
-- the OS3 decode test matches what the parser actually yields.
posixMSFromMillis :: Integer -> POSIXMS
posixMSFromMillis n = POSIXMS (posixSecondsToUTCTime (fromInteger (n `div` 1000)))
-- | Order-insensitive comparison for @(key, value)@ query-param pairs.
-- 'withQueries' is order-insensitive, but the test-suite's @shouldBe@
-- is not; this helper sorts both sides so a stable but unspecified
-- ordering does not cause spurious failures.
sortPairs :: [(Text.Text, Maybe Text.Text)] -> [(Text.Text, Maybe Text.Text)]
sortPairs = sortOn fst