bloodhound-1.0.0.0: tests/Test/IngestGeoIpSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.IngestGeoIpSpec (spec) where
import Data.Aeson
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Scientific (Scientific)
import Database.Bloodhound.ElasticSearch9.Requests qualified as RequestsES9
import Database.Bloodhound.ElasticSearch9.Types qualified as Types
import TestsUtils.Import
hasKey :: Key -> LBS.ByteString -> Bool
hasKey k bs = case decode bs of
Just (Object obj) -> k `KM.member` obj
_ -> False
spec :: Spec
spec =
describe "Ingest GeoIP / IP-location database APIs (/_ingest/geoip/*, /_ingest/ip_location/*)" $ do
describe "GeoIpDatabaseId JSON" $ do
it "round-trips an id" $ do
let i = Types.GeoIpDatabaseId "my-geoip-db"
decode (encode i) `shouldBe` Just i
it "unGeoIpDatabaseId extracts the underlying Text" $
Types.unGeoIpDatabaseId (Types.GeoIpDatabaseId "x")
`shouldBe` ("x" :: Text)
describe "GeoIpMaxmindConfig JSON" $ do
it "encodes as {account_id: ...}" $
encode (Types.GeoIpMaxmindConfig "my-key")
`shouldBe` "{\"account_id\":\"my-key\"}"
it "round-trips" $ do
let c = Types.GeoIpMaxmindConfig "k"
decode (encode c) `shouldBe` Just c
describe "GeoIpDatabasePutBody JSON" $ do
it "always encodes name and maxmind (required for GeoIP)" $ do
let body =
Types.GeoIpDatabasePutBody
{ Types.gipbName = "GeoLite2-City.mmdb",
Types.gipbMaxmind = Types.GeoIpMaxmindConfig "acct"
}
hasKey "maxmind" (encode body) `shouldBe` True
hasKey "ipinfo" (encode body) `shouldBe` False
decode (encode body) `shouldBe` Just body
it "round-trips a fully-populated body" $ do
let body =
Types.GeoIpDatabasePutBody
{ Types.gipbName = "db",
Types.gipbMaxmind = Types.GeoIpMaxmindConfig "k"
}
decode (encode body) `shouldBe` Just body
it "decodes a documented body verbatim" $ do
let raw =
LBS.pack
"{\"name\":\"GeoLite2-City.mmdb\",\"maxmind\":{\"account_id\":\"acct\"}}"
case decode raw :: Maybe Types.GeoIpDatabasePutBody of
Just b -> do
Types.gipbName b `shouldBe` ("GeoLite2-City.mmdb" :: Text)
Types.gipbMaxmind b
`shouldBe` Types.GeoIpMaxmindConfig "acct"
Nothing -> expectationFailure "failed to decode GeoIpDatabasePutBody"
it "rejects a body missing the required maxmind field" $
decode (LBS.pack "{\"name\":\"GeoLite2-City.mmdb\"}")
`shouldBe` (Nothing :: Maybe Types.GeoIpDatabasePutBody)
describe "IpLocationDatabasePutBody JSON" $ do
it "encodes a maxmind-only body, omitting ipinfo" $ do
let body =
Types.IpLocationDatabasePutBody
{ Types.ilpbName = "GeoLite2-City.mmdb",
Types.ilpbMaxmind = Just (Types.GeoIpMaxmindConfig "acct"),
Types.ilpbIpInfo = Nothing
}
hasKey "ipinfo" (encode body) `shouldBe` False
hasKey "maxmind" (encode body) `shouldBe` True
decode (encode body) `shouldBe` Just body
it "encodes an ipinfo-only body, omitting maxmind" $ do
let body =
Types.IpLocationDatabasePutBody
{ Types.ilpbName = "ipinfo-db",
Types.ilpbMaxmind = Nothing,
Types.ilpbIpInfo = Just (object ["token" .= ("t" :: Text)])
}
hasKey "maxmind" (encode body) `shouldBe` False
hasKey "ipinfo" (encode body) `shouldBe` True
decode (encode body) `shouldBe` Just body
it "omits both providers when Nothing" $ do
let body =
Types.IpLocationDatabasePutBody
{ Types.ilpbName = "db",
Types.ilpbMaxmind = Nothing,
Types.ilpbIpInfo = Nothing
}
hasKey "maxmind" (encode body) `shouldBe` False
hasKey "ipinfo" (encode body) `shouldBe` False
decode (encode body) `shouldBe` Just body
it "encodes both providers when both are set (caller's responsibility)" $ do
let body =
Types.IpLocationDatabasePutBody
{ Types.ilpbName = "db",
Types.ilpbMaxmind = Just (Types.GeoIpMaxmindConfig "acct"),
Types.ilpbIpInfo = Just (object ["token" .= ("t" :: Text)])
}
hasKey "maxmind" (encode body) `shouldBe` True
hasKey "ipinfo" (encode body) `shouldBe` True
decode (encode body) `shouldBe` Just body
it "decodes an ipinfo-only body" $ do
let raw =
LBS.pack
"{\"name\":\"ipinfo-db\",\"ipinfo\":{\"token\":\"t\"}}"
case decode raw :: Maybe Types.IpLocationDatabasePutBody of
Just b -> do
Types.ilpbName b `shouldBe` ("ipinfo-db" :: Text)
Types.ilpbMaxmind b `shouldBe` Nothing
Nothing -> expectationFailure "failed to decode ipinfo-only body"
it "decodes a full body" $ do
let raw =
LBS.pack
"{\"name\":\"GeoLite2-City.mmdb\",\"maxmind\":{\"account_id\":\"acct\"}}"
case decode raw :: Maybe Types.IpLocationDatabasePutBody of
Just b -> do
Types.ilpbName b `shouldBe` ("GeoLite2-City.mmdb" :: Text)
Types.ilpbMaxmind b
`shouldBe` Just (Types.GeoIpMaxmindConfig "acct")
Nothing -> expectationFailure "failed to decode IpLocationDatabasePutBody"
describe "GeoIpDatabaseInfo JSON" $ do
it "decodes a documented GET entry verbatim" $ do
let raw =
LBS.pack
"{\"id\":\"my-geoip-db\",\"version\":42,\"modified_date_millis\":1700000000000,\"database\":{\"name\":\"GeoLite2-City.mmdb\"}}"
case decode raw :: Maybe Types.GeoIpDatabaseInfo of
Just info -> do
Types.gidiId info `shouldBe` "my-geoip-db"
Types.gidiVersion info `shouldBe` (42 :: Scientific)
Types.gidiModifiedDateMillis info
`shouldBe` (1700000000000 :: Scientific)
Nothing -> expectationFailure "failed to decode GeoIpDatabaseInfo"
it "round-trips a fully-populated entry" $ do
let info =
Types.GeoIpDatabaseInfo
{ Types.gidiId = "my-geoip-db",
Types.gidiVersion = 42,
Types.gidiModifiedDateMillis = 1700000000000,
Types.gidiDatabase = object ["name" .= ("GeoLite2-City.mmdb" :: Text)]
}
decode (encode info) `shouldBe` Just info
it "rejects an entry missing a required field" $
decode (LBS.pack "{\"id\":\"only-id\"}")
`shouldBe` (Nothing :: Maybe Types.GeoIpDatabaseInfo)
describe "GeoIpDatabasesResponse JSON" $ do
it "decodes a databases array of fully-populated entries" $ do
let raw =
LBS.pack
"{\"databases\":[{\"id\":\"a\",\"version\":1,\"modified_date_millis\":1700000000000,\"database\":{}},{\"id\":\"b\",\"version\":2,\"modified_date_millis\":1700000000001,\"database\":{}}]}"
case decode raw :: Maybe Types.GeoIpDatabasesResponse of
Just resp -> length (Types.gdrDatabases resp) `shouldBe` 2
Nothing -> expectationFailure "failed to decode GeoIpDatabasesResponse"
it "defaults a missing databases key to []" $
case decode (LBS.pack "{}") :: Maybe Types.GeoIpDatabasesResponse of
Just resp -> length (Types.gdrDatabases resp) `shouldBe` 0
Nothing -> expectationFailure "failed to decode empty GeoIpDatabasesResponse"
describe "GeoIpStats JSON" $ do
it "decodes a stats object verbatim" $ do
let raw =
LBS.pack
"{\"successful_downloads\":3,\"failed_downloads\":1,\"total_download_time\":4591,\"databases_count\":2,\"skipped_updates\":0,\"expired_databases\":0}"
case decode raw :: Maybe Types.GeoIpStats of
Just s -> do
Types.gisSuccessfulDownloads s
`shouldBe` (3 :: Scientific)
Types.gisDatabasesCount s
`shouldBe` (2 :: Scientific)
Nothing -> expectationFailure "failed to decode GeoIpStats"
it "round-trips a fully-populated stats object" $ do
let s =
Types.GeoIpStats
{ Types.gisSuccessfulDownloads = 3,
Types.gisFailedDownloads = 1,
Types.gisTotalDownloadTime = 4591,
Types.gisDatabasesCount = 2,
Types.gisSkippedUpdates = 0,
Types.gisExpiredDatabases = 0
}
decode (encode s) `shouldBe` Just s
it "rejects an object missing a required field" $
decode (LBS.pack "{}")
`shouldBe` (Nothing :: Maybe Types.GeoIpStats)
describe "GeoIpNodeStats JSON" $ do
it "decodes per-node databases and files_in_temp" $ do
let raw =
LBS.pack
"{\"databases\":[{\"name\":\"GeoLite2-City.mmdb\"}],\"files_in_temp\":[\"tmp1\"]}"
case decode raw :: Maybe Types.GeoIpNodeStats of
Just ns -> do
length (Types.ginsDatabases ns) `shouldBe` 1
Types.ginsFilesInTemp ns `shouldBe` ["tmp1"]
Nothing -> expectationFailure "failed to decode GeoIpNodeStats"
describe "GeoIpStatsResponse JSON" $ do
it "decodes the documented stats+nodes shape" $ do
let raw =
LBS.pack
"{\"stats\":{\"successful_downloads\":1,\"failed_downloads\":0,\"total_download_time\":10,\"databases_count\":1,\"skipped_updates\":0,\"expired_databases\":0},\"nodes\":{\"node-1\":{\"databases\":[{\"name\":\"GeoLite2-City.mmdb\"}],\"files_in_temp\":[]}}}"
case decode raw :: Maybe Types.GeoIpStatsResponse of
Just resp -> do
Types.gisSuccessfulDownloads (Types.gisrStats resp)
`shouldBe` (1 :: Scientific)
length (Types.gisrNodes resp) `shouldBe` 1
Nothing -> expectationFailure "failed to decode GeoIpStatsResponse"
it "rejects a response missing stats" $
decode (LBS.pack "{\"nodes\":{}}")
`shouldBe` (Nothing :: Maybe Types.GeoIpStatsResponse)
it "rejects a response missing nodes" $
decode
( LBS.pack
"{\"stats\":{\"successful_downloads\":1,\"failed_downloads\":0,\"total_download_time\":10,\"databases_count\":1,\"skipped_updates\":0,\"expired_databases\":0}}"
)
`shouldBe` (Nothing :: Maybe Types.GeoIpStatsResponse)
describe "endpoint shape" $ do
it "GETs /_ingest/geoip/stats with no body" $ do
let req = RequestsES9.getGeoIpStats
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "geoip", "stats"]
bhRequestBody req `shouldSatisfy` isNothing
it "GETs /_ingest/geoip/database (all) with no body" $ do
let req = RequestsES9.getGeoIpDatabases
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "geoip", "database"]
it "GETs /_ingest/geoip/database/<id>" $ do
let req = RequestsES9.getGeoIpDatabase "mydb"
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "geoip", "database", "mydb"]
it "PUTs /_ingest/geoip/database/<id> with a body" $ do
let body =
Types.GeoIpDatabasePutBody
{ Types.gipbName = "GeoLite2-City.mmdb",
Types.gipbMaxmind = Types.GeoIpMaxmindConfig "acct"
}
req = RequestsES9.putGeoIpDatabase "mydb" body
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "geoip", "database", "mydb"]
bhRequestBody req `shouldSatisfy` isJust
it "DELETEs /_ingest/geoip/database/<id>" $ do
let req = RequestsES9.deleteGeoIpDatabase "*"
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "geoip", "database", "*"]
bhRequestBody req `shouldSatisfy` isNothing
it "GETs /_ingest/ip_location/database/<id>" $ do
let req = RequestsES9.getIpLocationDatabase "ipdb"
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "ip_location", "database", "ipdb"]
it "GETs /_ingest/ip_location/database (all) with no body" $ do
let req = RequestsES9.getIpLocationDatabases
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "ip_location", "database"]
bhRequestBody req `shouldSatisfy` isNothing
it "PUTs /_ingest/ip_location/database/<id> with a body" $ do
let body =
Types.IpLocationDatabasePutBody
{ Types.ilpbName = "ipinfo-db",
Types.ilpbMaxmind = Nothing,
Types.ilpbIpInfo = Just (object ["token" .= ("t" :: Text)])
}
req = RequestsES9.putIpLocationDatabase "ipdb" body
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "ip_location", "database", "ipdb"]
bhRequestBody req `shouldSatisfy` isJust
it "DELETEs /_ingest/ip_location/database/<id>" $ do
let req = RequestsES9.deleteIpLocationDatabase "ipdb"
getRawEndpoint (bhRequestEndpoint req)
`shouldBe` ["_ingest", "ip_location", "database", "ipdb"]