bloodhound-1.0.0.0: tests/Test/FlowFrameworkSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.FlowFrameworkSpec (spec) where
import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List (isInfixOf)
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Database.Bloodhound.OpenSearch3.Types
import TestsUtils.Import
import Prelude
-- ---------------------------------------------------------------------------
-- Sample bodies, drawn verbatim from the OS Flow Framework plugin docs
-- (<https://docs.opensearch.org/latest/automating-configurations/api/create-workflow/>).
-- ---------------------------------------------------------------------------
-- | A bare-bones fire-and-forget create / provision response — just the
-- server-assigned @workflow_id@. This is the shape returned when no
-- @wait_for_completion_timeout@ is supplied.
sampleWorkflowIdResponseJson :: LBS.ByteString
sampleWorkflowIdResponseJson = "{\"workflow_id\":\"8xL8bowB8y25Tqfenm50\"}"
-- | The richer timed create / provision response, carrying the
-- terminal @state@ and the list of @resources_created@ entries. Drawn
-- verbatim from the create-workflow docs page.
sampleTimedResponseJson :: LBS.ByteString
sampleTimedResponseJson =
"{\
\ \"workflow_id\": \"K13IR5QBEpCfUu_-AQdU\",\
\ \"state\": \"COMPLETED\",\
\ \"resources_created\": [\
\ {\"workflow_step_name\": \"create_connector\",\
\ \"workflow_step_id\": \"create_connector_1\",\
\ \"resource_id\": \"LF3IR5QBEpCfUu_-Awd_\",\
\ \"resource_type\": \"connector_id\"},\
\ {\"workflow_step_id\": \"register_model_2\",\
\ \"workflow_step_name\": \"register_remote_model\",\
\ \"resource_id\": \"L13IR5QBEpCfUu_-BQdI\",\
\ \"resource_type\": \"model_id\"},\
\ {\"workflow_step_name\": \"deploy_model\",\
\ \"workflow_step_id\": \"deploy_model_3\",\
\ \"resource_id\": \"L13IR5QBEpCfUu_-BQdI\",\
\ \"resource_type\": \"model_id\"}\
\ ]\
\}"
-- | The canonical \"Register and deploy a remote model\" template body —
-- exercises the three CORE step types chained via @previous_node_inputs@.
sampleRemoteModelTemplateJson :: LBS.ByteString
sampleRemoteModelTemplateJson =
"{\
\ \"name\": \"createconnector-registerremotemodel-deploymodel\",\
\ \"description\": \"An example of registering a remote model\",\
\ \"use_case\": \"REMOTE_MODEL_DEPLOYMENT\",\
\ \"version\": {\"template\": \"1.0.0\", \"compatibility\": [\"2.12.0\", \"3.0.0\"]},\
\ \"workflows\": {\
\ \"provision\": {\
\ \"nodes\": [\
\ {\"id\": \"create_connector_1\",\
\ \"type\": \"create_connector\",\
\ \"user_inputs\": {\
\ \"name\": \"OpenAI Chat Connector\",\
\ \"description\": \"Connector to public OpenAI service\",\
\ \"version\": \"1\",\
\ \"protocol\": \"http\",\
\ \"parameters\": {\"endpoint\": \"https://api.openai.com/v1/chat/completions\", \"model\": \"gpt-3.5-turbo\"},\
\ \"credential\": {\"openAI_key\": \"12345\"},\
\ \"actions\": [{\"action_type\": \"predict\", \"method\": \"POST\", \"url\": \"https://api.openai.com/v1/chat/completions\"}]\
\ }\
\ },\
\ {\"id\": \"register_model_2\",\
\ \"type\": \"register_remote_model\",\
\ \"previous_node_inputs\": {\"create_connector_1\": \"connector_id\"},\
\ \"user_inputs\": {\"name\": \"remote-inference-model\", \"function_name\": \"remote\"}\
\ },\
\ {\"id\": \"deploy_model_3\",\
\ \"type\": \"deploy_model\",\
\ \"previous_node_inputs\": {\"register_model_2\": \"model_id\"}\
\ }\
\ ]\
\ }\
\ }\
\}"
spec :: Spec
spec = describe "Flow Framework plugin" $ do
-- =======================================================================
-- WorkflowId newtype
-- =======================================================================
describe "WorkflowId JSON" $ do
it "round-trips as a bare JSON string" $ do
let wid = WorkflowId "8xL8bowB8y25Tqfenm50"
(decode . encode) wid `shouldBe` Just wid
it "encodes as a bare string, not an object" $
encode (WorkflowId "abc") `shouldBe` "\"abc\""
-- =======================================================================
-- WorkflowState enum
-- =======================================================================
describe "WorkflowState JSON" $ do
let cases =
[ (WorkflowStateNotStarted, "NOT_STARTED"),
(WorkflowStateProvisioning, "PROVISIONING"),
(WorkflowStateCompleted, "COMPLETED"),
(WorkflowStateFailed, "FAILED")
]
forM_ cases $ \(s, wire) -> do
it ("encodes " <> show wire <> " to the documented wire string") $
encode s `shouldBe` "\"" <> LBS.fromStrict wire <> "\""
it ("decodes the documented wire string " <> show wire) $
decode ("\"" <> LBS.fromStrict wire <> "\"" :: LBS.ByteString)
`shouldBe` Just s
it "decodes an unknown state into WorkflowStateOther (forward-compat)" $
decode "\"QUEUED\"" `shouldBe` Just (WorkflowStateOther "QUEUED")
it "round-trips an unknown state through Other" $ do
let s = WorkflowStateOther "WEIRD"
(decode . encode) s `shouldBe` Just s
it "rejects a non-string state" $
decode "42" `shouldBe` (Nothing :: Maybe WorkflowState)
it "round-trips through ToJSON/FromJSON" $
property $
\s -> (decode . encode) s === (Just s :: Maybe WorkflowState)
-- =======================================================================
-- ValidationMode enum
-- =======================================================================
describe "ValidationMode JSON" $ do
let cases =
[ (ValidationAll, "all"),
(ValidationNone, "none")
]
forM_ cases $ \(v, wire) -> do
it ("encodes " <> show wire) $
encode v `shouldBe` "\"" <> LBS.fromStrict wire <> "\""
it ("decodes " <> show wire) $
decode ("\"" <> LBS.fromStrict wire <> "\"" :: LBS.ByteString) `shouldBe` Just v
it "rejects an unknown value" $
decode "\"strict\"" `shouldBe` (Nothing :: Maybe ValidationMode)
-- =======================================================================
-- WorkflowVersion
-- =======================================================================
describe "WorkflowVersion JSON" $ do
it "round-trips a fully-populated version" $ do
let v = WorkflowVersion (Just "1.0.0") (Just ["2.12.0", "3.0.0"])
(decode . encode) v `shouldBe` Just v
it "round-trips an empty version" $ do
let v = WorkflowVersion Nothing Nothing
(decode . encode) v `shouldBe` Just v
it "renders as {} when fully Nothing" $
encode (WorkflowVersion Nothing Nothing) `shouldBe` "{}"
-- =======================================================================
-- DeployModelUserInputs (minimal CORE variant)
-- =======================================================================
describe "DeployModelUserInputs JSON" $ do
it "round-trips when model_id is set" $ do
let x = DeployModelUserInputs (Just "abc-123")
(decode . encode) x `shouldBe` Just x
it "round-trips when model_id is omitted (injected via previous_node_inputs)" $ do
let x = DeployModelUserInputs Nothing
(decode . encode) x `shouldBe` Just x
it "decodes {} to model_id=Nothing (matches deploy-with-injection shape)" $
decode "{}" `shouldBe` Just (DeployModelUserInputs Nothing)
it "encodes {} when model_id is Nothing" $
encode (DeployModelUserInputs Nothing) `shouldBe` "{}"
-- =======================================================================
-- CreateIndexUserInputs / CreateIngestPipelineUserInputs
-- =======================================================================
describe "CreateIndexUserInputs JSON" $ do
it "round-trips the two-field shape" $ do
let x = CreateIndexUserInputs "my-index" "{\"mappings\":{}}"
(decode . encode) x `shouldBe` Just x
it "encodes both fields" $ do
let lbs = encode (CreateIndexUserInputs "idx" "{}")
LBS.unpack lbs `shouldSatisfy` isInfixOf "\"index_name\":\"idx\""
LBS.unpack lbs `shouldSatisfy` isInfixOf "\"configurations\":\"{}\""
describe "CreateIngestPipelineUserInputs JSON" $ do
it "round-trips the two-field shape" $ do
let x = CreateIngestPipelineUserInputs "my-pipeline" "{\"processors\":[]}"
(decode . encode) x `shouldBe` Just x
it "encodes both fields" $ do
let lbs = encode (CreateIngestPipelineUserInputs "pip" "{}")
LBS.unpack lbs `shouldSatisfy` isInfixOf "\"pipeline_id\":\"pip\""
LBS.unpack lbs `shouldSatisfy` isInfixOf "\"configurations\":\"{}\""
-- =======================================================================
-- WorkflowConnectorAction (sub-record of CreateConnectorUserInputs)
-- =======================================================================
describe "WorkflowConnectorAction JSON" $ do
it "round-trips a minimal action (required fields only)" $ do
let a =
WorkflowConnectorAction
{ workflowConnectorActionType = "predict",
workflowConnectorActionMethod = "POST",
workflowConnectorActionUrl = "https://api.example.com",
workflowConnectorActionHeaders = Nothing,
workflowConnectorActionRequestBody = Nothing,
workflowConnectorActionPreProcessFunction = Nothing,
workflowConnectorActionPostProcessFunction = Nothing
}
(decode . encode) a `shouldBe` Just a
it "round-trips a fully-populated action" $ do
let a =
WorkflowConnectorAction
{ workflowConnectorActionType = "predict",
workflowConnectorActionMethod = "POST",
workflowConnectorActionUrl = "https://api.example.com",
workflowConnectorActionHeaders = Just Map.empty,
workflowConnectorActionRequestBody = Just (object ["foo" .= (1 :: Int)]),
workflowConnectorActionPreProcessFunction = Just "return params;",
workflowConnectorActionPostProcessFunction = Just "return params;"
}
(decode . encode) a `shouldBe` Just a
it "omits optional fields when Nothing" $
encode
( WorkflowConnectorAction
{ workflowConnectorActionType = "predict",
workflowConnectorActionMethod = "POST",
workflowConnectorActionUrl = "https://x",
workflowConnectorActionHeaders = Nothing,
workflowConnectorActionRequestBody = Nothing,
workflowConnectorActionPreProcessFunction = Nothing,
workflowConnectorActionPostProcessFunction = Nothing
}
)
`shouldBe` "{\"action_type\":\"predict\",\"method\":\"POST\",\"url\":\"https://x\"}"
-- =======================================================================
-- CreateConnectorUserInputs (richest CORE variant)
-- =======================================================================
describe "CreateConnectorUserInputs JSON" $ do
let sampleInputs =
CreateConnectorUserInputs
{ createConnectorUserInputsName = "OpenAI Chat Connector",
createConnectorUserInputsDescription = "Connector to public OpenAI service",
createConnectorUserInputsVersion = "1",
createConnectorUserInputsProtocol = "http",
createConnectorUserInputsParameters = Map.fromList [("endpoint", "https://api.openai.com/v1"), ("model", "gpt-3.5-turbo")],
createConnectorUserInputsCredential = Map.fromList [("openAI_key", "12345")],
createConnectorUserInputsActions =
[ WorkflowConnectorAction
{ workflowConnectorActionType = "predict",
workflowConnectorActionMethod = "POST",
workflowConnectorActionUrl = "https://api.openai.com/v1/chat/completions",
workflowConnectorActionHeaders = Nothing,
workflowConnectorActionRequestBody = Nothing,
workflowConnectorActionPreProcessFunction = Nothing,
workflowConnectorActionPostProcessFunction = Nothing
}
],
createConnectorUserInputsBackendRoles = Nothing,
createConnectorUserInputsAddAllBackendRoles = Nothing,
createConnectorUserInputsAccessMode = Nothing,
createConnectorUserInputsClientConfig = Nothing,
createConnectorUserInputsUrl = Nothing,
createConnectorUserInputsHeaders = Nothing
}
it "round-trips the documented sample" $
(decode . encode) sampleInputs `shouldBe` Just sampleInputs
it "requires the seven mandatory fields" $ do
-- Missing name -> parse fails
decode "{\"description\":\"x\",\"version\":\"1\",\"protocol\":\"http\",\"parameters\":{},\"credential\":{},\"actions\":[]}"
`shouldBe` (Nothing :: Maybe CreateConnectorUserInputs)
it "omits all optional fields when Nothing" $ do
let encoded = encode sampleInputs
-- No optional keys should appear
LBS.unpack encoded
`shouldNotSatisfy` isInfixOf "backend_roles"
LBS.unpack encoded
`shouldNotSatisfy` isInfixOf "access_mode"
-- =======================================================================
-- RegisterRemoteModelUserInputs (CORE variant with required + optional)
-- =======================================================================
describe "RegisterRemoteModelUserInputs JSON" $ do
it "round-trips the documented remote-inference-model sample" $ do
let x =
RegisterRemoteModelUserInputs
{ registerRemoteModelUserInputsName = "remote-inference-model",
registerRemoteModelUserInputsConnectorId = Nothing,
registerRemoteModelUserInputsFunctionName = Just "remote",
registerRemoteModelUserInputsModelGroupId = Nothing,
registerRemoteModelUserInputsDescription = Nothing,
registerRemoteModelUserInputsDeploy = Nothing,
registerRemoteModelUserInputsGuardrails = Nothing,
registerRemoteModelUserInputsInterface = Nothing,
registerRemoteModelUserInputsIsEnabled = Nothing,
registerRemoteModelUserInputsRateLimiter = Nothing,
registerRemoteModelUserInputsDeploySetting = Nothing,
registerRemoteModelUserInputsBackendRoles = Nothing,
registerRemoteModelUserInputsAddAllBackendRoles = Nothing,
registerRemoteModelUserInputsAccessMode = Nothing,
registerRemoteModelUserInputsModelNodeIds = Nothing
}
(decode . encode) x `shouldBe` Just x
it "requires name" $
decode "{\"connector_id\":\"x\"}" `shouldBe` (Nothing :: Maybe RegisterRemoteModelUserInputs)
it "decodes the doc-sample shape (name + function_name, no connector_id)" $ do
-- The canonical "remote-inference-model" doc sample uses
-- previous_node_inputs to inject connector_id, so user_inputs
-- carries only name and function_name. Decode must succeed.
let lbs = "{\"name\":\"x\",\"function_name\":\"remote\"}" :: LBS.ByteString
decode lbs
`shouldBe` Just
( RegisterRemoteModelUserInputs
{ registerRemoteModelUserInputsName = "x",
registerRemoteModelUserInputsConnectorId = Nothing,
registerRemoteModelUserInputsFunctionName = Just "remote",
registerRemoteModelUserInputsModelGroupId = Nothing,
registerRemoteModelUserInputsDescription = Nothing,
registerRemoteModelUserInputsDeploy = Nothing,
registerRemoteModelUserInputsGuardrails = Nothing,
registerRemoteModelUserInputsInterface = Nothing,
registerRemoteModelUserInputsIsEnabled = Nothing,
registerRemoteModelUserInputsRateLimiter = Nothing,
registerRemoteModelUserInputsDeploySetting = Nothing,
registerRemoteModelUserInputsBackendRoles = Nothing,
registerRemoteModelUserInputsAddAllBackendRoles = Nothing,
registerRemoteModelUserInputsAccessMode = Nothing,
registerRemoteModelUserInputsModelNodeIds = Nothing
}
)
-- =======================================================================
-- NodeInputs open sum type
-- =======================================================================
describe "NodeInputs type tag" $ do
-- Verify each typed variant reports its wire tag correctly.
it "nodeInputsType for DeployModelInputs is \"deploy_model\"" $
nodeInputsType (DeployModelInputs (DeployModelUserInputs (Just "x")))
`shouldBe` "deploy_model"
it "nodeInputsType for CreateConnectorInputs is \"create_connector\"" $
nodeInputsType (CreateConnectorInputs (error "unused" :: CreateConnectorUserInputs))
`shouldBe` "create_connector"
it "nodeInputsType for RegisterRemoteModelInputs is \"register_remote_model\"" $
nodeInputsType
( RegisterRemoteModelInputs
( RegisterRemoteModelUserInputs
{ registerRemoteModelUserInputsName = "x",
registerRemoteModelUserInputsConnectorId = Nothing,
registerRemoteModelUserInputsFunctionName = Nothing,
registerRemoteModelUserInputsModelGroupId = Nothing,
registerRemoteModelUserInputsDescription = Nothing,
registerRemoteModelUserInputsDeploy = Nothing,
registerRemoteModelUserInputsGuardrails = Nothing,
registerRemoteModelUserInputsInterface = Nothing,
registerRemoteModelUserInputsIsEnabled = Nothing,
registerRemoteModelUserInputsRateLimiter = Nothing,
registerRemoteModelUserInputsDeploySetting = Nothing,
registerRemoteModelUserInputsBackendRoles = Nothing,
registerRemoteModelUserInputsAddAllBackendRoles = Nothing,
registerRemoteModelUserInputsAccessMode = Nothing,
registerRemoteModelUserInputsModelNodeIds = Nothing
}
)
)
`shouldBe` "register_remote_model"
it "nodeInputsType for CreateIndexInputs is \"create_index\"" $
nodeInputsType (CreateIndexInputs (CreateIndexUserInputs "i" "{}"))
`shouldBe` "create_index"
it "nodeInputsType for CreateIngestPipelineInputs is \"create_ingest_pipeline\"" $
nodeInputsType (CreateIngestPipelineInputs (CreateIngestPipelineUserInputs "p" "{}"))
`shouldBe` "create_ingest_pipeline"
it "nodeInputsType for OtherInputs is the captured type string" $
nodeInputsType (OtherInputs "noop" (object [])) `shouldBe` "noop"
-- =======================================================================
-- WorkflowNode round-trip (id + type + user_inputs + previous_node_inputs)
-- =======================================================================
describe "WorkflowNode JSON" $ do
it "round-trips a deploy_model node with previous_node_inputs" $ do
let n =
WorkflowNode
{ workflowNodeId = "deploy_model_3",
workflowNodeInputs = DeployModelInputs (DeployModelUserInputs Nothing),
workflowNodePreviousInputs = Just (Map.fromList [("register_model_2", "model_id")])
}
(decode . encode) n `shouldBe` Just n
it "round-trips an OtherInputs node (untyped step)" $ do
let n =
WorkflowNode
{ workflowNodeId = "noop_1",
workflowNodeInputs = OtherInputs "noop" (object ["delay" .= (5 :: Int)]),
workflowNodePreviousInputs = Nothing
}
(decode . encode) n `shouldBe` Just n
it "decodes a node whose user_inputs is omitted (e.g. noop)" $ do
-- A noop node may omit user_inputs entirely; decode must still
-- succeed and produce OtherInputs carrying an empty object.
let lbs = "{\"id\":\"noop_1\",\"type\":\"noop\"}" :: LBS.ByteString
decode lbs
`shouldBe` Just
( WorkflowNode
{ workflowNodeId = "noop_1",
workflowNodeInputs = OtherInputs "noop" (object []),
workflowNodePreviousInputs = Nothing
}
)
it "encodes a node with no previous_node_inputs omitting that field" $ do
let n =
WorkflowNode
{ workflowNodeId = "deploy_model_3",
workflowNodeInputs = DeployModelInputs (DeployModelUserInputs Nothing),
workflowNodePreviousInputs = Nothing
}
LBS.unpack (encode n)
`shouldNotSatisfy` isInfixOf "previous_node_inputs"
-- =======================================================================
-- WorkflowEdge round-trip
-- =======================================================================
describe "WorkflowEdge JSON" $ do
it "round-trips a simple edge" $ do
let e = WorkflowEdge "a" "b"
(decode . encode) e `shouldBe` Just e
it "encodes both fields" $ do
let lbs = encode (WorkflowEdge "a" "b")
LBS.unpack lbs `shouldSatisfy` isInfixOf "\"source\":\"a\""
LBS.unpack lbs `shouldSatisfy` isInfixOf "\"dest\":\"b\""
-- =======================================================================
-- WorkflowEntry (subset of WorkflowTemplate.workflows map)
-- =======================================================================
describe "WorkflowEntry JSON" $ do
it "round-trips a one-node, no-edges entry" $ do
let e =
WorkflowEntry
{ workflowEntryUserParams = Nothing,
workflowEntryNodes =
[ WorkflowNode
{ workflowNodeId = "deploy_model_3",
workflowNodeInputs = DeployModelInputs (DeployModelUserInputs Nothing),
workflowNodePreviousInputs = Nothing
}
],
workflowEntryEdges = Nothing
}
(decode . encode) e `shouldBe` Just e
it "decodes an entry with missing nodes as an empty list (lenient)" $ do
let lbs = "{\"user_params\":{}}" :: LBS.ByteString
decode lbs
`shouldBe` Just
( WorkflowEntry
{ workflowEntryUserParams = Just mempty,
workflowEntryNodes = [],
workflowEntryEdges = Nothing
}
)
-- =======================================================================
-- WorkflowTemplate round-trip (the canonical sample)
-- =======================================================================
describe "WorkflowTemplate JSON" $ do
it "decodes the documented \"Register and deploy a remote model\" template" $ do
let decoded = decode sampleRemoteModelTemplateJson :: Maybe WorkflowTemplate
decoded `shouldSatisfy` (\x -> case x of Just _ -> True; Nothing -> False)
-- Spot-check that the typed decoder picked up the right
-- constructor for each node.
case decoded of
Just tmpl ->
case Map.lookup "provision" <$> workflowTemplateWorkflows tmpl of
Just (Just entry) -> do
length (workflowEntryNodes entry) `shouldBe` 3
-- First node is create_connector with its typed inputs
case workflowEntryNodes entry of
(n1 : _) ->
nodeInputsType (workflowNodeInputs n1) `shouldBe` "create_connector"
_ -> expectationFailure "expected at least one node"
_ -> expectationFailure "expected a provision workflow entry"
Nothing -> expectationFailure "decode returned Nothing"
it "encodes and re-decodes the documented template (round-trip)" $ do
let decoded = decode sampleRemoteModelTemplateJson :: Maybe WorkflowTemplate
case decoded of
Just tmpl -> (decode . encode) tmpl `shouldBe` Just tmpl
Nothing -> expectationFailure "initial decode failed"
it "requires the name field" $ do
-- A template body with no name should fail to decode.
decode
"{\"description\":\"x\"}"
`shouldBe` (Nothing :: Maybe WorkflowTemplate)
it "round-trips a minimal one-name template" $ do
let t = WorkflowTemplate "just-a-name" Nothing Nothing Nothing Nothing
(decode . encode) t `shouldBe` Just t
encode t `shouldBe` "{\"name\":\"just-a-name\"}"
-- =======================================================================
-- CreateWorkflowResponse (the create / provision response)
-- =======================================================================
describe "CreateWorkflowResponse JSON" $ do
it "decodes the bare fire-and-forget response" $ do
let decoded = decode sampleWorkflowIdResponseJson :: Maybe CreateWorkflowResponse
decoded
`shouldBe` Just
( CreateWorkflowResponse
{ createWorkflowResponseWorkflowId = WorkflowId "8xL8bowB8y25Tqfenm50",
createWorkflowResponseState = Nothing,
createWorkflowResponseResourcesCreated = Nothing
}
)
it "decodes the timed response (state + resources_created)" $ do
let decoded = decode sampleTimedResponseJson :: Maybe CreateWorkflowResponse
case decoded of
Just resp -> do
unWorkflowId (createWorkflowResponseWorkflowId resp)
`shouldBe` "K13IR5QBEpCfUu_-AQdU"
createWorkflowResponseState resp `shouldBe` Just WorkflowStateCompleted
(length <$> createWorkflowResponseResourcesCreated resp) `shouldBe` Just 3
Nothing -> expectationFailure "decode failed"
it "round-trips the timed response" $ do
let decoded = decode sampleTimedResponseJson :: Maybe CreateWorkflowResponse
case decoded of
Just resp -> (decode . encode) resp `shouldBe` Just resp
Nothing -> expectationFailure "initial decode failed"
it "requires workflow_id" $
decode
"{\"state\":\"COMPLETED\"}"
`shouldBe` (Nothing :: Maybe CreateWorkflowResponse)
-- =======================================================================
-- ResourceCreated (the resources_created entry shape)
-- =======================================================================
describe "ResourceCreated JSON" $ do
it "round-trips regardless of field ordering in the source JSON" $ do
-- The docs explicitly note that workflow_step_id and
-- workflow_step_name appear in either order across entries.
-- Both must decode into the same Haskell value.
let order1 = "{\"workflow_step_id\":\"a\",\"workflow_step_name\":\"b\",\"resource_id\":\"c\",\"resource_type\":\"d\"}" :: LBS.ByteString
order2 = "{\"workflow_step_name\":\"b\",\"workflow_step_id\":\"a\",\"resource_id\":\"c\",\"resource_type\":\"d\"}" :: LBS.ByteString
expected = ResourceCreated "a" "b" "c" "d"
decode order1 `shouldBe` Just expected
decode order2 `shouldBe` Just expected
-- =======================================================================
-- Options rendering (createWorkflowOptionsParams / provisionOptionsParams / deleteWorkflowOptionsParams)
-- =======================================================================
describe "createWorkflowOptionsParams" $ do
it "renders nothing for the default options" $
createWorkflowOptionsParams defaultCreateWorkflowOptions `shouldBe` []
it "renders provision=true when set" $
createWorkflowOptionsParams
defaultCreateWorkflowOptions {createWorkflowOptionsProvision = Just True}
`shouldBe` [("provision", Just "true")]
it "renders validation=none when set" $
createWorkflowOptionsParams
defaultCreateWorkflowOptions {createWorkflowOptionsValidation = Just ValidationNone}
`shouldBe` [("validation", Just "none")]
it "renders use_case verbatim" $
createWorkflowOptionsParams
defaultCreateWorkflowOptions {createWorkflowOptionsUseCase = Just "semantic_search"}
`shouldBe` [("use_case", Just "semantic_search")]
it "renders all fields together in source order" $
createWorkflowOptionsParams
defaultCreateWorkflowOptions
{ createWorkflowOptionsProvision = Just True,
createWorkflowOptionsValidation = Just ValidationAll,
createWorkflowOptionsWaitForCompletionTimeout = Just "5s"
}
`shouldBe` [("provision", Just "true"), ("validation", Just "all"), ("wait_for_completion_timeout", Just "5s")]
describe "provisionOptionsParams" $ do
it "renders nothing for the default options" $
provisionOptionsParams defaultProvisionOptions `shouldBe` []
it "renders wait_for_completion_timeout when set" $
provisionOptionsParams
defaultProvisionOptions {provisionOptionsTimeout = Just "2s"}
`shouldBe` [("wait_for_completion_timeout", Just "2s")]
it "renders substitution keys as additional query params" $
provisionOptionsParams
defaultProvisionOptions {provisionOptionsSubstitutions = Just (Map.fromList [("openai_key", "12345")])}
`shouldBe` [("openai_key", Just "12345")]
it "renders both timeout and substitutions together" $
provisionOptionsParams
defaultProvisionOptions
{ provisionOptionsTimeout = Just "2s",
provisionOptionsSubstitutions = Just (Map.fromList [("k", "v")])
}
`shouldBe` [("wait_for_completion_timeout", Just "2s"), ("k", Just "v")]
describe "deleteWorkflowOptionsParams" $ do
it "renders nothing for the default options" $
deleteWorkflowOptionsParams defaultDeleteWorkflowOptions `shouldBe` []
it "renders clear_status=true when set" $
deleteWorkflowOptionsParams
defaultDeleteWorkflowOptions {deleteWorkflowOptionsClearStatus = Just True}
`shouldBe` [("clear_status", Just "true")]
-- =======================================================================
-- DeprovisionWorkflowResponse (deprovision success body)
-- =======================================================================
describe "DeprovisionWorkflowResponse JSON" $ do
it "decodes the bare {workflow_id} success body" $
decode "{\"workflow_id\":\"8xL8bowB8y25Tqfenm50\"}"
`shouldBe` Just (DeprovisionWorkflowResponse (WorkflowId "8xL8bowB8y25Tqfenm50"))
it "round-trips" $
let resp = DeprovisionWorkflowResponse (WorkflowId "abc")
in (decode . encode) resp `shouldBe` Just resp
it "requires workflow_id" $
decode "{\"foo\":\"bar\"}"
`shouldBe` (Nothing :: Maybe DeprovisionWorkflowResponse)
it "silently ignores unexpected extra keys (forward-compat)" $ do
let resp = DeprovisionWorkflowResponse (WorkflowId "w")
decode "{\"workflow_id\":\"w\",\"unexpected\":\"x\",\"state\":\"COMPLETED\"}"
`shouldBe` Just resp
-- =======================================================================
-- WorkflowStateResponse (GET _status body)
-- =======================================================================
describe "WorkflowStateResponse JSON" $ do
it "decodes the minimal NOT_STARTED body" $ do
let lbs = "{\"workflow_id\":\"8xL8bowB8y25Tqfenm50\",\"state\":\"NOT_STARTED\"}" :: LBS.ByteString
decoded = decode lbs :: Maybe WorkflowStateResponse
workflowStateResponseWorkflowId <$> decoded `shouldBe` Just (WorkflowId "8xL8bowB8y25Tqfenm50")
workflowStateResponseState <$> decoded `shouldBe` Just WorkflowStateNotStarted
(decoded >>= workflowStateResponseResourcesCreated) `shouldBe` Nothing
it "decodes a provisioning body with resources_created" $ do
let lbs =
"{\"workflow_id\":\"w\",\"state\":\"PROVISIONING\",\
\ \"resources_created\":[{\"workflow_step_name\":\"create_connector\",\
\ \"workflow_step_id\":\"create_connector_1\",\"resource_type\":\"connector_id\",\
\ \"resource_id\":\"r1\"}]}" ::
LBS.ByteString
decoded = decode lbs :: Maybe WorkflowStateResponse
workflowStateResponseState <$> decoded `shouldBe` Just WorkflowStateProvisioning
(length <$> (workflowStateResponseResourcesCreated =<< decoded)) `shouldBe` Just 1
it "decodes a FAILED body carrying an error field" $ do
let lbs = "{\"workflow_id\":\"w\",\"state\":\"FAILED\",\"error\":\"boom\"}" :: LBS.ByteString
workflowStateResponseError
<$> (decode lbs :: Maybe WorkflowStateResponse)
`shouldBe` Just (Just "boom")
it "decodes an unknown state via the forward-compat escape hatch" $
workflowStateResponseState
<$> (decode "{\"workflow_id\":\"w\",\"state\":\"QUEUED\"}" :: Maybe WorkflowStateResponse)
`shouldBe` Just (WorkflowStateOther "QUEUED")
it "captures the all=true extras verbatim in other (forward-compat)" $ do
let lbs =
"{\"workflow_id\":\"w\",\"state\":\"COMPLETED\",\
\ \"provisioning_progress\":{\"done\":3,\"total\":3},\
\ \"provision_start_time\":123,\"provision_end_time\":456,\
\ \"user_outputs\":{\"k\":\"v\"}}" ::
LBS.ByteString
other = workflowStateResponseOther <$> (decode lbs :: Maybe WorkflowStateResponse)
-- The catch-all is the whole original object, so the all=true
-- fields are preserved verbatim and reachable by re-decoding it.
other `shouldBe` (decode lbs :: Maybe Value)
-- =======================================================================
-- Options rendering (deprovisionWorkflowOptionsParams / workflowStateOptionsParams)
-- =======================================================================
describe "deprovisionWorkflowOptionsParams" $ do
it "renders nothing for the default options" $
deprovisionWorkflowOptionsParams defaultDeprovisionWorkflowOptions `shouldBe` []
it "renders allow_delete verbatim when set" $
deprovisionWorkflowOptionsParams
defaultDeprovisionWorkflowOptions {deprovisionWorkflowOptionsAllowDelete = Just "my-index,my-pipeline"}
`shouldBe` [("allow_delete", Just "my-index,my-pipeline")]
describe "workflowStateOptionsParams" $ do
it "renders nothing for the default options" $
workflowStateOptionsParams defaultWorkflowStateOptions `shouldBe` []
it "renders all=true when set" $
workflowStateOptionsParams
defaultWorkflowStateOptions {workflowStateOptionsAll = Just True}
`shouldBe` [("all", Just "true")]
it "renders all=false when explicitly set" $
workflowStateOptionsParams
defaultWorkflowStateOptions {workflowStateOptionsAll = Just False}
`shouldBe` [("all", Just "false")]
-- =======================================================================
-- WorkflowStep (GET _steps descriptor entry)
-- =======================================================================
describe "WorkflowStep JSON" $ do
it "decodes the register_remote_model sample from the docs" $ do
let lbs =
"{\"inputs\":[\"name\",\"connector_id\"],\
\ \"outputs\":[\"model_id\",\"register_model_status\"],\
\ \"required_plugins\":[\"opensearch-ml\"]}" ::
LBS.ByteString
decoded = decode lbs :: Maybe WorkflowStep
workflowStepInputs <$> decoded `shouldBe` Just ["name", "connector_id"]
workflowStepOutputs <$> decoded `shouldBe` Just ["model_id", "register_model_status"]
workflowStepRequiredPlugins <$> decoded `shouldBe` Just ["opensearch-ml"]
it "decodes a step carrying an undocumented field (forward-compat)" $ do
let lbs =
"{\"inputs\":[\"a\"],\"outputs\":[\"b\"],\
\ \"required_plugins\":[\"opensearch-ml\"],\"default_timeout\":60}" ::
LBS.ByteString
decoded = decode lbs :: Maybe WorkflowStep
workflowStepInputs <$> decoded `shouldBe` Just ["a"]
-- The catch-all captures the whole original object verbatim, so the
-- undocumented @default_timeout@ key survives a round-trip.
(workflowStepOther <$> decoded) `shouldBe` (decode lbs :: Maybe Value)
it "decodes a step missing the optional arrays as empty lists" $ do
let decoded = decode "{}" :: Maybe WorkflowStep
workflowStepInputs <$> decoded `shouldBe` Just []
workflowStepOutputs <$> decoded `shouldBe` Just []
workflowStepRequiredPlugins <$> decoded `shouldBe` Just []
-- =======================================================================
-- WorkflowStepsResponse (GET _steps top-level map)
-- =======================================================================
describe "WorkflowStepsResponse JSON" $ do
it "decodes a multi-step map keyed by step name" $ do
let lbs =
"{\"register_remote_model\":\
\ {\"inputs\":[\"name\"],\"outputs\":[\"model_id\"],\"required_plugins\":[\"opensearch-ml\"]},\
\ \"deploy_model\":\
\ {\"inputs\":[\"model_id\"],\"outputs\":[],\"required_plugins\":[\"opensearch-ml\"]}}" ::
LBS.ByteString
decoded = unWorkflowStepsResponse <$> (decode lbs :: Maybe WorkflowStepsResponse)
(Map.size <$> decoded) `shouldBe` Just 2
let outputs =
workflowStepOutputs
<$> (decoded >>= Map.lookup "register_remote_model")
outputs `shouldBe` Just ["model_id"]
it "decodes an empty object as an empty map" $
unWorkflowStepsResponse
<$> (decode "{}" :: Maybe WorkflowStepsResponse)
`shouldBe` Just Map.empty
-- =======================================================================
-- Options rendering (workflowStepsOptionsParams)
-- =======================================================================
describe "workflowStepsOptionsParams" $ do
it "renders nothing for the default options" $
workflowStepsOptionsParams defaultWorkflowStepsOptions `shouldBe` []
it "renders workflow_step verbatim when set" $
workflowStepsOptionsParams
defaultWorkflowStepsOptions {workflowStepsStep = Just "create_connector,deploy_model"}
`shouldBe` [("workflow_step", Just "create_connector,deploy_model")]
-- =======================================================================
-- searchWorkflowState hit shape (SearchResult WorkflowStateResponse)
-- =======================================================================
describe "searchWorkflowState hit (SearchResult WorkflowStateResponse)" $
it "decodes a standard search envelope wrapping workflow-state documents" $ do
let lbs =
"{\"took\":1,\"timed_out\":false,\"_shards\":{},\
\ \"hits\":{\"total\":{\"value\":1,\"relation\":\"eq\"},\
\ \"hits\":[{\"_index\":\"workflow-state\",\"_id\":\"w\",\
\ \"_source\":{\"workflow_id\":\"w\",\"state\":\"NOT_STARTED\"}}]}}" ::
LBS.ByteString
decoded = decode lbs :: Maybe (SearchResult WorkflowStateResponse)
-- If decode failed this whole chain yields Nothing.
hitCount = fmap (length . hits . searchHits) decoded
firstSrcWorkflowId =
decoded >>= \r -> case hits (searchHits r) of
(h : _) -> workflowStateResponseWorkflowId <$> hitSource h
[] -> Nothing
hitCount `shouldBe` Just 1
firstSrcWorkflowId `shouldBe` Just (WorkflowId "w")
-- QuickCheck instance: drives the WorkflowState round-trip property above.
-- Includes the four documented states plus a generator for the Other
-- escape hatch (so the property exercises forward-compat decode).
instance Arbitrary WorkflowState where
arbitrary =
oneof
[ pure WorkflowStateNotStarted,
pure WorkflowStateProvisioning,
pure WorkflowStateCompleted,
pure WorkflowStateFailed,
WorkflowStateOther . T.pack <$> listOf1 (elements (['A' .. 'Z'] <> "_"))
]
shrink (WorkflowStateOther _) = [WorkflowStateCompleted, WorkflowStateFailed]
shrink _ = []