elasticsearch-interchange (empty) → 0.1.0.0
raw patch · 16 files changed
+1092/−0 lines, 16 filesdep +basedep +bytebuilddep +byteslicesetup-changed
Dependencies added: base, bytebuild, byteslice, bytestring, elasticsearch-interchange, json-query, json-syntax, pretty-show, primitive, tasty, tasty-golden, text-short, unpacked-maybe-text
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- elasticsearch-interchange.cabal +66/−0
- samples/bulk/request/001/output.json +4/−0
- samples/bulk/response/001/input.json +40/−0
- samples/cat/aliases/response/001/input.json +26/−0
- samples/cat/indices/response/001/input.json +38/−0
- samples/search/response/001/input.json +49/−0
- src/Elasticsearch/Aliases/Request.hs +60/−0
- src/Elasticsearch/Bulk/Request.hs +138/−0
- src/Elasticsearch/Bulk/Response.hs +245/−0
- src/Elasticsearch/Cat/Aliases/Response.hs +44/−0
- src/Elasticsearch/Cat/Indices/Response.hs +72/−0
- src/Elasticsearch/Search/Response.hs +146/−0
- test/Main.hs +127/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for elasticsearch-interchange++## 0.1.0.0 -- 2022-12-08++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021, Layer 3 Communications++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Layer 3 Communications nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ elasticsearch-interchange.cabal view
@@ -0,0 +1,66 @@+cabal-version: 3.0+name: elasticsearch-interchange+version: 0.1.0.0+synopsis: Serialization of Elasticsearch requests and responses+description:+ This library provides data types for communicating with elasticsearch. It+ also includes serialization and deserialization functions for these data+ types. This library does not include machinery for transport. The user is+ responsible for using an http client forming the complete requests+ (e.g. setting the Content-Type header).+bug-reports: https://github.com/layer-3-communications/elasticsearch-interchange+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: amartin@layer3com.com+copyright: 2021 Layer 3 Communications+category: Data+build-type: Simple+extra-source-files:+ CHANGELOG.md+ samples/bulk/request/001/*.json+ samples/bulk/response/001/*.json+ samples/search/response/001/*.json+ samples/cat/aliases/response/001/*.json+ samples/cat/indices/response/001/*.json++library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -O2+ exposed-modules:+ Elasticsearch.Bulk.Request+ Elasticsearch.Bulk.Response+ Elasticsearch.Search.Response+ Elasticsearch.Cat.Indices.Response+ Elasticsearch.Cat.Aliases.Response+ Elasticsearch.Aliases.Request+ build-depends:+ , base >=4.13 && <5+ , bytebuild >=0.3.7 && <0.4+ , json-query >=0.2.1 && <0.3+ , json-syntax >=0.2 && <0.3+ , primitive >=0.7.1 && <0.8+ , text-short >=0.1.3 && <0.2+ , unpacked-maybe-text >=0.1 && <0.2++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -Wall -O2+ build-depends:+ , base >=4.11.1 && <5+ , bytebuild+ , byteslice+ , bytestring+ , elasticsearch-interchange+ , json-query+ , json-syntax+ , primitive+ , tasty+ , tasty-golden+ , text-short+ , unpacked-maybe-text+ , pretty-show >=1.10
+ samples/bulk/request/001/output.json view
@@ -0,0 +1,4 @@+{"index":{"_index":"person-2018.09.28","_id":"5bc6d38e-8b30-11eb-8dcd-0242ac130003"}}+{}+{"create":{"_index":"person-2018.09.29","_id":"3cd512c8-8b31-11eb-8dcd-0242ac130003"}}+{"name":"Xavier"}
+ samples/bulk/response/001/input.json view
@@ -0,0 +1,40 @@+{+ "took": 30,+ "errors": false,+ "items": [+ {+ "index": {+ "_index": "test",+ "_type": "_doc",+ "_id": "1",+ "_version": 1,+ "result": "created",+ "_shards": {+ "total": 2,+ "successful": 1,+ "failed": 0+ },+ "status": 201,+ "_seq_no" : 0,+ "_primary_term": 1+ }+ },+ {+ "delete": {+ "_index": "test",+ "_type": "_doc",+ "_id": "2",+ "_version": 1,+ "result": "not_found",+ "_shards": {+ "total": 2,+ "successful": 1,+ "failed": 0+ },+ "status": 404,+ "_seq_no" : 1,+ "_primary_term" : 2+ }+ }+ ]+}
+ samples/cat/aliases/response/001/input.json view
@@ -0,0 +1,26 @@+[+ {+ "alias": "widgets",+ "index": "widgets-2022.09.21",+ "filter": "-",+ "routing.index": "-",+ "routing.search": "-",+ "is_write_index": "-"+ },+ {+ "alias": "widgets",+ "index": "widgets-2022.09.22",+ "filter": "-",+ "routing.index": "-",+ "routing.search": "-",+ "is_write_index": "-"+ },+ {+ "alias": "gadgets",+ "index": "gadgets-2022.09.21",+ "filter": "-",+ "routing.index": "-",+ "routing.search": "-",+ "is_write_index": "-"+ }+]
+ samples/cat/indices/response/001/input.json view
@@ -0,0 +1,38 @@+[+ {+ "health": "green",+ "status": "open",+ "index": "example-alpha",+ "uuid": "L_ObHO__R32Mn5ef_HEuFQ",+ "pri": "1",+ "rep": "1",+ "docs.count": "6728",+ "docs.deleted": "152",+ "store.size": "2254044",+ "pri.store.size": "1121907"+ },+ {+ "health": "green",+ "status": "closed",+ "index": "example-beta",+ "uuid": "KlgRurzNRRanrldo06OFog",+ "pri": "1",+ "rep": "1",+ "docs.count": "85",+ "docs.deleted": "0",+ "store.size": "286823",+ "pri.store.size": "143410"+ },+ {+ "health": "yellow",+ "status": "open",+ "index": "example-gamma",+ "uuid": "bcqcIRUPRoklp-GW_l1gYg",+ "pri": "1",+ "rep": "1",+ "docs.count": "22517",+ "docs.deleted": "6019",+ "store.size": "164020888",+ "pri.store.size": "82609812"+ }+]
+ samples/search/response/001/input.json view
@@ -0,0 +1,49 @@+++{+ "took": 5,+ "timed_out": false,+ "_shards": {+ "total": 1,+ "successful": 1,+ "skipped": 0,+ "failed": 0+ },+ "hits": {+ "total": {+ "value": 20,+ "relation": "eq"+ },+ "max_score": 1.3862942,+ "hits": [+ {+ "_index": "my-index-000001",+ "_type" : "_doc",+ "_id": "0",+ "_score": 1.3862942,+ "_source": {+ "@timestamp": "2099-11-15T14:12:12",+ "http": {+ "request": {+ "method": "get"+ },+ "response": {+ "status_code": 200,+ "bytes": 1070000+ },+ "version": "1.1"+ },+ "source": {+ "ip": "127.0.0.1"+ },+ "message": "GET /search HTTP/1.1 200 1070000",+ "user": {+ "id": "kimchy"+ }+ }+ }+ ]+ }+}++
+ src/Elasticsearch/Aliases/Request.hs view
@@ -0,0 +1,60 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language OverloadedStrings #-}+{-# language PatternSynonyms #-}++module Elasticsearch.Aliases.Request+ ( Action(..)+ , AddAttributes(..)+ , RemoveAttributes(..)+ , encode+ ) where++import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import Json (pattern (:->))++import qualified Json++-- | The action to be taken with the document.+data Action+ = Add AddAttributes+ -- ^ Add an index to an alias+ | Remove RemoveAttributes+ -- ^ Remove an index from an alias+ deriving (Show)++data AddAttributes = AddAttributes+ { alias :: !ShortText+ , index :: !ShortText+ , isWriteIndex :: !Bool+ } deriving (Show)++data RemoveAttributes = RemoveAttributes+ { alias :: !ShortText+ , index :: !ShortText+ } deriving (Show)++encode :: SmallArray Action -> Json.Value+encode !xs = Json.object1 ("actions" :-> Json.Array (fmap encodeAction xs))++encodeAction :: Action -> Json.Value+encodeAction = \case+ Add x -> encodeAdd x+ Remove x -> encodeRemove x++encodeAdd :: AddAttributes -> Json.Value+encodeAdd AddAttributes{alias,index,isWriteIndex} =+ Json.object1 $ "add" :-> Json.object3+ ("alias" :-> Json.String alias)+ ("index" :-> Json.String index)+ ("is_write_index" :-> (if isWriteIndex then Json.True else Json.False))++encodeRemove :: RemoveAttributes -> Json.Value+encodeRemove RemoveAttributes{alias,index} =+ Json.object1 $ "remove" :-> Json.object2+ ("alias" :-> Json.String alias)+ ("index" :-> Json.String index)
+ src/Elasticsearch/Bulk/Request.hs view
@@ -0,0 +1,138 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}++module Elasticsearch.Bulk.Request+ ( Operation(..)+ , Action(..)+ , encode+ , encodeSmile+ ) where++import Data.Bytes.Builder (Builder)+import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import GHC.Exts (Ptr(Ptr))++import qualified Data.Maybe.Unpacked.Text.Short as M+import qualified Data.Bytes.Builder as Builder+import qualified Json+import qualified Json.Smile++-- | A single operation in a bulk request.+data Operation = Operation+ { action :: !Action+ -- ^ The action to take. Usually 'Create' or 'Index'.+ , index :: {-# UNPACK #-} !ShortText+ -- ^ Index name, required+ , id_ :: {-# UNPACK #-} !M.MaybeShortText+ -- ^ Document ID, optional but strongly recommended.+ , document :: !Json.Value+ -- ^ Document + } deriving (Show)++-- | The action to be taken with the document.+data Action+ = Create+ -- ^ Create a new document. Fails if document with ID already exists.+ | Index+ -- ^ Create or update a document.+ | Delete+ -- ^ Delete a document. Note: Currently broken. Results in+ -- malformed request.+ | Update+ -- ^ Update a document. Fails if document with ID does not exist.+ deriving (Show)++-- | Encode returns a builder, not a JSON value, because the body of+-- an Elasticsearch bulk requests is not JSON. Technically, it is+-- <http://ndjson.org ndjson>, but since there is no common type for+-- that, this module just converts it straight to a builder.+encode :: SmallArray Operation -> Builder+encode !xs = foldMap encodeOne xs++encodeOne :: Operation -> Builder+encodeOne Operation{action,index,id_,document} =+ encodePreamble action+ <> Builder.shortTextJsonString index+ <> M.maybe mempty+ (\t -> Builder.ascii7 ',' '"' '_' 'i' 'd' '"' ':'+ <> Builder.shortTextJsonString t+ ) id_+ <> Builder.ascii3 '}' '}' '\n'+ <> Json.encode document+ <> Builder.ascii '\n'++-- When we encode the first part of the operation, we are trying to+-- build something like this:+-- {"index":{"_index":"test","_id":"1"}}+-- {"index":{"_index":"test"}+-- {"create":{"_index":"test","_id":"1"}}+-- This function encodes just the beginning part. For example:+-- {"index":{"_index":+-- {"create":{"_index":+encodePreamble :: Action -> Builder+encodePreamble x = case x of+ Create -> Builder.cstring (Ptr "{\"create\":{\"_index\":"# )+ Index -> Builder.cstring (Ptr "{\"index\":{\"_index\":"# )+ Delete -> Builder.cstring (Ptr "{\"delete\":{\"_index\":"# )+ Update -> Builder.cstring (Ptr "{\"update\":{\"_index\":"# )++-- | Encode with SMILE. This does not use backreferences.+encodeSmile :: SmallArray Operation -> Builder+{-# noinline encodeSmile #-}+encodeSmile !xs = foldMap encodeSmileOne xs++encodeSmileAction :: Action -> ShortText -> ShortText -> Builder+{-# inline encodeSmileAction #-}+encodeSmileAction x !indexName !docId =+ ( case x of+ Create ->+ -- Breakdown:+ -- [0-3]: four-byte prefix, smiley face+ -- [4]: object (0xfa)+ -- [5]: key, length 6+ -- [6-11]: "create"+ -- [12]: object (0xfa)+ -- [13]: key, length 6+ -- [14-19]: "_index"+ Builder.cstring (Ptr "\x3a\x29\x0a\x00\xfa\x85\x63\x72\x65\x61\x74\x65\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)+ Index -> + -- Nearly the same as create but with the action key different+ Builder.cstring (Ptr "\x3a\x29\x0a\x00\xfa\x84\x69\x6e\x64\x65\x78\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)+ _ -> errorWithoutStackTrace "Elasticsearch.Bulk.Request[encodeSmileAction]: write Update and Delete cases"+ )+ <>+ Json.Smile.encodeString indexName+ <>+ Builder.cstring (Ptr "\x82\x5f\x69\x64"#) -- the "_id" key+ <>+ Json.Smile.encodeString docId+ <>+ Builder.cstring (Ptr "\xfb\xfb\xff"#) -- close objects and stream separator 0xFF++encodeSmileActionWithoutDocId :: Action -> ShortText -> Builder+{-# inline encodeSmileActionWithoutDocId #-}+encodeSmileActionWithoutDocId x !indexName =+ ( case x of+ Create ->+ Builder.cstring (Ptr "\x3a\x29\x0a\x00\xfa\x85\x63\x72\x65\x61\x74\x65\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)+ Index -> + -- Nearly the same as create but with the action key different+ Builder.cstring (Ptr "\x3a\x29\x0a\x00\xfa\x84\x69\x6e\x64\x65\x78\xfa\x85\x5f\x69\x6e\x64\x65\x78"#)+ _ -> errorWithoutStackTrace "Elasticsearch.Bulk.Request[encodeSmileAction]: write Update and Delete cases"+ )+ <>+ Json.Smile.encodeString indexName+ <>+ Builder.cstring (Ptr "\xfb\xfb\xff"#) -- close objects and stream separator 0xFF++encodeSmileOne :: Operation -> Builder+encodeSmileOne Operation{action,index,id_,document} =+ M.maybe+ (encodeSmileActionWithoutDocId action index)+ (encodeSmileAction action index)+ id_+ <> Json.Smile.encode document+ <> Builder.word8 0xFF
+ src/Elasticsearch/Bulk/Response.hs view
@@ -0,0 +1,245 @@+{-# language ApplicativeDo #-}+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language OverloadedStrings #-}+{-# language UnboxedTuples #-}++-- | Response to @/_bulk@ request.+module Elasticsearch.Bulk.Response+ ( -- * Types+ Response(..)+ , Action(..)+ , Item(..)+ , ConcurrencyControl(..)+ , Error(..)+ , Details(..)+ -- * Response Parser+ , parser+ -- * Example Data+ -- $example+ ) where++import Prelude hiding (id)++import Control.Monad ((>=>))+import Data.Foldable (find)+import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import Data.Word (Word64,Word16)+import Elasticsearch.Bulk.Request (Action(Update,Create,Delete,Index))+import Json (Member(Member))+import Json.Parser (Parser,MemberParser)+import Json.Context (Context(Key))++import qualified Data.Primitive as PM+import qualified Json as J+import qualified Json.Parser as P++data Response = Response+ { took :: !Word64+ -- ^ How many milliseconds did the operation take?+ , errors :: !Bool+ -- ^ Did anything go wrong?+ , items :: !(SmallArray Item)+ -- ^ Individual responses for each operation.+ } deriving (Show)++-- | The _type field is omitted because it is always _doc in Elasticsearch 7+.+-- Some other fields are omitted because they are only present when an operation+-- succeeds.+data Item = Item+ { action :: !Action+ , index :: !ShortText+ -- ^ @_index@+ , id :: !ShortText+ -- ^ @_id@+ , status :: !Word16+ -- ^ @status@+ , details :: !Details+ -- ^ No single field dictates the details.+ } deriving (Show)++-- | An item has different fields depending on whether the operation+-- was considered to have succeeded.+data Details + = Success !ConcurrencyControl+ | Failure !Error+ deriving (Show)++data ConcurrencyControl = ConcurrencyControl+ { version :: !Word64+ -- ^ @_version@+ , sequenceNumber :: !Word64+ -- ^ @_seq_no@+ } deriving (Show)++data Error = Error+ { type_ :: !ShortText+ , reason :: !ShortText+ } deriving (Show)++-- | Decode the JSON response to a bulk request.+parser :: J.Value -> Parser Response+parser v = do+ mbrs <- P.object v+ P.members+ ( do took <- P.key "took" (P.number >=> P.word64)+ errors <- P.key "errors" P.boolean+ items <- P.key "items" (P.array >=> P.smallArray itemParser)+ pure Response{took,errors,items}+ ) mbrs++itemParser :: J.Value -> Parser Item+itemParser v = do+ mbrsTop <- P.object v+ case PM.sizeofSmallArray mbrsTop of+ 1 -> do+ let !(# Member{key=keyAction,value=valueAction} #) = PM.indexSmallArray## mbrsTop 0+ action <- case keyAction of+ "update" -> pure Update+ "create" -> pure Create+ "delete" -> pure Delete+ "index" -> pure Index+ _ -> P.fail "expected one of: update, create, delete, index"+ P.contextually (Key keyAction) $ do+ mbrsProps <- P.object valueAction+ case find (\Member{key=keyProp} -> keyProp == "error") mbrsProps of+ Nothing -> P.members -- item indicates a success+ ( do index <- P.key "_index" P.string+ id <- P.key "_id" P.string+ status <- P.key "status" (P.number >=> P.word16)+ version <- P.key "_version" (P.number >=> P.word64)+ sequenceNumber <- P.key "_seq_no" (P.number >=> P.word64)+ pure Item+ { action,index,id,status+ , details=Success ConcurrencyControl{version,sequenceNumber}+ }+ ) mbrsProps+ Just Member{value=errorValue} -> do -- item indicates a failure+ mbrsError <- P.object errorValue+ err <- P.contextually (Key "error") (P.members errorMemberParser mbrsError)+ P.members+ ( do index <- P.key "_index" P.string+ id <- P.key "_id" P.string+ status <- P.key "status" (P.number >=> P.word16)+ pure Item+ { action,index,id,status+ , details=Failure err+ }+ ) mbrsProps+ _ -> P.fail "expected object with single member"++errorMemberParser :: MemberParser Error+errorMemberParser = do+ type_ <- P.key "type" P.string+ reason <- P.key "reason" P.string+ pure Error{type_,reason}+++-- $example+--+-- Example responses from Elasticsearch documentation with additional+-- commentary. This one does not include any detailed error messages:+--+-- > {+-- > "took": 30,+-- > "errors": false,+-- > "items": [+-- > {+-- > "index": {+-- > "_index": "test",+-- > "_type": "_doc",+-- > "_id": "1",+-- > "_version": 1,+-- > "result": "created",+-- > "_shards": {+-- > "total": 2,+-- > "successful": 1,+-- > "failed": 0+-- > },+-- > "status": 201,+-- > "_seq_no" : 0,+-- > "_primary_term": 1+-- > }+-- > },+-- > {+-- > "delete": {+-- > "_index": "test",+-- > "_type": "_doc",+-- > "_id": "2",+-- > "_version": 1,+-- > "result": "not_found",+-- > "_shards": {+-- > "total": 2,+-- > "successful": 1,+-- > "failed": 0+-- > },+-- > "status": 404,+-- > "_seq_no" : 1,+-- > "_primary_term" : 2+-- > }+-- > }+-- > ]+-- > }+--+-- This one does have detailed error messages in it:+--+-- > {+-- > "took": 486,+-- > "errors": true,+-- > "items": [+-- > {+-- > "update": {+-- > "_index": "index1",+-- > "_type" : "_doc",+-- > "_id": "5",+-- > "status": 404,+-- > "error": {+-- > "type": "document_missing_exception",+-- > "reason": "[_doc][5]: document missing",+-- > "index_uuid": "aAsFqTI0Tc2W0LCWgPNrOA",+-- > "shard": "0",+-- > "index": "index1"+-- > }+-- > }+-- > },+-- > {+-- > "update": {+-- > "_index": "index1",+-- > "_type" : "_doc",+-- > "_id": "6",+-- > "status": 404,+-- > "error": {+-- > "type": "document_missing_exception",+-- > "reason": "[_doc][6]: document missing",+-- > "index_uuid": "aAsFqTI0Tc2W0LCWgPNrOA",+-- > "shard": "0",+-- > "index": "index1"+-- > }+-- > }+-- > },+-- > {+-- > "create": {+-- > "_index": "index1",+-- > "_type" : "_doc",+-- > "_id": "7",+-- > "_version": 1,+-- > "result": "created",+-- > "_shards": {+-- > "total": 2,+-- > "successful": 1,+-- > "failed": 0+-- > },+-- > "_seq_no": 0,+-- > "_primary_term": 1,+-- > "status": 201+-- > }+-- > }+-- > ]+-- > }+--+-- Even though the documentation shows an @index_uuid@ field in the+-- error details, Elasticsearch 7.10 does not always populate this field.+-- It is not terribly useful, so it is omitted from the 'Error' type.
+ src/Elasticsearch/Cat/Aliases/Response.hs view
@@ -0,0 +1,44 @@+{-# language ApplicativeDo #-}+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language OverloadedStrings #-}+{-# language UnboxedTuples #-}++-- | Response to @/_cat/aliases@ request.+module Elasticsearch.Cat.Aliases.Response+ ( Response(..)+ , Alias(..)+ -- * Response Parser+ , parser+ ) where++import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import Json.Parser (Parser)++import qualified Json as J+import qualified Json.Parser as P++newtype Response = Response+ { indices :: SmallArray Alias+ } deriving (Show)++data Alias = Alias+ { alias :: !ShortText+ , index :: !ShortText+ } deriving (Show)++parser :: J.Value -> Parser Response+parser v = fmap Response (P.array v >>= P.smallArray aliasParser)++aliasParser :: J.Value -> Parser Alias+aliasParser v = do+ mbrs <- P.object v+ P.members+ ( do alias <- P.key "alias" P.string+ index <- P.key "index" P.string+ pure Alias{alias,index}+ ) mbrs
+ src/Elasticsearch/Cat/Indices/Response.hs view
@@ -0,0 +1,72 @@+{-# language ApplicativeDo #-}+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language OverloadedStrings #-}+{-# language UnboxedTuples #-}++-- | Response to @/_cat/indices@ request. Make sure to set these query string+-- parameters: @format=json&bytes=b@.+module Elasticsearch.Cat.Indices.Response+ ( Response(..)+ , Index(..)+ , Health(..)+ , Status(..)+ -- * Response Parser+ , parser+ ) where++import Control.Monad ((>=>))+import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import Json.Parser (Parser)++import qualified Json as J+import qualified Json.Parser as P++newtype Response = Response+ { indices :: SmallArray Index+ } deriving (Show)++data Index = Index+ { health :: !Health+ -- ^ Health: green, yellow, red (@health@)+ , status :: !Status+ -- ^ Status: open or closed (@status@)+ , index :: !ShortText+ -- ^ The name of the index (@index@)+ } deriving (Show)++data Health = Green | Yellow | Red+ deriving (Show)++data Status = Open | Closed+ deriving (Show)++parser :: J.Value -> Parser Response+parser v = fmap Response (P.array v >>= P.smallArray indexParser)++indexParser :: J.Value -> Parser Index+indexParser v = do+ mbrs <- P.object v+ P.members+ ( do health <- P.key "health" (P.string >=> healthParser)+ status <- P.key "status" (P.string >=> statusParser)+ index <- P.key "index" P.string+ pure Index{health,status,index}+ ) mbrs++healthParser :: ShortText -> Parser Health+healthParser = \case+ "red" -> pure Red+ "yellow" -> pure Yellow+ "green" -> pure Green+ _ -> P.fail "expected one of: red, yellow, green"++statusParser :: ShortText -> Parser Status+statusParser = \case+ "open" -> pure Open+ "closed" -> pure Closed+ _ -> P.fail "expected one of: open, closed"
+ src/Elasticsearch/Search/Response.hs view
@@ -0,0 +1,146 @@+{-# language ApplicativeDo #-}+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language OverloadedStrings #-}+{-# language UnboxedTuples #-}++-- | Responses from Search API (@http:\/\/elasticsearch.example.com\/{index}\/_search@)+module Elasticsearch.Search.Response+ ( -- * Types+ Response(..)+ , Hits(..)+ , Hit(..)+ , Total(..)+ -- * Response Parser+ , parser+ -- * Example Data+ -- $example+ ) where++import Prelude hiding (id)++import Control.Monad ((>=>))+import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import Data.Word (Word64)+import Json.Parser (Parser,MemberParser)++import qualified Json as J+import qualified Json.Parser as P++-- | A response from a search.+--+-- One strange thing about the organization of the response is that there+-- is a @hits@ field with another @hits@ field inside of it. This is how+-- elasticsearch presents this information, and that unusual structure is+-- simply mirrored by these types.+data Response = Response+ { took :: !Word64+ -- ^ How many milliseconds did the operation take?+ , hits :: !Hits+ -- ^ A hits object+ } deriving (Show)++data Hits = Hits+ { total :: !Total+ -- ^ Information about the total number of documents that matched+ , hits :: !(SmallArray Hit)+ -- ^ Array of hits + } deriving (Show)++-- | A document that matched the search criteria+data Hit = Hit+ { index :: !ShortText+ -- ^ Index name+ , id :: !ShortText+ -- ^ Document id+ , source :: !J.Value+ -- ^ Source document+ } deriving (Show)++data Total = Total+ { value :: !Word64+ , relation :: !ShortText+ } deriving (Show)++-- | Decode the JSON response to a bulk request.+parser :: J.Value -> Parser Response+parser v = do+ mbrs <- P.object v+ P.members+ ( do took <- P.key "took" (P.number >=> P.word64)+ hits <- P.key "hits" (P.object >=> P.members hitsParser)+ pure Response{took,hits}+ ) mbrs++hitsParser :: MemberParser Hits+hitsParser = do+ total <- P.key "total" (P.object >=> P.members totalParser)+ hits <- P.key "hits"+ (P.array >=> P.smallArray (P.object >=> P.members hitParser))+ pure Hits{total,hits}++totalParser :: MemberParser Total+totalParser = do+ value <- P.key "value" (P.number >=> P.word64)+ relation <- P.key "relation" P.string+ pure Total{value,relation}++hitParser :: MemberParser Hit+hitParser = do+ index <- P.key "_index" P.string+ id <- P.key "_id" P.string+ source <- P.key "_source" pure+ pure Hit{index,id,source}++-- $example+--+-- Example response from Elasticsearch documentation:+--+-- > {+-- > "took": 5,+-- > "timed_out": false,+-- > "_shards": {+-- > "total": 1,+-- > "successful": 1,+-- > "skipped": 0,+-- > "failed": 0+-- > },+-- > "hits": {+-- > "total": {+-- > "value": 20,+-- > "relation": "eq"+-- > },+-- > "max_score": 1.3862942,+-- > "hits": [+-- > {+-- > "_index": "my-index-000001",+-- > "_type" : "_doc",+-- > "_id": "0",+-- > "_score": 1.3862942,+-- > "_source": {+-- > "@timestamp": "2099-11-15T14:12:12",+-- > "http": {+-- > "request": {+-- > "method": "get"+-- > },+-- > "response": {+-- > "status_code": 200,+-- > "bytes": 1070000+-- > },+-- > "version": "1.1"+-- > },+-- > "source": {+-- > "ip": "127.0.0.1"+-- > },+-- > "message": "GET /search HTTP/1.1 200 1070000",+-- > "user": {+-- > "id": "kimchy"+-- > }+-- > }+-- > }+-- > ]+-- > }+-- > }
+ test/Main.hs view
@@ -0,0 +1,127 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language MultiWayIf #-}+{-# language NumDecimals #-}+{-# language OverloadedStrings #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language PatternSynonyms #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++import Test.Tasty (defaultMain,testGroup,TestTree)+import Test.Tasty.Golden (goldenVsString)+import Elasticsearch.Bulk.Request (Operation(Operation),Action(Index,Create))+import Text.Show.Pretty (ppShow)+import Json (pattern (:->))++import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Chunks as Chunks+import qualified Data.Bytes.Builder as Builder+import qualified Data.List as List+import qualified Data.Maybe.Unpacked.Text.Short as M+import qualified GHC.Exts as Exts+import qualified Elasticsearch.Bulk.Request as Bulk.Request+import qualified Elasticsearch.Bulk.Response as Bulk.Response+import qualified Elasticsearch.Search.Response as Search.Response+import qualified Elasticsearch.Cat.Indices.Response as Cat.Indices.Response+import qualified Elasticsearch.Cat.Aliases.Response as Cat.Aliases.Response+import qualified Elasticsearch.Aliases.Request as Aliases.Request+import qualified Json+import qualified Json.Errors as Errors+import qualified Json.Parser as Parser+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Char8 as LBC8+import qualified Data.Text.Short as TS++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Elasticsearch"+ [ testGroup "Search"+ [ testGroup "Response"+ [ goldenVsString "001" "samples/search/response/001/output.txt" $ do+ prepare "samples/search/response/001/input.json" Search.Response.parser+ ]+ ]+ , testGroup "CatAliases"+ [ testGroup "Response"+ [ goldenVsString "001" "samples/cat/aliases/response/001/output.txt" $ do+ prepare "samples/cat/aliases/response/001/input.json" Cat.Aliases.Response.parser+ ]+ ]+ , testGroup "CatIndices"+ [ testGroup "Response"+ [ goldenVsString "001" "samples/cat/indices/response/001/output.txt" $ do+ prepare "samples/cat/indices/response/001/input.json" Cat.Indices.Response.parser+ ]+ ]+ , testGroup "Aliases"+ [ testGroup "Request"+ [ goldenVsString "001" "samples/aliases/request/001/output.json"+ $ pure+ $ LBS.fromStrict+ $ Chunks.concatByteString+ $ Builder.run 64+ $ Json.encode+ $ Aliases.Request.encode+ $ Exts.fromList+ [ Aliases.Request.Add Aliases.Request.AddAttributes+ { alias = "person-2018"+ , index = "person-2018.09.28"+ , isWriteIndex = False+ }+ , Aliases.Request.Remove Aliases.Request.RemoveAttributes+ { alias = "person-2018"+ , index = "person-2018.09.27"+ }+ ]+ ]+ ]+ , testGroup "Bulk"+ [ testGroup "Request"+ [ goldenVsString "001" "samples/bulk/request/001/output.json"+ $ pure+ $ LBS.fromStrict+ $ Chunks.concatByteString+ $ Builder.run 64+ $ Bulk.Request.encode+ $ Exts.fromList+ [ Operation+ { action = Index+ , index = "person-2018.09.28"+ , id_ = M.just "5bc6d38e-8b30-11eb-8dcd-0242ac130003"+ , document = Json.emptyObject+ }+ , Operation+ { action = Create+ , index = "person-2018.09.29"+ , id_ = M.just "3cd512c8-8b31-11eb-8dcd-0242ac130003"+ , document = Json.Object+ (Exts.fromList ["name" :-> Json.String "Xavier"])+ }+ ]+ ]+ , testGroup "Response"+ [ goldenVsString "001" "samples/bulk/response/001/output.txt" $ do+ prepare "samples/bulk/response/001/input.json" Bulk.Response.parser+ ]+ ]+ ]++prepare :: Show a+ => String -- path to json+ -> (Json.Value -> Parser.Parser a)+ -> IO LBC8.ByteString+prepare path parse = do+ c <- Bytes.readFile path+ case Json.decode c of+ Left _ -> fail "input file was not JSON"+ Right v -> do+ case Parser.run (parse v) of+ Left errs -> fail ("parse error at: " ++ TS.unpack (Errors.encode errs))+ Right response -> do+ let raw = ppShow response+ let clean = if List.isSuffixOf "\n" raw then raw else raw ++ "\n"+ pure (LBC8.pack clean)