From f12e410b70bf1560bd6fa94e01a2a9aff47b276a Mon Sep 17 00:00:00 2001 From: Alexander Kiel Date: Sat, 12 Oct 2019 11:35:08 +0200 Subject: [PATCH] Split into Modules --- .dockerignore | 4 +- .gitignore | 4 +- .travis.yml | 21 +- Dockerfile | 10 +- Makefile | 50 ++ README.md | 10 +- deps.edn | 119 ++++ dev/blaze/dev.clj | 40 ++ dev/blaze/dev/datomic.clj | 29 + dev/user.clj | 133 ----- docker-compose.yml | 2 +- docs/index.adoc | 6 +- fetch-cql-tests.sh | 16 - modules/anomaly/deps.edn | 3 + modules/anomaly/src/blaze/anomaly.clj | 23 + modules/cql/.gitignore | 1 + modules/cql/deps.edn | 58 ++ .../resources}/blaze/fhir-modelinfo-4.0.0.xml | 0 .../org/hl7/elm_modelinfo/r1/jaxb.properties | 0 .../cql/src}/blaze/cql_translator.clj | 0 .../cql/src}/blaze/elm/aggregates.clj | 0 .../cql/src}/blaze/elm/boolean.clj | 0 .../cql/src}/blaze/elm/compiler.clj | 89 ++- .../cql/src}/blaze/elm/compiler/function.clj | 2 +- .../cql/src}/blaze/elm/compiler/property.clj | 16 +- .../cql/src}/blaze/elm/compiler/protocols.clj | 0 .../cql/src}/blaze/elm/compiler/query.clj | 0 .../cql/src}/blaze/elm/compiler/retrieve.clj | 6 +- .../cql/src}/blaze/elm/data_provider.clj | 4 +- .../cql/src}/blaze/elm/date_time.clj | 30 +- .../cql/src}/blaze/elm/decimal.clj | 0 .../cql/src}/blaze/elm/deps_infer.clj | 0 .../src}/blaze/elm/equiv_relationships.clj | 0 .../cql/src}/blaze/elm/evaluator.clj | 13 +- .../cql/src}/blaze/elm/integer.clj | 0 .../cql/src}/blaze/elm/interval.clj | 0 {src => modules/cql/src}/blaze/elm/list.clj | 3 +- {src => modules/cql/src}/blaze/elm/nil.clj | 0 .../cql/src}/blaze/elm/normalizer.clj | 0 .../cql/src}/blaze/elm/protocols.clj | 0 .../cql/src}/blaze/elm/quantity.clj | 0 {src => modules/cql/src}/blaze/elm/spec.clj | 1 - {src => modules/cql/src}/blaze/elm/string.clj | 0 .../cql/src}/blaze/elm/type_infer.clj | 0 {src => modules/cql/src}/blaze/elm/util.clj | 0 {test => modules/cql/test}/blaze/cql_test.clj | 2 +- .../cql/test}/blaze/cql_translator_test.clj | 10 +- .../blaze/elm/compiler/property_test.clj | 23 +- .../blaze/elm/compiler/retrieve_test.clj | 68 ++- .../cql/test}/blaze/elm/compiler_test.clj | 75 ++- .../blaze/elm/equiv_relationships_test.clj | 6 +- .../cql/test}/blaze/elm/literals.clj | 0 .../cql/test}/blaze/elm/normalizer_test.clj | 12 +- .../cql/test}/blaze/elm/type_infer_test.clj | 16 +- {src => modules/cql/test}/data_readers.clj | 0 modules/cql/tests.edn | 5 + modules/datomic-test-util/deps.edn | 11 + .../src}/blaze/datomic/test_util.clj | 5 +- modules/datomic/deps.edn | 71 +++ modules/datomic/src/blaze/datomic.clj | 54 ++ .../datomic/src}/blaze/datomic/cql.clj | 0 .../src}/blaze/datomic/element_definition.clj | 0 .../datomic/src}/blaze/datomic/pull.clj | 1 - .../datomic/src}/blaze/datomic/quantity.clj | 0 .../datomic/src}/blaze/datomic/schema.clj | 14 +- modules/datomic/src/blaze/datomic/spec.clj | 43 ++ .../src}/blaze/datomic/transaction.clj | 113 ++-- .../datomic/src}/blaze/datomic/util.clj | 0 .../datomic/src}/blaze/datomic/value.clj | 2 +- .../datomic/test}/blaze/datomic/pull_test.clj | 52 +- .../test}/blaze/datomic/schema_test.clj | 17 +- .../test}/blaze/datomic/transaction_test.clj | 371 ++++++------ .../datomic/test}/blaze/datomic/util_test.clj | 6 +- .../test}/blaze/datomic/value_test.clj | 19 +- modules/datomic/tests.edn | 5 + modules/executor/deps.edn | 1 + .../executor/src}/blaze/executors.clj | 3 + modules/extern-terminology-service/README.md | 3 + modules/extern-terminology-service/deps.edn | 21 + .../src}/blaze/terminology_service/extern.clj | 82 ++- modules/fhir-client/deps.edn | 27 + .../fhir-client/src}/blaze/fhir_client.clj | 0 modules/interaction/deps.edn | 38 ++ .../src/blaze/interaction}/capabilities.clj | 11 +- .../src/blaze/interaction}/create.clj | 36 +- .../src/blaze/interaction}/delete.clj | 32 +- .../blaze/interaction/history/instance.clj | 19 +- .../src/blaze/interaction/history/system.clj | 17 +- .../src/blaze/interaction/history/type.clj | 21 +- .../src/blaze/interaction}/history/util.clj | 27 +- .../blaze/interaction/middleware}/type.clj | 2 +- .../src/blaze/interaction}/read.clj | 17 +- .../src/blaze/interaction/search_type.clj | 16 +- .../src/blaze/interaction}/spec.clj | 5 +- .../src/blaze/interaction}/transaction.clj | 49 +- .../src/blaze/interaction}/update.clj | 36 +- .../blaze/interaction/capabilities_test.clj | 19 + .../test/blaze/interaction}/create_test.clj | 73 ++- .../test/blaze/interaction}/delete_test.clj | 67 ++- .../interaction/history/instance_test.clj | 66 +-- .../blaze/interaction/history/system_test.clj | 60 +- .../blaze/interaction}/history/test_util.clj | 16 +- .../blaze/interaction/history/type_test.clj | 51 +- .../blaze/interaction}/history/util_test.clj | 36 +- .../interaction/middleware}/type_test.clj | 19 +- .../test/blaze/interaction}/read_test.clj | 25 +- .../blaze/interaction/search_type_test.clj | 26 +- .../test/blaze/interaction/test_util.clj | 86 +++ .../blaze/interaction}/transaction_test.clj | 122 ++-- .../test/blaze/interaction}/update_test.clj | 112 ++-- modules/interaction/tests.edn | 5 + modules/module-base/deps.edn | 6 + modules/module-base/src/blaze/module.clj | 19 + modules/openid-auth/deps.edn | 27 + modules/openid-auth/src/blaze/openid_auth.clj | 55 ++ .../test/blaze/openid_auth_test.clj | 6 +- modules/openid-auth/tests.edn | 5 + .../measure-evaluate-measure/README.md | 3 + .../measure-evaluate-measure/deps.edn | 38 ++ .../blaze/fhir/operation/evaluate_measure.clj | 83 +++ .../fhir/operation/evaluate_measure/cql.clj | 0 .../evaluate_measure/handler/impl.clj | 35 +- .../operation/evaluate_measure/measure.clj | 0 .../evaluate_measure/middleware/params.clj | 0 .../evaluate_measure/handler/impl_test.clj | 77 ++- .../evaluate_measure/measure_test.clj | 8 +- .../operation/evaluate_measure/q1-data.json | 0 .../operation/evaluate_measure/q1-query.cql | 0 .../operation/evaluate_measure/q10-data.json | 0 .../operation/evaluate_measure/q10-query.cql | 0 .../operation/evaluate_measure/q11-data.json | 0 .../operation/evaluate_measure/q11-query.cql | 0 .../operation/evaluate_measure/q12-data.json | 0 .../operation/evaluate_measure/q12-query.cql | 0 .../operation/evaluate_measure/q13-data.json | 0 .../operation/evaluate_measure/q13-query.cql | 0 .../operation/evaluate_measure/q14-data.json | 135 +++++ .../operation/evaluate_measure/q14-query.cql | 10 + .../operation/evaluate_measure/q15-data.json | 79 +++ .../operation/evaluate_measure/q15-query.cql | 8 + .../operation/evaluate_measure/q16-data.json | 347 ++++++++++++ .../operation/evaluate_measure/q16-query.cql | 10 + .../operation/evaluate_measure/q17-data.json | 77 +++ .../operation/evaluate_measure/q17-query.cql | 5 + .../operation/evaluate_measure/q2-data.json | 0 .../operation/evaluate_measure/q2-query.cql | 0 .../operation/evaluate_measure/q3-data.json | 0 .../operation/evaluate_measure/q3-query.cql | 0 .../operation/evaluate_measure/q4-data.json | 0 .../operation/evaluate_measure/q4-query.cql | 0 .../operation/evaluate_measure/q5-data.json | 0 .../operation/evaluate_measure/q5-query.cql | 0 .../operation/evaluate_measure/q6-data.json | 0 .../operation/evaluate_measure/q6-query.cql | 0 .../operation/evaluate_measure/q7-data.json | 0 .../operation/evaluate_measure/q7-query.cql | 0 .../operation/evaluate_measure/q8-data.json | 0 .../operation/evaluate_measure/q8-query.cql | 0 .../operation/evaluate_measure/q9-data.json | 0 .../operation/evaluate_measure/q9-query.cql | 2 +- .../measure-evaluate-measure/tests.edn | 5 + modules/rest-api/deps.edn | 54 ++ modules/rest-api/src/blaze/rest_api.clj | 385 +++++++++++++ .../blaze/rest_api/middleware/auth_guard.clj | 22 + .../src/blaze/rest_api}/middleware/json.clj | 6 +- modules/rest-api/src/blaze/rest_api/spec.clj | 115 ++++ modules/rest-api/test/blaze/rest_api_test.clj | 184 ++++++ modules/rest-api/tests.edn | 5 + modules/rest-util/deps.edn | 44 ++ .../rest-util/src}/blaze/bundle.clj | 4 +- .../src}/blaze/fhir/response/create.clj | 0 .../src}/blaze/handler/fhir/util.clj | 60 +- .../rest-util/src}/blaze/handler/util.clj | 22 +- .../src}/blaze/middleware/fhir/metrics.clj | 0 .../rest-util/test}/blaze/bundle_test.clj | 14 +- .../test}/blaze/fhir/response/create_test.clj | 53 +- .../test/blaze/handler/fhir/util_test.clj | 153 +++++ .../test}/blaze/handler/util_test.clj | 8 +- .../blaze/middleware/fhir/metrics_test.clj | 12 + modules/rest-util/tests.edn | 5 + modules/spec/deps.edn | 1 + {src => modules/spec/src}/blaze/spec.clj | 106 +--- modules/structure-definition/deps.edn | 11 + .../profiles-resources.json | 0 .../profiles-types.json | 0 .../src/blaze/structure_definition.clj | 142 +++++ modules/terminology-service/README.md | 3 + modules/terminology-service/deps.edn | 3 + .../src}/blaze/terminology_service.clj | 0 .../thread-pool-executor-collector/deps.edn | 6 + .../blaze/thread_pool_executor_collector.clj | 79 +++ pom.xml | 24 + project.clj | 82 --- resources/blaze.edn | 107 ++++ src/blaze/core.clj | 21 +- .../operation/evaluate_measure/handler.clj | 32 -- src/blaze/handler/app.clj | 58 +- src/blaze/handler/cql_evaluation.clj | 123 ---- src/blaze/handler/fhir/core.clj | 112 ---- src/blaze/handler/health.clj | 15 +- src/blaze/handler/metrics.clj | 22 +- src/blaze/metrics.clj | 138 ++--- src/blaze/middleware/authentication.clj | 58 -- src/blaze/middleware/cors.clj | 20 - src/blaze/middleware/guard.clj | 14 - src/blaze/structure_definition.clj | 30 - src/blaze/system.clj | 530 +++++------------- src/blaze/util/cache.clj | 20 - test/blaze/datomic/cql_test.clj | 16 - test/blaze/handler/app_test.clj | 72 --- test/blaze/handler/fhir/core_test.clj | 95 ---- test/blaze/handler/fhir/test_util.clj | 92 --- test/blaze/handler/fhir/util_test.clj | 49 -- test/blaze/handler/test_util.clj | 31 - test/blaze/integration_test.clj | 83 --- test/blaze/system_test.clj | 19 +- tests.edn | 5 + 217 files changed, 4678 insertions(+), 2667 deletions(-) create mode 100644 Makefile create mode 100644 deps.edn create mode 100644 dev/blaze/dev.clj create mode 100644 dev/blaze/dev/datomic.clj delete mode 100644 dev/user.clj delete mode 100755 fetch-cql-tests.sh create mode 100644 modules/anomaly/deps.edn create mode 100644 modules/anomaly/src/blaze/anomaly.clj create mode 100644 modules/cql/.gitignore create mode 100644 modules/cql/deps.edn rename {resources => modules/cql/resources}/blaze/fhir-modelinfo-4.0.0.xml (100%) rename {resources => modules/cql/resources}/org/hl7/elm_modelinfo/r1/jaxb.properties (100%) rename {src => modules/cql/src}/blaze/cql_translator.clj (100%) rename {src => modules/cql/src}/blaze/elm/aggregates.clj (100%) rename {src => modules/cql/src}/blaze/elm/boolean.clj (100%) rename {src => modules/cql/src}/blaze/elm/compiler.clj (97%) rename {src => modules/cql/src}/blaze/elm/compiler/function.clj (92%) rename {src => modules/cql/src}/blaze/elm/compiler/property.clj (93%) rename {src => modules/cql/src}/blaze/elm/compiler/protocols.clj (100%) rename {src => modules/cql/src}/blaze/elm/compiler/query.clj (100%) rename {src => modules/cql/src}/blaze/elm/compiler/retrieve.clj (94%) rename {src => modules/cql/src}/blaze/elm/data_provider.clj (59%) rename {src => modules/cql/src}/blaze/elm/date_time.clj (97%) rename {src => modules/cql/src}/blaze/elm/decimal.clj (100%) rename {src => modules/cql/src}/blaze/elm/deps_infer.clj (100%) rename {src => modules/cql/src}/blaze/elm/equiv_relationships.clj (100%) rename {src => modules/cql/src}/blaze/elm/evaluator.clj (95%) rename {src => modules/cql/src}/blaze/elm/integer.clj (100%) rename {src => modules/cql/src}/blaze/elm/interval.clj (100%) rename {src => modules/cql/src}/blaze/elm/list.clj (97%) rename {src => modules/cql/src}/blaze/elm/nil.clj (100%) rename {src => modules/cql/src}/blaze/elm/normalizer.clj (100%) rename {src => modules/cql/src}/blaze/elm/protocols.clj (100%) rename {src => modules/cql/src}/blaze/elm/quantity.clj (100%) rename {src => modules/cql/src}/blaze/elm/spec.clj (99%) rename {src => modules/cql/src}/blaze/elm/string.clj (100%) rename {src => modules/cql/src}/blaze/elm/type_infer.clj (100%) rename {src => modules/cql/src}/blaze/elm/util.clj (100%) rename {test => modules/cql/test}/blaze/cql_test.clj (99%) rename {test => modules/cql/test}/blaze/cql_translator_test.clj (83%) rename {test => modules/cql/test}/blaze/elm/compiler/property_test.clj (71%) rename {test => modules/cql/test}/blaze/elm/compiler/retrieve_test.clj (68%) rename {test => modules/cql/test}/blaze/elm/compiler_test.clj (99%) rename {test => modules/cql/test}/blaze/elm/equiv_relationships_test.clj (94%) rename {src => modules/cql/test}/blaze/elm/literals.clj (100%) rename {test => modules/cql/test}/blaze/elm/normalizer_test.clj (96%) rename {test => modules/cql/test}/blaze/elm/type_infer_test.clj (89%) rename {src => modules/cql/test}/data_readers.clj (100%) create mode 100644 modules/cql/tests.edn create mode 100644 modules/datomic-test-util/deps.edn rename {test => modules/datomic-test-util/src}/blaze/datomic/test_util.clj (98%) create mode 100644 modules/datomic/deps.edn create mode 100644 modules/datomic/src/blaze/datomic.clj rename {src => modules/datomic/src}/blaze/datomic/cql.clj (100%) rename {src => modules/datomic/src}/blaze/datomic/element_definition.clj (100%) rename {src => modules/datomic/src}/blaze/datomic/pull.clj (99%) rename {src => modules/datomic/src}/blaze/datomic/quantity.clj (100%) rename {src => modules/datomic/src}/blaze/datomic/schema.clj (97%) create mode 100644 modules/datomic/src/blaze/datomic/spec.clj rename {src => modules/datomic/src}/blaze/datomic/transaction.clj (94%) rename {src => modules/datomic/src}/blaze/datomic/util.clj (100%) rename {src => modules/datomic/src}/blaze/datomic/value.clj (99%) rename {test => modules/datomic/test}/blaze/datomic/pull_test.clj (62%) rename {test => modules/datomic/test}/blaze/datomic/schema_test.clj (97%) rename {test => modules/datomic/test}/blaze/datomic/transaction_test.clj (83%) rename {test => modules/datomic/test}/blaze/datomic/util_test.clj (92%) rename {test => modules/datomic/test}/blaze/datomic/value_test.clj (78%) create mode 100644 modules/datomic/tests.edn create mode 100644 modules/executor/deps.edn rename {src => modules/executor/src}/blaze/executors.clj (96%) create mode 100644 modules/extern-terminology-service/README.md create mode 100644 modules/extern-terminology-service/deps.edn rename {src => modules/extern-terminology-service/src}/blaze/terminology_service/extern.clj (69%) create mode 100644 modules/fhir-client/deps.edn rename {src => modules/fhir-client/src}/blaze/fhir_client.clj (100%) create mode 100644 modules/interaction/deps.edn rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/capabilities.clj (91%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/create.clj (61%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/delete.clj (59%) rename src/blaze/handler/fhir/history_instance.clj => modules/interaction/src/blaze/interaction/history/instance.clj (85%) rename src/blaze/handler/fhir/history_system.clj => modules/interaction/src/blaze/interaction/history/system.clj (89%) rename src/blaze/handler/fhir/history_type.clj => modules/interaction/src/blaze/interaction/history/type.clj (87%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/history/util.clj (88%) rename {src/blaze/middleware/fhir => modules/interaction/src/blaze/interaction/middleware}/type.clj (93%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/read.clj (85%) rename src/blaze/handler/fhir/search.clj => modules/interaction/src/blaze/interaction/search_type.clj (85%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/spec.clj (66%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/transaction.clj (89%) rename {src/blaze/handler/fhir => modules/interaction/src/blaze/interaction}/update.clj (73%) create mode 100644 modules/interaction/test/blaze/interaction/capabilities_test.clj rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/create_test.clj (58%) rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/delete_test.clj (59%) rename test/blaze/handler/fhir/history_instance_test.clj => modules/interaction/test/blaze/interaction/history/instance_test.clj (54%) rename test/blaze/handler/fhir/history_system_test.clj => modules/interaction/test/blaze/interaction/history/system_test.clj (85%) rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/history/test_util.clj (86%) rename test/blaze/handler/fhir/history_type_test.clj => modules/interaction/test/blaze/interaction/history/type_test.clj (60%) rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/history/util_test.clj (87%) rename {test/blaze/middleware/fhir => modules/interaction/test/blaze/interaction/middleware}/type_test.clj (76%) rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/read_test.clj (84%) rename test/blaze/handler/fhir/search_test.clj => modules/interaction/test/blaze/interaction/search_type_test.clj (82%) create mode 100644 modules/interaction/test/blaze/interaction/test_util.clj rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/transaction_test.clj (85%) rename {test/blaze/handler/fhir => modules/interaction/test/blaze/interaction}/update_test.clj (63%) create mode 100644 modules/interaction/tests.edn create mode 100644 modules/module-base/deps.edn create mode 100644 modules/module-base/src/blaze/module.clj create mode 100644 modules/openid-auth/deps.edn create mode 100644 modules/openid-auth/src/blaze/openid_auth.clj rename test/blaze/middleware/authentication_test.clj => modules/openid-auth/test/blaze/openid_auth_test.clj (93%) create mode 100644 modules/openid-auth/tests.edn create mode 100644 modules/operations/measure-evaluate-measure/README.md create mode 100644 modules/operations/measure-evaluate-measure/deps.edn create mode 100644 modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj rename {src => modules/operations/measure-evaluate-measure/src}/blaze/fhir/operation/evaluate_measure/cql.clj (100%) rename {src => modules/operations/measure-evaluate-measure/src}/blaze/fhir/operation/evaluate_measure/handler/impl.clj (73%) rename {src => modules/operations/measure-evaluate-measure/src}/blaze/fhir/operation/evaluate_measure/measure.clj (100%) rename {src => modules/operations/measure-evaluate-measure/src}/blaze/fhir/operation/evaluate_measure/middleware/params.clj (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj (56%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/measure_test.clj (98%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q1-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q1-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q10-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q10-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q11-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q11-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q12-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q12-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q13-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q13-query.cql (100%) create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-data.json create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-query.cql create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-data.json create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-query.cql create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-data.json create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-query.cql create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-data.json create mode 100644 modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-query.cql rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q2-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q2-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q3-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q3-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q4-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q4-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q5-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q5-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q6-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q6-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q7-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q7-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q8-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q8-query.cql (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q9-data.json (100%) rename {test => modules/operations/measure-evaluate-measure/test}/blaze/fhir/operation/evaluate_measure/q9-query.cql (80%) create mode 100644 modules/operations/measure-evaluate-measure/tests.edn create mode 100644 modules/rest-api/deps.edn create mode 100644 modules/rest-api/src/blaze/rest_api.clj create mode 100644 modules/rest-api/src/blaze/rest_api/middleware/auth_guard.clj rename {src/blaze => modules/rest-api/src/blaze/rest_api}/middleware/json.clj (96%) create mode 100644 modules/rest-api/src/blaze/rest_api/spec.clj create mode 100644 modules/rest-api/test/blaze/rest_api_test.clj create mode 100644 modules/rest-api/tests.edn create mode 100644 modules/rest-util/deps.edn rename {src => modules/rest-util/src}/blaze/bundle.clj (98%) rename {src => modules/rest-util/src}/blaze/fhir/response/create.clj (100%) rename {src => modules/rest-util/src}/blaze/handler/fhir/util.clj (71%) rename {src => modules/rest-util/src}/blaze/handler/util.clj (88%) rename {src => modules/rest-util/src}/blaze/middleware/fhir/metrics.clj (100%) rename {test => modules/rest-util/test}/blaze/bundle_test.clj (96%) rename {test => modules/rest-util/test}/blaze/fhir/response/create_test.clj (62%) create mode 100644 modules/rest-util/test/blaze/handler/fhir/util_test.clj rename {test => modules/rest-util/test}/blaze/handler/util_test.clj (53%) create mode 100644 modules/rest-util/test/blaze/middleware/fhir/metrics_test.clj create mode 100644 modules/rest-util/tests.edn create mode 100644 modules/spec/deps.edn rename {src => modules/spec/src}/blaze/spec.clj (62%) create mode 100644 modules/structure-definition/deps.edn rename {resources/blaze/fhir/r4/structure-definitions => modules/structure-definition/resources/blaze/fhir/r4/structure_definitions}/profiles-resources.json (100%) rename {resources/blaze/fhir/r4/structure-definitions => modules/structure-definition/resources/blaze/fhir/r4/structure_definitions}/profiles-types.json (100%) create mode 100644 modules/structure-definition/src/blaze/structure_definition.clj create mode 100644 modules/terminology-service/README.md create mode 100644 modules/terminology-service/deps.edn rename {src => modules/terminology-service/src}/blaze/terminology_service.clj (100%) create mode 100644 modules/thread-pool-executor-collector/deps.edn create mode 100644 modules/thread-pool-executor-collector/src/blaze/thread_pool_executor_collector.clj create mode 100644 pom.xml delete mode 100644 project.clj create mode 100644 resources/blaze.edn delete mode 100644 src/blaze/fhir/operation/evaluate_measure/handler.clj delete mode 100644 src/blaze/handler/cql_evaluation.clj delete mode 100644 src/blaze/handler/fhir/core.clj delete mode 100644 src/blaze/middleware/authentication.clj delete mode 100644 src/blaze/middleware/cors.clj delete mode 100644 src/blaze/middleware/guard.clj delete mode 100644 src/blaze/structure_definition.clj delete mode 100644 src/blaze/util/cache.clj delete mode 100644 test/blaze/datomic/cql_test.clj delete mode 100644 test/blaze/handler/app_test.clj delete mode 100644 test/blaze/handler/fhir/core_test.clj delete mode 100644 test/blaze/handler/fhir/test_util.clj delete mode 100644 test/blaze/handler/fhir/util_test.clj delete mode 100644 test/blaze/handler/test_util.clj delete mode 100644 test/blaze/integration_test.clj create mode 100644 tests.edn diff --git a/.dockerignore b/.dockerignore index 9bb1d68e9..61387306a 100644 --- a/.dockerignore +++ b/.dockerignore @@ -1,5 +1,7 @@ * +!modules !resources !src !Dockerfile -!project.clj +!deps.edn +!pom.xml diff --git a/.gitignore b/.gitignore index 523688dc0..a1f292682 100644 --- a/.gitignore +++ b/.gitignore @@ -1,11 +1,11 @@ /target /.lein-* -/.nrepl-port +.nrepl-port /queries /generate-docs.sh /fill-store.sh /load-test.sh /start-db.sh -/cql-test /kube* /nginx.conf +.cpcache diff --git a/.travis.yml b/.travis.yml index 8361f455c..a416873b7 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,9 +1,18 @@ -dist: trusty -language: clojure +sudo: true +language: java jdk: - openjdk8 -lein: 2.8.1 +- openjdk11 +cache: + directories: + - $HOME/.m2 + - $HOME/.cljs + - $HOME/.gitlibs + - .cpcache +install: +- curl -O https://download.clojure.org/install/linux-install-1.10.1.469.sh +- chmod +x linux-install-1.10.1.469.sh +- sudo ./linux-install-1.10.1.469.sh script: -- ./fetch-cql-tests.sh -- lein check -- lein test +- make check +- make test diff --git a/Dockerfile b/Dockerfile index 5800b09f5..7e7ddd0eb 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,14 +1,14 @@ -FROM clojure:lein-2.9.1 as build +FROM clojure:openjdk-11-tools-deps as build COPY . /build/ WORKDIR /build -RUN lein uberjar +RUN clojure -A:depstar -m hf.depstar.uberjar target/blaze-standalone.jar -FROM openjdk:8u222-jre +FROM openjdk:11.0.4-jre -COPY --from=build /build/target/blaze-0.7.0-alpha3-standalone.jar /app/ +COPY --from=build /build/target/blaze-standalone.jar /app/ WORKDIR /app -CMD ["/bin/bash", "-c", "java $JVM_OPTS -jar blaze-0.7.0-alpha3-standalone.jar"] +CMD ["/bin/bash", "-c", "java $JVM_OPTS -jar blaze-standalone.jar -m blaze.core"] diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..716033293 --- /dev/null +++ b/Makefile @@ -0,0 +1,50 @@ +VERSION = "0.7.0-alpha5" + +check: + clojure -A:check + +modules/cql/cql-test: + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlAggregateFunctionsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlArithmeticFunctionsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlComparisonOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlConditionalOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlDateTimeOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlErrorsAndMessagingOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlIntervalOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlListOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlLogicalOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlNullologicalOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlStringOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlTypeOperatorsTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlTypesTest.xml + wget -P modules/cql/cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/ValueLiteralsAndSelectors.xml + +test-cql: modules/cql/cql-test + cd modules/cql; clojure -A:test --profile :ci + +test-datomic: + cd modules/datomic; clojure -A:test --profile :ci + +test-interaction: + cd modules/interaction; clojure -A:test --profile :ci + +test-openid-auth: + cd modules/openid-auth; clojure -A:test --profile :ci + +test-operations-measure-evaluate-measure: + cd modules/operations/measure-evaluate-measure; clojure -A:test --profile :ci + +test-rest-api: + cd modules/rest-api; clojure -A:test --profile :ci + +test-rest-util: + cd modules/rest-util; clojure -A:test --profile :ci + +test: test-cql test-datomic test-interaction test-openid-auth test-operations-measure-evaluate-measure test-rest-api test-rest-util + clojure -A:test --profile :ci + +uberjar: + clojure -A:depstar -m hf.depstar.uberjar target/blaze-${VERSION}-standalone.jar + + +.PHONY: check test-cql test-datomic test-interaction test-openid-auth test-operations-measure-evaluate-measure test-rest-api test-rest-util test uberjar diff --git a/README.md b/README.md index b57ce3932..c59e29ba0 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,7 @@ The goal of this project is to provide a FHIR® Store with an internal CQL Evalu The project is currently under active development. Essentially all official [CQL Tests][3] pass. Please report any issues you encounter during evaluation. -Latest release: [v0.7.0-alpha2][5] +Latest release: [v0.7.0-alpha5][5] ## Quick Start @@ -23,14 +23,14 @@ In order to run Blaze with an in-memory, volatile database, just execute the fol ### Docker ```bash -docker run -p 8080:8080 liferesearch/blaze:0.7.0-alpha3 +docker run -p 8080:8080 liferesearch/blaze:0.7.0-alpha5 ``` ### Java ```bash -wget https://github.com/life-research/blaze/releases/download/v0.7.0-alpha2/blaze-0.7.0-alpha3-standalone.jar -java -jar blaze-0.7.0-alpha3-standalone.jar +wget https://github.com/life-research/blaze/releases/download/v0.7.0-alpha5/blaze-0.7.0-alpha5-standalone.jar +java -jar blaze-0.7.0-alpha5-standalone.jar ``` Logging output should appear which prints the most important settings and system parameters like Java version and available memory. @@ -56,4 +56,4 @@ your option) any later version. [2]: [3]: [4]: -[5]: +[5]: diff --git a/deps.edn b/deps.edn new file mode 100644 index 000000000..c4839c59d --- /dev/null +++ b/deps.edn @@ -0,0 +1,119 @@ +{:paths ["src" "resources"] + + :deps + {blaze/datomic + {:local/root "modules/datomic"} + + blaze/extern-terminology-service + {:local/root "modules/extern-terminology-service"} + + blaze/interaction + {:local/root "modules/interaction"} + + blaze.operation/measure-evaluate-measure + {:local/root "modules/operations/measure-evaluate-measure"} + + blaze/openid-auth + {:local/root "modules/openid-auth"} + + blaze/rest-api + {:local/root "modules/rest-api"} + + blaze/structure-definition + {:local/root "modules/structure-definition"} + + blaze/thread-pool-executor-collector + {:local/root "modules/thread-pool-executor-collector"} + + com.cognitect/anomalies + {:mvn/version "0.1.12"} + + com.datomic/datomic-free + {:mvn/version "0.9.5697" + :exclusions + [io.netty/netty-all]} + + com.h2database/h2 + {:mvn/version "1.4.199"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:git/url "https://github.com/alexanderkiel/integrant.git" + :sha "c673b85130e553feec6d4c5d2d1ec773a49c929c"} + + io.netty/netty-codec-http + {:mvn/version "4.1.39.Final"} + + io.netty/netty-handler-proxy + {:mvn/version "4.1.39.Final"} + + io.netty/netty-resolver-dns + {:mvn/version "4.1.39.Final"} + + io.netty/netty-transport-native-epoll$linux-x86_64 + {:mvn/version "4.1.39.Final"} + + io.prometheus/simpleclient_hotspot + {:mvn/version "0.6.0"} + + org.clojars.akiel/datomic-spec + {:mvn/version "0.5.2"} + + org.clojars.akiel/datomic-tools + {:mvn/version "0.4"} + + org.clojars.akiel/spec-coerce + {:mvn/version "0.4.0"} + + org.clojure/clojure + {:mvn/version "1.10.1"} + + org.clojure/tools.reader + {:mvn/version "1.3.2"} + + phrase + {:mvn/version "0.3-alpha3"} + + prom-metrics + {:mvn/version "0.5-alpha2"}} + + :aliases + {:depstar + {:extra-deps + {seancorfield/depstar + {:mvn/version "0.3.3"}}} + + :check + {:extra-deps + {athos/clj-check + {:git/url "https://github.com/athos/clj-check.git" + :sha "b48d4e7000586529f81c1e29069b503b57259514"}} + :main-opts + ["-m" "clj-check.check"]} + + :test + {:extra-paths ["dev" "test"] + + :extra-deps + {criterium + {:mvn/version "0.4.5"} + + lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/data.xml + {:mvn/version "0.0.8"} + + org.clojure/test.check + {:mvn/version "0.10.0"} + + org.clojure/tools.namespace + {:mvn/version "0.3.1"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/dev/blaze/dev.clj b/dev/blaze/dev.clj new file mode 100644 index 000000000..408882133 --- /dev/null +++ b/dev/blaze/dev.clj @@ -0,0 +1,40 @@ +(ns blaze.dev + (:require + [blaze.spec] + [blaze.system :as system] + [clojure.repl :refer [pst]] + [clojure.spec.test.alpha :as st] + [clojure.tools.namespace.repl :refer [refresh]] + [datomic-spec.test :as dst])) + + +;; Spec Instrumentation +(st/instrument) +(dst/instrument) + + +(defonce system nil) + + +(defn init [] + (alter-var-root #'system (constantly (system/init! (System/getenv)))) + nil) + + +(defn reset [] + (some-> system system/shutdown!) + (refresh :after `init)) + + +;; Init Development +(comment + (init) + (pst) + ) + + +;; Reset after making changes +(comment + (reset) + (st/unstrument) + ) diff --git a/dev/blaze/dev/datomic.clj b/dev/blaze/dev/datomic.clj new file mode 100644 index 000000000..4ad3c938a --- /dev/null +++ b/dev/blaze/dev/datomic.clj @@ -0,0 +1,29 @@ +(ns blaze.dev.datomic + (:require + [blaze.datomic.util :as datomic-util] + [blaze.dev :refer [system]] + [datomic.api :as d])) + + +(defn count-resources [db type] + (d/q '[:find (count ?e) . :in $ ?id :where [?e ?id]] db (datomic-util/resource-id-attr type))) + + +(comment + (def conn (::conn system)) + (def db (d/db conn)) + (def hdb (d/history db)) + + (count-resources (d/db conn) "Coding") + (count-resources (d/db conn) "Organization") + (count-resources (d/db conn) "Patient") + (count-resources (d/db conn) "Specimen") + (count-resources (d/db conn) "Observation") + + (d/pull (d/db conn) '[*] 1262239348687945) + (d/entity (d/db conn) [:Patient/id "0"]) + (d/q '[:find (pull ?e [*]) :where [?e :code/id]] (d/db conn)) + + (d/pull (d/db conn) '[*] (d/t->tx 1197)) + ) + diff --git a/dev/user.clj b/dev/user.clj deleted file mode 100644 index e9ce4880e..000000000 --- a/dev/user.clj +++ /dev/null @@ -1,133 +0,0 @@ -(ns user - (:require - [clojure.repl :refer [pst]] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.string :as str] - [clojure.tools.namespace.repl :refer [refresh]] - [criterium.core :refer [bench quick-bench]] - [datomic.api :as d] - [datomic-spec.test :as dst] - [env-tools.alpha :as env-tools] - [blaze.cql-translator :as cql] - [blaze.elm.compiler :as compiler] - [blaze.elm.deps-infer :as deps-infer] - [blaze.elm.evaluator :as evaluator] - [blaze.elm.equiv-relationships :as equiv-relationships] - [blaze.elm.literals] - [blaze.elm.normalizer :as normalizer] - [blaze.elm.type-infer :as type-infer] - [blaze.datomic.cql :as datomic-cql] - [blaze.datomic.pull] - [blaze.datomic.util :as datomic-util] - [blaze.spec] - [blaze.system :as system] - [prometheus.alpha :as prom] - [spec-coerce.alpha :refer [coerce]]) - (:import - [io.prometheus.client CollectorRegistry] - [java.time OffsetDateTime])) - - -;; Spec Instrumentation -(st/instrument) -(dst/instrument) - - -(defonce system nil) - -(defn init [] - (let [config (coerce :system/config (env-tools/build-config :system/config))] - (if (s/valid? :system/config config) - (alter-var-root #'system (constantly (system/init! config))) - (s/explain :system/config config)) - nil)) - -(defn reset [] - (system/shutdown! system) - (refresh :after 'user/init)) - -;; Init Development -(comment - (init) - (pst) - ) - -;; Reset after making changes -(comment - (reset) - (st/unstrument) - ) - - -(defn count-resources [db type] - (d/q '[:find (count ?e) . :in $ ?id :where [?e ?id]] db (datomic-util/resource-id-attr type))) - -(comment - - (def conn (:database-conn system)) - (def db (d/db conn)) - (def hdb (d/history db)) - - (count-resources (d/db conn) "Coding") - (count-resources (d/db conn) "Organization") - (count-resources (d/db conn) "Patient") - (count-resources (d/db conn) "Specimen") - (count-resources (d/db conn) "Observation") - - (d/pull (d/db conn) '[*] 1262239348687945) - (d/entity (d/db conn) [:Patient/id "0"]) - (d/q '[:find (pull ?e [*]) :where [?e :code/id]] (d/db conn)) - - (d/pull (d/db conn) '[*] (d/t->tx 1197)) - - ) - -(comment - - (def conn (d/connect "datomic:free://localhost:4334/dev-7?password=foo")) - (def db (d/db conn)) - (def now (OffsetDateTime/now)) - - (def library (cql/translate (slurp "queries/q1-patient-gender.cql"))) - - (-> library - normalizer/normalize-library - equiv-relationships/find-equiv-rels-library - deps-infer/infer-library-deps - type-infer/infer-library-types - ) - - (def expression-defs - (:life/compiled-expression-defs - (compiler/compile-library db library {}))) - - (time (into {} (filter (fn [[name]] (str/starts-with? name "Anzahl"))) @(evaluator/evaluate db now (compiler/compile-library db library {})))) - - (compiler/-hash (:life/expression (nth expression-defs 3))) - (pst) - - (dotimes [_ 10] - (time (into {} (filter (fn [[name]] (str/starts-with? name "Anzahl"))) - @(evaluator/evaluate db now expression-defs)))) - - (d/pull db '[{:Observation/_subject [*]}] [:Patient/id "1000"]) - - (.clear (CollectorRegistry/defaultRegistry)) - (.register (CollectorRegistry/defaultRegistry) compiler/evaluation-seconds) - (.register (CollectorRegistry/defaultRegistry) datomic-cql/call-seconds) - (prom/clear! compiler/evaluation-seconds) - (prom/clear! datomic-cql/call-seconds) - (println (:body (prom/dump-metrics))) - - ) - -;; Extract Codes from Code System -(comment - (mapcat - (fn [{:strs [code concept]}] - (if concept - (cons code (map #(get % "code") concept)) - [code])) - (cheshire.core/parse-string "")) - ) diff --git a/docker-compose.yml b/docker-compose.yml index 2265f2023..2714071f8 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -11,7 +11,7 @@ services: volumes: - "db-data:/data" store: - image: "liferesearch/blaze:0.7.0-alpha3" + image: "liferesearch/blaze:0.7.0-alpha5" environment: BASE_URL: "http://localhost:8080" DATABASE_URI: "datomic:free://db:4334/dev?password=datomic" diff --git a/docs/index.adoc b/docs/index.adoc index 5e3a3d842..3bd62cbb3 100644 --- a/docs/index.adoc +++ b/docs/index.adoc @@ -69,15 +69,15 @@ You can change the data dir in the properties file if you like to have it at a d ==== Install Blaze Blaze runs on the JVM and comes as single JAR file. -Download the most recent version https://github.com/life-research/blaze/releases/tag/v0.7.0-alpha2[here]. -Look for `blaze-0.7.0-alpha3-standalone.jar`. +Download the most recent version https://github.com/life-research/blaze/releases/tag/v0.7.0-alpha5[here]. +Look for `blaze-0.7.0-alpha5-standalone.jar`. In addition to the JAR file, Blaze needs a set of FHIR® structure definitions to build it's database schema. Please download and unpack the `fhir.zip` from the same location. After the download, you can start blaze with the following command (Linux, MacOS): ``` -DATABASE_URI=datomic:free://localhost:4334/db java -server -Xms2g -Xmx2g -XX:+UseG1GC -jar blaze-0.7.0-alpha3-standalone.jar +DATABASE_URI=datomic:free://localhost:4334/db java -server -Xms2g -Xmx2g -XX:+UseG1GC -jar blaze-0.7.0-alpha5-standalone.jar ``` Under Windows you need to set the Environment variables in the PowerShell before starting Blaze: diff --git a/fetch-cql-tests.sh b/fetch-cql-tests.sh deleted file mode 100755 index 1a478cb0f..000000000 --- a/fetch-cql-tests.sh +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/env bash - -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlAggregateFunctionsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlArithmeticFunctionsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlComparisonOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlConditionalOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlDateTimeOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlErrorsAndMessagingOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlIntervalOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlListOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlLogicalOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlNullologicalOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlStringOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlTypeOperatorsTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/CqlTypesTest.xml -wget -P cql-test -q https://raw.githubusercontent.com/HL7/cql/v1.4-ballot/tests/cql/ValueLiteralsAndSelectors.xml diff --git a/modules/anomaly/deps.edn b/modules/anomaly/deps.edn new file mode 100644 index 000000000..0ee3d4546 --- /dev/null +++ b/modules/anomaly/deps.edn @@ -0,0 +1,3 @@ +{:deps + {com.cognitect/anomalies + {:mvn/version "0.1.12"}}} diff --git a/modules/anomaly/src/blaze/anomaly.clj b/modules/anomaly/src/blaze/anomaly.clj new file mode 100644 index 000000000..569eba93a --- /dev/null +++ b/modules/anomaly/src/blaze/anomaly.clj @@ -0,0 +1,23 @@ +(ns blaze.anomaly + (:require + [clojure.spec.alpha :as s] + [cognitect.anomalies :as anom])) + + +(s/fdef throw-anom + :args + (s/cat + :category ::anom/category + :message ::anom/message + :kvs (s/* (s/cat :k keyword? :v some?)))) + +(defn throw-anom + "Throws an `ex-info` with `message` and an anomaly build from `kvs`, + `category` and `message` as data." + [category message & {:as kvs}] + (throw + (ex-info + message + (assoc kvs + ::anom/category category + ::anom/message message)))) diff --git a/modules/cql/.gitignore b/modules/cql/.gitignore new file mode 100644 index 000000000..4c566a797 --- /dev/null +++ b/modules/cql/.gitignore @@ -0,0 +1 @@ +cql-test diff --git a/modules/cql/deps.edn b/modules/cql/deps.edn new file mode 100644 index 000000000..3e5b4ccc9 --- /dev/null +++ b/modules/cql/deps.edn @@ -0,0 +1,58 @@ +{:paths ["src" "resources"] + + :deps + {blaze/datomic + {:local/root "../datomic"} + + camel-snake-kebab + {:mvn/version "0.4.0"} + + info.cqframework/cql-to-elm + {:mvn/version "1.4.6" + :exclusions + [com.google.code.javaparser/javaparser + org.eclipse.persistence/eclipselink + info.cqframework/qdm + junit + xpp3 + xpp3/xpp3_xpath + org.antlr/antlr4]} + + javax.measure/unit-api + {:mvn/version "1.0"} + + javax.xml.bind/jaxb-api + {:mvn/version "2.4.0-b180830.0359"} + + org.antlr/antlr4-runtime + {:mvn/version "4.5" + :exclusions [org.abego.treelayout/org.abego.treelayout.core]} + + org.eclipse.persistence/org.eclipse.persistence.moxy + {:mvn/version "2.7.4"} + + systems.uom/systems-quantity + {:mvn/version "1.0"} + + systems.uom/systems-ucum + {:mvn/version "0.9"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/data.xml + {:mvn/version "0.0.8"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/resources/blaze/fhir-modelinfo-4.0.0.xml b/modules/cql/resources/blaze/fhir-modelinfo-4.0.0.xml similarity index 100% rename from resources/blaze/fhir-modelinfo-4.0.0.xml rename to modules/cql/resources/blaze/fhir-modelinfo-4.0.0.xml diff --git a/resources/org/hl7/elm_modelinfo/r1/jaxb.properties b/modules/cql/resources/org/hl7/elm_modelinfo/r1/jaxb.properties similarity index 100% rename from resources/org/hl7/elm_modelinfo/r1/jaxb.properties rename to modules/cql/resources/org/hl7/elm_modelinfo/r1/jaxb.properties diff --git a/src/blaze/cql_translator.clj b/modules/cql/src/blaze/cql_translator.clj similarity index 100% rename from src/blaze/cql_translator.clj rename to modules/cql/src/blaze/cql_translator.clj diff --git a/src/blaze/elm/aggregates.clj b/modules/cql/src/blaze/elm/aggregates.clj similarity index 100% rename from src/blaze/elm/aggregates.clj rename to modules/cql/src/blaze/elm/aggregates.clj diff --git a/src/blaze/elm/boolean.clj b/modules/cql/src/blaze/elm/boolean.clj similarity index 100% rename from src/blaze/elm/boolean.clj rename to modules/cql/src/blaze/elm/boolean.clj diff --git a/src/blaze/elm/compiler.clj b/modules/cql/src/blaze/elm/compiler.clj similarity index 97% rename from src/blaze/elm/compiler.clj rename to modules/cql/src/blaze/elm/compiler.clj index d168e851f..7e5d8d436 100644 --- a/src/blaze/elm/compiler.clj +++ b/modules/cql/src/blaze/elm/compiler.clj @@ -10,11 +10,7 @@ Every local (without time zone) date or time is meant relative to the time zone of the :now timestamp in the evaluation context." (:require - [camel-snake-kebab.core :refer [->kebab-case-string ->camelCaseString]] - [clojure.spec.alpha :as s] - [clojure.string :as str] - [cognitect.anomalies :as anom] - [datomic-spec.core :as ds] + [blaze.anomaly :refer [throw-anom]] [blaze.elm.compiler.function :as function] [blaze.elm.compiler.protocols :refer [Expression -eval -hash]] [blaze.elm.compiler.property :as property] @@ -30,7 +26,7 @@ [blaze.elm.deps-infer :refer [infer-library-deps]] [blaze.elm.equiv-relationships :refer [find-equiv-rels-library]] [blaze.elm.integer] - [blaze.elm.interval :refer [interval interval?]] + [blaze.elm.interval :refer [interval]] [blaze.elm.list] [blaze.elm.nil] [blaze.elm.normalizer :refer [normalize-library]] @@ -40,7 +36,10 @@ [blaze.elm.string :as string] [blaze.elm.type-infer :refer [infer-library-types]] [blaze.elm.util :as elm-util] - [blaze.util :as u :refer [throw-anom]]) + [clojure.spec.alpha :as s] + [cognitect.anomalies :as anom] + [cuerdas.core :as str] + [datomic-spec.core :as ds]) (:import [java.time LocalDate LocalDateTime OffsetDateTime Year YearMonth ZoneOffset] [java.time.temporal ChronoUnit Temporal] @@ -104,7 +103,7 @@ "Compiles `expression`." {:arglists '([context expression])} (fn [_ {:keys [type]}] - (keyword "elm.compiler.type" (->kebab-case-string type)))) + (keyword "elm.compiler.type" (str/kebab type)))) (defmethod compile* :default @@ -206,7 +205,7 @@ (defn- record-name [s] - (str (u/title-case (->camelCaseString (name s))) "OperatorExpression")) + (str (str/capital (str/camel (name s))) "OperatorExpression")) (defmacro defunop @@ -329,7 +328,7 @@ (defn- to-chrono-unit [precision] - (case (str/lower-case precision) + (case (str/lower precision) "year" ChronoUnit/YEARS "month" ChronoUnit/MONTHS "week" ChronoUnit/WEEKS @@ -387,14 +386,6 @@ :operands (-hash operand#)}))))) -(defn- literal? [x] - (or (boolean? x) - (number? x) - (string? x) - (instance? Temporal x) - (instance? Quantity x))) - - (defn- append-locator [msg locator] (if locator (str msg " " locator ".") @@ -510,9 +501,9 @@ (if-let [attr (property/attr expression)] (choice-type-expr context source scope attr) (throw-anom - {::anom/category ::anom/unsupported - ::anom/message "Unsupported choice-type, runtime-type expression." - :expression expression})) + ::anom/unsupported + "Unsupported choice-type, runtime-type expression." + :expression expression)) (if-let [attr (property/attr expression)] (property-expr context source scope attr) (runtime-type-property-expr context source scope path)))) @@ -553,7 +544,7 @@ (when-let [{code-system-ref :codeSystem code :id :as code-def} (find-code-def library name)] (if code-system-ref - (when-let [{:keys [version] system :id} (compile context (assoc code-system-ref :type "CodeSystemRef"))] + (when-let [{system :id} (compile context (assoc code-system-ref :type "CodeSystemRef"))] ;; TODO: version (cql/find-code db system code)) (throw (ex-info "Can't handle code-defs without code-system-ref." @@ -732,14 +723,14 @@ :as expr}] (when (seq (filter #(= "With" (:type %)) relationships)) (throw-anom - {::anom/category ::anom/unsupported - ::anom/message "Unsupported With clause in query expression." - :expression expr})) + ::anom/unsupported + "Unsupported With clause in query expression." + :expression expr)) (when (seq (filter #(= "Without" (:type %)) relationships)) (throw-anom - {::anom/category ::anom/unsupported - ::anom/message "Unsupported Without clause in query expression." - :expression expr})) + ::anom/unsupported + "Unsupported Without clause in query expression." + :expression expr)) (if (= 1 (count sources)) (let [{:keys [expression alias]} (first sources) context (dissoc context :optimizations) @@ -807,7 +798,6 @@ ;; The With clause restricts the elements of a given source to only those ;; elements that have elements in the related source that satisfy the suchThat ;; condition. This operation is known as a semi-join in database languages. -;; condition. This operation is known as a semi-join in database languages. (defn- find-operand-with-alias "Finds the operand in `expression` that accesses entities with `alias`." [operands alias] @@ -1371,7 +1361,7 @@ ;; 17.9. Lower (defunop lower [s] - (some-> s str/lower-case)) + (str/lower s)) ;; 17.10. Matches @@ -1483,7 +1473,7 @@ ;; 17.18. Upper (defunop upper [s] - (some-> s str/upper-case)) + (str/upper s)) @@ -1928,7 +1918,7 @@ ;; 19.4. Collapse -(defbinop collapse [source per] +(defbinop collapse [source _] (when source (let [source (sort-by :start (remove nil? source))] (reverse @@ -2457,10 +2447,9 @@ :else (throw-anom - {::anom/category ::anom/unsupported - ::anom/message - (format "Unsupported FHIR type `%s` in As expression." type-name) - :type-name type-name}))) + ::anom/unsupported + (format "Unsupported FHIR type `%s` in As expression." type-name) + :type-name type-name))) (defn- matches-elm-named-type-fn [type-name] @@ -2470,10 +2459,9 @@ "DateTime" temporal? "Quantity" quantity? (throw-anom - {::anom/category ::anom/unsupported - ::anom/message - (format "Unsupported ELM type `%s` in As expression." type-name) - :type-name type-name}))) + ::anom/unsupported + (format "Unsupported ELM type `%s` in As expression." type-name) + :type-name type-name))) (defn- matches-named-type-fn [type-name] @@ -2484,10 +2472,9 @@ "urn:hl7-org:elm-types:r1" (matches-elm-named-type-fn type-name) (throw-anom - {::anom/category ::anom/unsupported - ::anom/message - (format "Unsupported type namespace `%s` in As expression." type-ns) - :type-ns type-ns})))) + ::anom/unsupported + (format "Unsupported type namespace `%s` in As expression." type-ns) + :type-ns type-ns)))) (defn- matches-type-specifier-fn [as-type-specifier] @@ -2501,10 +2488,10 @@ (every? pred x))) (throw-anom - {::anom/category ::anom/unsupported - ::anom/message - (format "Unsupported type specifier type `%s` in As expression." (:type as-type-specifier)) - :type-specifier-type (:type as-type-specifier)}))) + ::anom/unsupported + (format "Unsupported type specifier type `%s` in As expression." + (:type as-type-specifier)) + :type-specifier-type (:type as-type-specifier)))) (defn- matches-type-fn @@ -2518,9 +2505,9 @@ :else (throw-anom - {::anom/category ::anom/fault - ::anom/message "Invalid As expression without `as-type` and `as-type-specifier`." - :expression expression}))) + ::anom/fault + "Invalid As expression without `as-type` and `as-type-specifier`." + :expression expression))) (defmethod compile* :elm.compiler.type/as diff --git a/src/blaze/elm/compiler/function.clj b/modules/cql/src/blaze/elm/compiler/function.clj similarity index 92% rename from src/blaze/elm/compiler/function.clj rename to modules/cql/src/blaze/elm/compiler/function.clj index 13b2cb194..db872c3a6 100644 --- a/src/blaze/elm/compiler/function.clj +++ b/modules/cql/src/blaze/elm/compiler/function.clj @@ -1,6 +1,6 @@ (ns blaze.elm.compiler.function (:require - [blaze.elm.compiler.protocols :refer [Expression -eval expr?]] + [blaze.elm.compiler.protocols :refer [Expression -eval]] [blaze.elm.protocols :as p])) diff --git a/src/blaze/elm/compiler/property.clj b/modules/cql/src/blaze/elm/compiler/property.clj similarity index 93% rename from src/blaze/elm/compiler/property.clj rename to modules/cql/src/blaze/elm/compiler/property.clj index f0e880d0c..633512d0b 100644 --- a/src/blaze/elm/compiler/property.clj +++ b/modules/cql/src/blaze/elm/compiler/property.clj @@ -1,11 +1,11 @@ (ns blaze.elm.compiler.property (:require + [blaze.anomaly :refer [throw-anom]] [blaze.datomic.util :as datomic-util] [blaze.datomic.value :as dv] [blaze.elm.compiler.protocols :refer [Expression -eval expr?]] [blaze.elm.spec] [blaze.elm.util :as elm-util] - [blaze.util :refer [throw-anom]] [clojure.spec.alpha :as s] [clojure.string :as str] [cognitect.anomalies :as anom])) @@ -48,12 +48,11 @@ (if (= "http://hl7.org/fhir" type-ns) (attr-kw type-name path) (throw-anom - {::anom/category ::anom/unsupported - ::anom/message - (format - "Unsupported source type namespace `%s` in property expression with path `%s`." - type-ns path) - :expression expr}))) + ::anom/unsupported + (format + "Unsupported source type namespace `%s` in property expression with path `%s`." + type-ns path) + :expression expr))) source (let [{type-specifier :resultTypeSpecifier type-name :resultTypeName} source] @@ -73,7 +72,8 @@ Expression (-eval [_ context resource scope] (let [value (-eval source context resource scope)] - (dv/read ((type-attr value) value))))) + (when-let [type-attr (type-attr value)] + (dv/read (type-attr value)))))) (s/fdef source-choice-type-expr diff --git a/src/blaze/elm/compiler/protocols.clj b/modules/cql/src/blaze/elm/compiler/protocols.clj similarity index 100% rename from src/blaze/elm/compiler/protocols.clj rename to modules/cql/src/blaze/elm/compiler/protocols.clj diff --git a/src/blaze/elm/compiler/query.clj b/modules/cql/src/blaze/elm/compiler/query.clj similarity index 100% rename from src/blaze/elm/compiler/query.clj rename to modules/cql/src/blaze/elm/compiler/query.clj diff --git a/src/blaze/elm/compiler/retrieve.clj b/modules/cql/src/blaze/elm/compiler/retrieve.clj similarity index 94% rename from src/blaze/elm/compiler/retrieve.clj rename to modules/cql/src/blaze/elm/compiler/retrieve.clj index b65d5845f..2c684bfd8 100644 --- a/src/blaze/elm/compiler/retrieve.clj +++ b/modules/cql/src/blaze/elm/compiler/retrieve.clj @@ -1,7 +1,7 @@ (ns blaze.elm.compiler.retrieve (:require + [blaze.anomaly :refer [throw-anom]] [blaze.elm.compiler.protocols :refer [Expression -eval expr?]] - [blaze.util :refer [throw-anom]] [clojure.spec.alpha :as s] [cognitect.anomalies :as anom] [datomic.api :as d] @@ -52,8 +52,8 @@ (if-let [attr-id (d/entid db (keyword ns code-id))] (->AttrRetrieveExpression attr-id) (throw-anom - {::anom/category ::anom/fault - ::anom/message (str "Missing Datomic attribute: " (keyword ns code-id))})))) + ::anom/fault + (str "Missing Datomic attribute: " (keyword ns code-id)))))) (defrecord MultipleCodeRetrieveExpression [exprs] diff --git a/src/blaze/elm/data_provider.clj b/modules/cql/src/blaze/elm/data_provider.clj similarity index 59% rename from src/blaze/elm/data_provider.clj rename to modules/cql/src/blaze/elm/data_provider.clj index 0ea3fb6c7..00be8d488 100644 --- a/src/blaze/elm/data_provider.clj +++ b/modules/cql/src/blaze/elm/data_provider.clj @@ -1,6 +1,4 @@ -(ns blaze.elm.data-provider - (:require - [clojure.spec.alpha :as s])) +(ns blaze.elm.data-provider) (defprotocol DataProvider diff --git a/src/blaze/elm/date_time.clj b/modules/cql/src/blaze/elm/date_time.clj similarity index 97% rename from src/blaze/elm/date_time.clj rename to modules/cql/src/blaze/elm/date_time.clj index 8b44e0e2c..fc626c86e 100644 --- a/src/blaze/elm/date_time.clj +++ b/modules/cql/src/blaze/elm/date_time.clj @@ -622,7 +622,7 @@ (same-as [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 0 (precision-num other))) + (when (<= p-num (min 0 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (= cmp 0))) (p/equal this other)))) @@ -631,7 +631,7 @@ (same-as [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 1 (precision-num other))) + (when (<= p-num (min 1 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (= cmp 0))) (p/equal this other)))) @@ -640,7 +640,7 @@ (same-as [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 2 (precision-num other))) + (when (<= p-num (min 2 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (= cmp 0))) (p/equal this other)))) @@ -649,7 +649,7 @@ (same-as [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 6 (precision-num other))) + (when (<= p-num (min 6 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (= cmp 0))) (p/equal this other)))) @@ -658,7 +658,7 @@ (same-as [this other precision] (when (instance? PrecisionLocalTime other) (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min (:p-num this) (:p-num other))) + (when (<= p-num (min (:p-num this) (:p-num other))) (when-let [cmp (compare-to-precision (:local-time this) (:local-time other) p-num p-num 3)] (= cmp 0))) @@ -671,7 +671,7 @@ (same-or-before [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 0 (precision-num other))) + (when (<= p-num (min 0 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (<= cmp 0))) (p/less-or-equal this other)))) @@ -680,7 +680,7 @@ (same-or-before [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 1 (precision-num other))) + (when (<= p-num (min 1 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (<= cmp 0))) (p/less-or-equal this other)))) @@ -689,7 +689,7 @@ (same-or-before [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 2 (precision-num other))) + (when (<= p-num (min 2 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (<= cmp 0))) (p/less-or-equal this other)))) @@ -698,7 +698,7 @@ (same-or-before [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 6 (precision-num other))) + (when (<= p-num (min 6 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (<= cmp 0))) (p/less-or-equal this other)))) @@ -707,7 +707,7 @@ (same-or-before [this other precision] (when (instance? PrecisionLocalTime other) (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min (:p-num this) (:p-num other))) + (when (<= p-num (min (:p-num this) (:p-num other))) (when-let [cmp (compare-to-precision (:local-time this) (:local-time other) p-num p-num 3)] (<= cmp 0))) @@ -720,7 +720,7 @@ (same-or-after [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 0 (precision-num other))) + (when (<= p-num (min 0 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (>= cmp 0))) (p/greater-or-equal this other)))) @@ -729,7 +729,7 @@ (same-or-after [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 1 (precision-num other))) + (when (<= p-num (min 1 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (>= cmp 0))) (p/greater-or-equal this other)))) @@ -738,7 +738,7 @@ (same-or-after [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 2 (precision-num other))) + (when (<= p-num (min 2 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (>= cmp 0))) (p/greater-or-equal this other)))) @@ -747,7 +747,7 @@ (same-or-after [this other precision] (when other (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min 6 (precision-num other))) + (when (<= p-num (min 6 (precision-num other))) (when-let [cmp (compare-to-precision this other p-num p-num)] (>= cmp 0))) (p/greater-or-equal this other)))) @@ -756,7 +756,7 @@ (same-or-after [this other precision] (when (instance? PrecisionLocalTime other) (if-let [p-num (some-> precision precision->p-num)] - (if (<= p-num (min (:p-num this) (:p-num other))) + (when (<= p-num (min (:p-num this) (:p-num other))) (when-let [cmp (compare-to-precision (:local-time this) (:local-time other) p-num p-num 3)] (>= cmp 0))) diff --git a/src/blaze/elm/decimal.clj b/modules/cql/src/blaze/elm/decimal.clj similarity index 100% rename from src/blaze/elm/decimal.clj rename to modules/cql/src/blaze/elm/decimal.clj diff --git a/src/blaze/elm/deps_infer.clj b/modules/cql/src/blaze/elm/deps_infer.clj similarity index 100% rename from src/blaze/elm/deps_infer.clj rename to modules/cql/src/blaze/elm/deps_infer.clj diff --git a/src/blaze/elm/equiv_relationships.clj b/modules/cql/src/blaze/elm/equiv_relationships.clj similarity index 100% rename from src/blaze/elm/equiv_relationships.clj rename to modules/cql/src/blaze/elm/equiv_relationships.clj diff --git a/src/blaze/elm/evaluator.clj b/modules/cql/src/blaze/elm/evaluator.clj similarity index 95% rename from src/blaze/elm/evaluator.clj rename to modules/cql/src/blaze/elm/evaluator.clj index d4bfc9087..2028bfbcb 100644 --- a/src/blaze/elm/evaluator.clj +++ b/modules/cql/src/blaze/elm/evaluator.clj @@ -7,7 +7,7 @@ [cognitect.anomalies :as anom] [datomic-spec.core :as ds] [blaze.elm.compiler.protocols :refer [Expression -eval]] - [manifold.deferred :as md] + [manifold.deferred :as md :refer [deferred?]] [prometheus.alpha :as prom :refer [defhistogram]] [taoensso.timbre :as log]) (:import @@ -63,7 +63,7 @@ (defn- create-expression - [name expression deps deferred-intermediate-results] + [_ expression deps deferred-intermediate-results] (if (empty? deps) expression (reify Expression @@ -161,9 +161,12 @@ (s/fdef evaluate - :args (s/cat :db ::ds/db :now #(instance? OffsetDateTime %) - :compiled-library :life/compiled-library) - :ret md/deferred?) + :args + (s/cat + :db ::ds/db + :now #(instance? OffsetDateTime %) + :compiled-library :life/compiled-library) + :ret deferred?) (defn evaluate "Returns an error-deferred with an anomaly on evaluation errors." diff --git a/src/blaze/elm/integer.clj b/modules/cql/src/blaze/elm/integer.clj similarity index 100% rename from src/blaze/elm/integer.clj rename to modules/cql/src/blaze/elm/integer.clj diff --git a/src/blaze/elm/interval.clj b/modules/cql/src/blaze/elm/interval.clj similarity index 100% rename from src/blaze/elm/interval.clj rename to modules/cql/src/blaze/elm/interval.clj diff --git a/src/blaze/elm/list.clj b/modules/cql/src/blaze/elm/list.clj similarity index 97% rename from src/blaze/elm/list.clj rename to modules/cql/src/blaze/elm/list.clj index db4cb998c..b6a501ffc 100644 --- a/src/blaze/elm/list.clj +++ b/modules/cql/src/blaze/elm/list.clj @@ -1,8 +1,7 @@ (ns blaze.elm.list "Implementation of the list type." (:require - [blaze.elm.protocols :as p] - [clojure.set :as set]) + [blaze.elm.protocols :as p]) (:import [clojure.lang PersistentVector])) diff --git a/src/blaze/elm/nil.clj b/modules/cql/src/blaze/elm/nil.clj similarity index 100% rename from src/blaze/elm/nil.clj rename to modules/cql/src/blaze/elm/nil.clj diff --git a/src/blaze/elm/normalizer.clj b/modules/cql/src/blaze/elm/normalizer.clj similarity index 100% rename from src/blaze/elm/normalizer.clj rename to modules/cql/src/blaze/elm/normalizer.clj diff --git a/src/blaze/elm/protocols.clj b/modules/cql/src/blaze/elm/protocols.clj similarity index 100% rename from src/blaze/elm/protocols.clj rename to modules/cql/src/blaze/elm/protocols.clj diff --git a/src/blaze/elm/quantity.clj b/modules/cql/src/blaze/elm/quantity.clj similarity index 100% rename from src/blaze/elm/quantity.clj rename to modules/cql/src/blaze/elm/quantity.clj diff --git a/src/blaze/elm/spec.clj b/modules/cql/src/blaze/elm/spec.clj similarity index 99% rename from src/blaze/elm/spec.clj rename to modules/cql/src/blaze/elm/spec.clj index 297dadc57..b1e94af8c 100644 --- a/src/blaze/elm/spec.clj +++ b/modules/cql/src/blaze/elm/spec.clj @@ -4,7 +4,6 @@ [clojure.set :as set] [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] - [clojure.string :as str] [blaze.elm.quantity :refer [print-unit]]) (:import [java.time LocalDate] diff --git a/src/blaze/elm/string.clj b/modules/cql/src/blaze/elm/string.clj similarity index 100% rename from src/blaze/elm/string.clj rename to modules/cql/src/blaze/elm/string.clj diff --git a/src/blaze/elm/type_infer.clj b/modules/cql/src/blaze/elm/type_infer.clj similarity index 100% rename from src/blaze/elm/type_infer.clj rename to modules/cql/src/blaze/elm/type_infer.clj diff --git a/src/blaze/elm/util.clj b/modules/cql/src/blaze/elm/util.clj similarity index 100% rename from src/blaze/elm/util.clj rename to modules/cql/src/blaze/elm/util.clj diff --git a/test/blaze/cql_test.clj b/modules/cql/test/blaze/cql_test.clj similarity index 99% rename from test/blaze/cql_test.clj rename to modules/cql/test/blaze/cql_test.clj index 3aa55dbef..66e08abac 100644 --- a/test/blaze/cql_test.clj +++ b/modules/cql/test/blaze/cql_test.clj @@ -4,7 +4,7 @@ [clojure.data.xml :as xml] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :refer [deftest is testing use-fixtures]] [cognitect.anomalies :as anom] [blaze.cql-translator :refer [translate]] [blaze.elm.compiler :refer [compile]] diff --git a/test/blaze/cql_translator_test.clj b/modules/cql/test/blaze/cql_translator_test.clj similarity index 83% rename from test/blaze/cql_translator_test.clj rename to modules/cql/test/blaze/cql_translator_test.clj index 713dacfd8..7e3c40229 100644 --- a/test/blaze/cql_translator_test.clj +++ b/modules/cql/test/blaze/cql_translator_test.clj @@ -1,8 +1,12 @@ (ns blaze.cql-translator-test (:require - [clojure.test :refer :all] - [juxt.iota :refer [given]] - [blaze.cql-translator :refer [translate]])) + [blaze.cql-translator :refer [translate]] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [deftest testing]] + [juxt.iota :refer [given]])) + + +(st/instrument) (defmacro given-translation [cql & body] diff --git a/test/blaze/elm/compiler/property_test.clj b/modules/cql/test/blaze/elm/compiler/property_test.clj similarity index 71% rename from test/blaze/elm/compiler/property_test.clj rename to modules/cql/test/blaze/elm/compiler/property_test.clj index 5e1802f1a..f45f87176 100644 --- a/test/blaze/elm/compiler/property_test.clj +++ b/modules/cql/test/blaze/elm/compiler/property_test.clj @@ -1,9 +1,12 @@ (ns blaze.elm.compiler.property-test (:require - [blaze.datomic.test-util :as datomic-test-util] - [blaze.elm.compiler.property :refer :all] + [blaze.datomic.util :as datomic-util] + [blaze.elm.compiler.property + :refer [attr scope-expr scope-runtime-type-expr]] [blaze.elm.compiler.protocols :refer [-eval]] - [clojure.test :refer :all])) + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [are deftest is]])) (deftest attr-test @@ -45,9 +48,21 @@ "foo"))) +(defn stub-entity-type [entity type] + (st/instrument + [`datomic-util/entity-type] + {:spec + {`datomic-util/entity-type + (s/fspec + :args (s/cat :resource #{entity}) + :ret #{type})} + :stub + #{`datomic-util/entity-type}})) + + (deftest scope-runtime-type-expr-test (let [entity {:CodeableConcept/coding "foo"}] - (datomic-test-util/stub-entity-type entity "CodeableConcept") + (stub-entity-type entity "CodeableConcept") (is (= (-eval diff --git a/test/blaze/elm/compiler/retrieve_test.clj b/modules/cql/test/blaze/elm/compiler/retrieve_test.clj similarity index 68% rename from test/blaze/elm/compiler/retrieve_test.clj rename to modules/cql/test/blaze/elm/compiler/retrieve_test.clj index 1e26260f0..4be65f6ce 100644 --- a/test/blaze/elm/compiler/retrieve_test.clj +++ b/modules/cql/test/blaze/elm/compiler/retrieve_test.clj @@ -1,11 +1,12 @@ (ns blaze.elm.compiler.retrieve-test (:require - [blaze.datomic.test-util :as datomic-test-util] - [blaze.elm.compiler.protocols :refer [Expression -eval]] - [blaze.elm.compiler.retrieve :refer :all] + [blaze.elm.compiler.protocols :refer [-eval]] + [blaze.elm.compiler.retrieve + :refer [context-expr multiple-code-expr single-code-expr]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all]) + [clojure.test :refer [deftest is testing]] + [datomic.api :as d]) (:import [datomic Datom])) @@ -16,13 +17,48 @@ (st/unstrument)) +(defn stub-entid [db ident eid] + (st/instrument + [`d/entid] + {:spec + {`d/entid + (s/fspec + :args (s/cat :db #{db} :ident #{ident}) + :ret #{eid})} + :stub + #{`d/entid}})) + + +(defn stub-datoms [db index components-spec replace-fn] + (st/instrument + [`d/datoms] + {:spec + {`d/datoms + (s/fspec + :args (s/cat :db #{db} :index #{index} :components components-spec))} + :replace + {`d/datoms replace-fn}})) + + +(defn stub-entity [db eid-spec entity-spec] + (st/instrument + [`d/entity] + {:spec + {`d/entity + (s/fspec + :args (s/cat :db #{db} :eid eid-spec) + :ret entity-spec)} + :stub + #{`d/entity}})) + + (deftest single-code-expr-test (st/unstrument `single-code-expr) - (datomic-test-util/stub-entid ::db :Patient.Observation.code/code-id 42) - (datomic-test-util/stub-datoms + (stub-entid ::db :Patient.Observation.code/code-id 42) + (stub-datoms ::db :eavt (s/cat :e #{::patient-eid} :a #{42}) (constantly [(reify Datom (v [_] ::observation-eid))])) - (datomic-test-util/stub-entity ::db #{::observation-eid} #{::observation}) + (stub-entity ::db #{::observation-eid} #{::observation}) (is (= @@ -83,11 +119,11 @@ (st/unstrument `context-expr) (testing "Observation in Patient Context" - (datomic-test-util/stub-entid ::db :Observation/subject 42) - (datomic-test-util/stub-datoms + (stub-entid ::db :Observation/subject 42) + (stub-datoms ::db :vaet (s/cat :v #{::patient-eid} :a #{42}) (constantly [(reify Datom (e [_] ::observation-eid))])) - (datomic-test-util/stub-entity ::db #{::observation-eid} #{::observation}) + (stub-entity ::db #{::observation-eid} #{::observation}) (is (= @@ -99,11 +135,11 @@ [::observation]))) (testing "Patient in Specimen Context" - (datomic-test-util/stub-entid ::db :Specimen/subject 42) - (datomic-test-util/stub-datoms + (stub-entid ::db :Specimen/subject 42) + (stub-datoms ::db :eavt (s/cat :e #{::specimen-eid} :a #{42}) (constantly [(reify Datom (v [_] ::patient-eid))])) - (datomic-test-util/stub-entity ::db #{::patient-eid} #{::patient}) + (stub-entity ::db #{::patient-eid} #{::patient}) (is (= @@ -115,11 +151,11 @@ [::patient]))) (testing "Observation in Specimen Context" - (datomic-test-util/stub-entid ::db :Observation/specimen 42) - (datomic-test-util/stub-datoms + (stub-entid ::db :Observation/specimen 42) + (stub-datoms ::db :vaet (s/cat :v #{::specimen-eid} :a #{42}) (constantly [(reify Datom (e [_] ::observation-eid))])) - (datomic-test-util/stub-entity ::db #{::observation-eid} #{::observation}) + (stub-entity ::db #{::observation-eid} #{::observation}) (is (= diff --git a/test/blaze/elm/compiler_test.clj b/modules/cql/test/blaze/elm/compiler_test.clj similarity index 99% rename from test/blaze/elm/compiler_test.clj rename to modules/cql/test/blaze/elm/compiler_test.clj index 79e4b0cb8..9d3009fdb 100644 --- a/test/blaze/elm/compiler_test.clj +++ b/modules/cql/test/blaze/elm/compiler_test.clj @@ -2,22 +2,21 @@ "Section numbers are according to https://cql.hl7.org/04-logicalspecification.html." (:require - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] - [clojure.test.check.properties :as prop] [blaze.datomic.cql :as cql] - [blaze.datomic.cql-test :as cql-test] - [blaze.datomic.test-util :as datomic-test-util] + [blaze.datomic.util :as datomic-util] [blaze.elm.compiler :refer [compile compile-with-equiv-clause]] - [blaze.elm.compiler.protocols :refer [Expression -eval -hash]] + [blaze.elm.compiler.protocols :refer [-eval]] [blaze.elm.compiler.retrieve-test :as retrieve-test] [blaze.elm.date-time :refer [local-time local-time? period]] [blaze.elm.decimal :as decimal] [blaze.elm.interval :refer [interval]] [blaze.elm.literals :as elm] [blaze.elm.quantity :refer [quantity]] - [blaze.test-util :refer [satisfies-prop]]) + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [are deftest is testing use-fixtures]] + [clojure.test.check :as tc] + [clojure.test.check.properties :as prop]) (:import [blaze.elm.date_time Period] [clojure.core Eduction] @@ -47,6 +46,15 @@ (use-fixtures :each fixture) +(defmacro satisfies-prop [num-tests prop] + `(let [result# (tc/quick-check ~num-tests ~prop)] + (if (instance? Throwable (:result result#)) + (throw (:result result#)) + (if (true? (:result result#)) + (is :success) + (is (clojure.pprint/pprint result#)))))) + + (def now (OffsetDateTime/now (ZoneOffset/ofHours 0))) @@ -160,12 +168,23 @@ ;; 3. Clinical Values +(defn stub-find-code [db system code res-spec] + (st/instrument + `cql/find-code + {:spec + {`cql/find-code + (s/fspec + :args (s/cat :db #{db} :system #{system} :code #{code}) + :ret res-spec)} + :stub #{`cql/find-code}})) + + ;; 3.1. Code ;; ;; The Code type represents a literal code selector. (deftest compile-code-test (testing "Found" - (cql-test/stub-find-code ::db "life" "0" #{::code}) + (stub-find-code ::db "life" "0" #{::code}) (let [context {:db ::db @@ -178,7 +197,7 @@ (is (= ::code (-eval (compile context code) {:db ::db} nil nil))))) (testing "Not found" - (cql-test/stub-find-code ::db "life" "0" nil?) + (stub-find-code ::db "life" "0" nil?) (let [context {:db ::db @@ -197,7 +216,7 @@ ;; within an expression. (deftest compile-code-ref-test (testing "Found" - (cql-test/stub-find-code ::db "life" "0" #{::code}) + (stub-find-code ::db "life" "0" #{::code}) (let [context {:db ::db :library @@ -213,7 +232,7 @@ ::code))) (testing "Not found" - (cql-test/stub-find-code ::db "life" "0" nil?) + (stub-find-code ::db "life" "0" nil?) (let [context {:db ::db :library @@ -274,7 +293,7 @@ ;; 9.4. FunctionRef -(deftest compile-expression-ref-test +(deftest compile-function-ref-test (are [elm res] (= res (-eval (compile {} elm) {} nil nil)) {:name "ToString" @@ -287,6 +306,18 @@ ;; 10. Queries +(defn stub-list-resources [db type resources-spec] + (st/instrument + `datomic-util/list-resources + {:spec + {`datomic-util/list-resources + (s/fspec + :args (s/cat :db #{db} :type #{type}) + :ret resources-spec)} + :stub + #{`datomic-util/list-resources}})) + + ;; 10.1. Query (deftest compile-query-test (testing "Non-retrieve queries" @@ -317,7 +348,7 @@ (is (instance? Eduction res))))) (testing "Retrieve queries" - (datomic-test-util/stub-list-resources ::db "Patient" #{[::patient]}) + (stub-list-resources ::db "Patient" #{[::patient]}) (let [retrieve {:dataType "{http://hl7.org/fhir}Patient" :type "Retrieve"} where {:type "Equal" @@ -385,7 +416,7 @@ {`compile-with-equiv-clause (s/fspec :args (s/cat :context any? :with-equiv-clause :elm.query.life/with-equiv))}}) - (datomic-test-util/stub-list-resources + (stub-list-resources ::db "Observation" #{[{:Observation/subject ::subject}]}) (testing "Equiv With with two Observations comparing there subjects." @@ -440,7 +471,7 @@ ;; 11.1. Retrieve (deftest compile-retrieve-test - (datomic-test-util/stub-list-resources ::db "Patient" #{[::patient]}) + (stub-list-resources ::db "Patient" #{[::patient]}) (let [context {:db ::db @@ -471,7 +502,7 @@ (is (= [::observation] (-eval expr {} ::patient nil)))))) (testing "while retrieving observations with one specific code" - (cql-test/stub-find-code ::db "life" "0" #{::code}) + (stub-find-code ::db "life" "0" #{::code}) (retrieve-test/stub-single-code-expr ::db "Patient" "Observation" "code" ::code [::observation]) @@ -487,7 +518,7 @@ (is (= [::observation] (-eval expr context resource nil)))))) (testing "while retrieving observations with one not existing code" - (cql-test/stub-find-code ::db "life" "1" nil?) + (stub-find-code ::db "life" "1" nil?) (let [elm {:dataType "{http://hl7.org/fhir}Observation" :codeProperty "code" :type "Retrieve" @@ -504,7 +535,7 @@ (is (= [] (-eval expr context resource nil)))))) (testing "while retrieving conditions with one specific code" - (cql-test/stub-find-code ::db "life" "0" #{::code}) + (stub-find-code ::db "life" "0" #{::code}) (retrieve-test/stub-single-code-expr ::db "Patient" "Condition" "code" ::code [::condition]) @@ -550,10 +581,10 @@ (is (= [::observation] (-eval expr context ::specimen nil))))))) (testing "Unspecified Eval Context" - (cql-test/stub-find-code ::db "life" "0" #{{:db/id ::code-eid}}) + (stub-find-code ::db "life" "0" #{{:db/id ::code-eid}}) (testing "retrieving all patients" - (datomic-test-util/stub-list-resources ::db "Patient" #{[::patient]}) + (stub-list-resources ::db "Patient" #{[::patient]}) (are [elm res] (= res (-eval (compile (assoc context :eval-context "Unspecified") elm) @@ -4309,7 +4340,7 @@ (are [list] (thrown? Exception (-eval (compile {} (elm/singleton-from list)) {} nil nil)) #elm/list [#elm/int "1" #elm/int "1"]) - (datomic-test-util/stub-list-resources ::db "Patient" #{[::patient]}) + (stub-list-resources ::db "Patient" #{[::patient]}) (are [list res] (= res (-eval (compile {:eval-context "Unspecified"} (elm/singleton-from list)) {:db ::db} nil nil)) {:dataType "{http://hl7.org/fhir}Patient" :type "Retrieve"} diff --git a/test/blaze/elm/equiv_relationships_test.clj b/modules/cql/test/blaze/elm/equiv_relationships_test.clj similarity index 94% rename from test/blaze/elm/equiv_relationships_test.clj rename to modules/cql/test/blaze/elm/equiv_relationships_test.clj index ad3902832..995b03b04 100644 --- a/test/blaze/elm/equiv_relationships_test.clj +++ b/modules/cql/test/blaze/elm/equiv_relationships_test.clj @@ -1,10 +1,10 @@ (ns blaze.elm.equiv-relationships-test (:require - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] [blaze.elm.equiv-relationships :refer [split-by-first-equal-expression]] - [blaze.elm.literals])) + [blaze.elm.literals] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [are deftest]])) (st/instrument) diff --git a/src/blaze/elm/literals.clj b/modules/cql/test/blaze/elm/literals.clj similarity index 100% rename from src/blaze/elm/literals.clj rename to modules/cql/test/blaze/elm/literals.clj diff --git a/test/blaze/elm/normalizer_test.clj b/modules/cql/test/blaze/elm/normalizer_test.clj similarity index 96% rename from test/blaze/elm/normalizer_test.clj rename to modules/cql/test/blaze/elm/normalizer_test.clj index 2980cdc5f..2b183ba98 100644 --- a/test/blaze/elm/normalizer_test.clj +++ b/modules/cql/test/blaze/elm/normalizer_test.clj @@ -2,9 +2,13 @@ "Section numbers are according to https://cql.hl7.org/04-logicalspecification.html." (:require - [clojure.test :refer :all] - [juxt.iota :refer [given]] - [blaze.elm.normalizer :refer [normalize]])) + [blaze.elm.normalizer :refer [normalize]] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [deftest testing]] + [juxt.iota :refer [given]])) + + +(st/instrument) (def expression-1 @@ -154,7 +158,7 @@ ;; 14. Nullological Operators ;; 14.2. Coalesce -(deftest normalize-or-test +(deftest normalize-coalesce-test (testing "Normalizes all operands of an Coalesce expression" (given (normalize {:type "Coalesce" :operand [expression-1 expression-2]}) :operand := [(normalize expression-1) (normalize expression-2)]))) diff --git a/test/blaze/elm/type_infer_test.clj b/modules/cql/test/blaze/elm/type_infer_test.clj similarity index 89% rename from test/blaze/elm/type_infer_test.clj rename to modules/cql/test/blaze/elm/type_infer_test.clj index 18599b87c..e00dcff95 100644 --- a/test/blaze/elm/type_infer_test.clj +++ b/modules/cql/test/blaze/elm/type_infer_test.clj @@ -1,14 +1,12 @@ (ns blaze.elm.type-infer-test (:require - [clojure.test :refer :all] - [juxt.iota :refer [given]] - [blaze.elm.type-infer - :refer - [elm-type-specifier - infer-types - list-type-specifier - named-type-specifier - named-list-type-specifier]])) + [blaze.elm.type-infer :refer [infer-types]] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [deftest testing]] + [juxt.iota :refer [given]])) + + +(st/instrument) (defmacro ^:private given-infer-types [elm & body] diff --git a/src/data_readers.clj b/modules/cql/test/data_readers.clj similarity index 100% rename from src/data_readers.clj rename to modules/cql/test/data_readers.clj diff --git a/modules/cql/tests.edn b/modules/cql/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/cql/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/datomic-test-util/deps.edn b/modules/datomic-test-util/deps.edn new file mode 100644 index 000000000..ec3252e30 --- /dev/null +++ b/modules/datomic-test-util/deps.edn @@ -0,0 +1,11 @@ +{:deps + {blaze/datomic + {:local/root "../datomic"} + + com.datomic/datomic-free + {:mvn/version "0.9.5697" + :exclusions + [io.netty/netty-all]} + + org.clojars.akiel/datomic-tools + {:mvn/version "0.4"}}} diff --git a/test/blaze/datomic/test_util.clj b/modules/datomic-test-util/src/blaze/datomic/test_util.clj similarity index 98% rename from test/blaze/datomic/test_util.clj rename to modules/datomic-test-util/src/blaze/datomic/test_util.clj index e21cf92f9..138ee3364 100644 --- a/test/blaze/datomic/test_util.clj +++ b/modules/datomic-test-util/src/blaze/datomic/test_util.clj @@ -6,7 +6,6 @@ [blaze.structure-definition :refer [read-structure-definitions]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] [datomic.api :as d] [datomic-tools.schema :as dts] [blaze.datomic.schema :as schema]) @@ -500,13 +499,13 @@ #{`tx/resource-upsert}})) -(defn stub-transact-async [conn tx-data tx-result] +(defn stub-transact-async [executor conn tx-data tx-result] (st/instrument [`tx/transact-async] {:spec {`tx/transact-async (s/fspec - :args (s/cat :conn #{conn} :tx-data #{tx-data}) + :args (s/cat :executor #{executor} :conn #{conn} :tx-data #{tx-data}) :ret #{tx-result})} :stub #{`tx/transact-async}})) diff --git a/modules/datomic/deps.edn b/modules/datomic/deps.edn new file mode 100644 index 000000000..dd46f3c66 --- /dev/null +++ b/modules/datomic/deps.edn @@ -0,0 +1,71 @@ +{:deps + {blaze/anomaly + {:local/root "../anomaly"} + + blaze/executor + {:local/root "../executor"} + + blaze/module-base + {:local/root "../module-base"} + + blaze/structure-definition + {:local/root "../structure-definition"} + + blaze/terminology-service + {:local/root "../terminology-service"} + + com.datomic/datomic-free + {:mvn/version "0.9.5697" + :exclusions + [io.netty/netty-all]} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + funcool/cuerdas + {:mvn/version "2.2.0" + :exclusions [org.clojure/clojurescript]} + + javax.measure/unit-api + {:mvn/version "1.0"} + + org.clojars.akiel/datomic-spec + {:mvn/version "0.5.2"} + + org.clojars.akiel/datomic-tools + {:mvn/version "0.4"} + + prom-metrics + {:mvn/version "0.5-alpha2"} + + systems.uom/systems-quantity + {:mvn/version "1.0"} + + systems.uom/systems-ucum + {:mvn/version "0.9"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {blaze/datomic-test-util + {:local/root "../datomic-test-util"} + + criterium + {:mvn/version "0.4.5"} + + lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/data.xml + {:mvn/version "0.0.8"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/modules/datomic/src/blaze/datomic.clj b/modules/datomic/src/blaze/datomic.clj new file mode 100644 index 000000000..9b8cd0b88 --- /dev/null +++ b/modules/datomic/src/blaze/datomic.clj @@ -0,0 +1,54 @@ +(ns blaze.datomic + (:require + [blaze.datomic.schema :as schema] + [blaze.datomic.transaction :as tx] + [blaze.module :refer [defcollector]] + [datomic.api :as d] + [datomic-tools.schema :as dts] + [integrant.core :as ig] + [taoensso.timbre :as log]) + (:import + [java.util.concurrent ArrayBlockingQueue ThreadPoolExecutor TimeUnit])) + + +(defn- upsert-schema [uri structure-definitions] + (let [conn (d/connect uri) + _ @(d/transact-async conn (dts/schema)) + {:keys [tx-data]} @(d/transact-async conn (schema/structure-definition-schemas structure-definitions))] + (log/info "Upsert schema in database:" uri "creating" (count tx-data) "new facts"))) + + +(defmethod ig/init-key :blaze.datomic/conn + [_ {:database/keys [uri] :keys [structure-definitions]}] + (if (d/create-database uri) + (do + (log/info "Created database at:" uri) + (upsert-schema uri structure-definitions)) + (log/info "Use existing database at:" uri)) + + (log/info "Connect with database:" uri) + (d/connect uri)) + + +(defmethod ig/init-key ::tx/executor + [_ _] + (ThreadPoolExecutor. 20 20 1 TimeUnit/MINUTES (ArrayBlockingQueue. 100))) + + +(derive ::tx/executor :blaze.metrics/thread-pool-executor) + + +(defcollector resource-upsert-duration-seconds [_] + tx/resource-upsert-duration-seconds) + + +(defcollector execution-duration-seconds [_] + tx/execution-duration-seconds) + + +(defcollector resources-total [_] + tx/resources-total) + + +(defcollector datoms-total [_] + tx/datoms-total) diff --git a/src/blaze/datomic/cql.clj b/modules/datomic/src/blaze/datomic/cql.clj similarity index 100% rename from src/blaze/datomic/cql.clj rename to modules/datomic/src/blaze/datomic/cql.clj diff --git a/src/blaze/datomic/element_definition.clj b/modules/datomic/src/blaze/datomic/element_definition.clj similarity index 100% rename from src/blaze/datomic/element_definition.clj rename to modules/datomic/src/blaze/datomic/element_definition.clj diff --git a/src/blaze/datomic/pull.clj b/modules/datomic/src/blaze/datomic/pull.clj similarity index 99% rename from src/blaze/datomic/pull.clj rename to modules/datomic/src/blaze/datomic/pull.clj index 49fd4393f..30fe00a59 100644 --- a/src/blaze/datomic/pull.clj +++ b/modules/datomic/src/blaze/datomic/pull.clj @@ -2,7 +2,6 @@ "Create Pull Patterns from FHIR Structure Definitions" (:require [blaze.datomic.quantity :as quantity] - [blaze.spec] [blaze.datomic.util :as util] [blaze.datomic.value :as value] [clojure.spec.alpha :as s] diff --git a/src/blaze/datomic/quantity.clj b/modules/datomic/src/blaze/datomic/quantity.clj similarity index 100% rename from src/blaze/datomic/quantity.clj rename to modules/datomic/src/blaze/datomic/quantity.clj diff --git a/src/blaze/datomic/schema.clj b/modules/datomic/src/blaze/datomic/schema.clj similarity index 97% rename from src/blaze/datomic/schema.clj rename to modules/datomic/src/blaze/datomic/schema.clj index 9991c9707..6de061f70 100644 --- a/src/blaze/datomic/schema.clj +++ b/modules/datomic/src/blaze/datomic/schema.clj @@ -2,13 +2,11 @@ "Creates a Datomic schema based on FHIR structure definitions." (:require [clojure.spec.alpha :as s] - [clojure.string :as str] + [cuerdas.core :as str] [datomic.api :as d] [datomic-spec.core :as ds] [datomic-tools.schema :refer [defattr defunc defpart]] - [blaze.datomic.element-definition] - [blaze.spec] - [blaze.util :as u])) + [blaze.datomic.element-definition])) (defattr :type/elements @@ -224,12 +222,6 @@ false)) -(defn- with-ns - "Adds `ns` to all non-namespaced keywords in `m`." - [ns m] - (into {} (map (fn [[k v]] (if (namespace k) [k v] [(keyword ns (name k)) v]))) m)) - - (defn- backbone-element? {:arglists '([element])} [{[{:keys [code]}] :type}] @@ -267,7 +259,7 @@ last (last path)] (mapv (fn [{:keys [code] :as type}] - (assoc type :path [butlast (str last (u/title-case code))])) + (assoc type :path [butlast (str last (str/capital code))])) type))) diff --git a/modules/datomic/src/blaze/datomic/spec.clj b/modules/datomic/src/blaze/datomic/spec.clj new file mode 100644 index 000000000..a1aad7046 --- /dev/null +++ b/modules/datomic/src/blaze/datomic/spec.clj @@ -0,0 +1,43 @@ +(ns blaze.datomic.spec + (:require + [clojure.spec.alpha :as s])) + + +(s/def :schema/element + some?) + + +(s/def :element/primitive? + boolean?) + + +(s/def :element/choice-type? + boolean?) + + +(s/def :element/part-of-choice-type? + boolean?) + + +(s/def :element/type-attr-ident + keyword?) + + +(s/def :element/type-choices + (s/coll-of :schema/element)) + + +(s/def :element/type + :schema/element) + + +(s/def :element/type-code + string?) + + +(s/def :element/json-key + string?) + + +(s/def :element/value-set-binding + string?) diff --git a/src/blaze/datomic/transaction.clj b/modules/datomic/src/blaze/datomic/transaction.clj similarity index 94% rename from src/blaze/datomic/transaction.clj rename to modules/datomic/src/blaze/datomic/transaction.clj index 851c2a469..a3a3aef69 100644 --- a/src/blaze/datomic/transaction.clj +++ b/modules/datomic/src/blaze/datomic/transaction.clj @@ -1,12 +1,13 @@ (ns blaze.datomic.transaction (:require + [blaze.anomaly :refer [throw-anom]] [blaze.datomic.quantity :as quantity] [blaze.datomic.pull :as pull] + [blaze.datomic.spec] [blaze.datomic.value :as value] [blaze.datomic.util :as util] - [blaze.spec] + [blaze.executors :refer [executor?]] [blaze.terminology-service :as ts :refer [term-service?]] - [blaze.util :refer [throw-anom]] [clojure.set :as set] [clojure.spec.alpha :as s] [clojure.string :as str] @@ -23,8 +24,7 @@ [java.time.format DateTimeFormatter] [java.util Base64] [java.util Date Map$Entry UUID] - [java.util.concurrent ExecutionException TimeUnit ThreadPoolExecutor - ArrayBlockingQueue RejectedExecutionException])) + [java.util.concurrent ExecutionException RejectedExecutionException])) (defn- ident->path [ident] @@ -37,11 +37,11 @@ (int? value) (BigDecimal/valueOf ^long value) :else (throw-anom - {::anom/category ::anom/incorrect - ::anom/message (str "Invalid decimal value `" value "`.") - :fhir/issue "value" - :fhir.issue/expression (ident->path ident) - :value value}))) + ::anom/incorrect + (str "Invalid decimal value `" value "`.") + :fhir/issue "value" + :fhir.issue/expression (ident->path ident) + :value value))) (defn- coerce-date-time [^String value] @@ -73,10 +73,10 @@ (UUID/fromString s) (catch Exception _ (throw-anom - {::anom/category ::anom/incorrect - ::anom/message (str "Invalid UUID `" s "`.") - :fhir/issue "value" - :fhir.issue/expression (ident->path ident)})))) + ::anom/incorrect + (str "Invalid UUID `" s "`.") + :fhir/issue "value" + :fhir.issue/expression (ident->path ident))))) (defn- quantity [element {:strs [value code unit]}] @@ -130,42 +130,46 @@ (if (= :db.cardinality/one cardinality) (when (or (vector? value) (set? value)) (throw-anom - {::anom/category ::anom/incorrect - ::anom/message - (str "Incorrect sequential value `" (pr-str value) - "` at element `" (ident->path ident) "`.") - :fhir/issue "value" - :fhir.issue/expression (ident->path ident)})) + ::anom/incorrect + (str "Incorrect sequential value `" (pr-str value) + "` at element `" (ident->path ident) "`.") + :fhir/issue "value" + :fhir.issue/expression (ident->path ident))) (when (not (or (vector? value) (set? value))) (throw-anom - {::anom/category ::anom/incorrect - ::anom/message - (str "Incorrect non-sequential value `" (pr-str value) - "` at element `" (ident->path ident) "`.") - :fhir/issue "value" - :fhir.issue/expression (ident->path ident)})))) + ::anom/incorrect + (str "Incorrect non-sequential value `" (pr-str value) + "` at element `" (ident->path ident) "`.") + :fhir/issue "value" + :fhir.issue/expression (ident->path ident))))) -(defn check-primitive [{:element/keys [primitive? type-code] :db/keys [ident]} value] +(defn- check-primitive [{:element/keys [primitive? type-code] :db/keys [ident]} value] (when-not (= "code" type-code) (if (and primitive? (not (= "Quantity" type-code))) (when (map? value) (throw-anom - {::anom/category ::anom/incorrect - ::anom/message - (str "Incorrect non-primitive value at primitive element `" (ident->path ident) "`.") - :fhir/issue "value" - :fhir.issue/expression (ident->path ident)})) + ::anom/incorrect + (str "Incorrect non-primitive value at primitive element `" + (ident->path ident) "`.") + :fhir/issue "value" + :fhir.issue/expression (ident->path ident))) (when-not (or (map? value) (s/valid? (s/coll-of map?) value)) (throw-anom - {::anom/category ::anom/incorrect - ::anom/message - (str "Incorrect primitive value `" (pr-str value) - "` at non-primitive element `" (ident->path ident) "`.") - :fhir/issue "value" - :fhir.issue/expression (ident->path ident)}))))) + ::anom/incorrect + (str "Incorrect primitive value `" (pr-str value) + "` at non-primitive element `" (ident->path ident) "`.") + :fhir/issue "value" + :fhir.issue/expression (ident->path ident)))))) +(s/fdef find-json-value + :args + (s/cat + ::db ::ds/db + :element :schema/element + :entity (s/nilable (s/map-of string? any?)))) + (defn find-json-value "Tries to find a value suitable for `element` in a JSON `entity`. @@ -175,6 +179,7 @@ Returns the first found value on choice typed elements. Returns nil of nothing was found." + {:arglists '([db element entity])} [db {:element/keys [choice-type? type-choices json-key] :as element} entity] (if choice-type? (transduce @@ -233,10 +238,10 @@ (if-let [{:db/keys [id]} (d/entity db [:code/id code-id])] (into [[:db/add parent-id ident id]] (subject-index context code-id)) (throw-anom - {::anom/category ::anom/fault - ::anom/message (str "Can't find code with id `" code-id "`.") - :context context - :element element})))) + ::anom/fault + (str "Can't find code with id `" code-id "`.") + :context context + :element element)))) (defn- add-primitive-element @@ -909,7 +914,7 @@ (let [tx-data (upsert-resource {:db db :tempids tempids} type old-resource resource) {:db/keys [id] :instance/keys [version]} old-resource] - (when (or (not (empty? tx-data)) (util/deleted? old-resource)) + (when (or (seq tx-data) (util/deleted? old-resource)) (conj tx-data (version-decrement-upsert id version)))) (let [tempid (get-in tempids [type id])] @@ -969,10 +974,6 @@ ::anom/fault)) -(def tx-executor - (ThreadPoolExecutor. 20 20 1 TimeUnit/MINUTES (ArrayBlockingQueue. 100))) - - (defhistogram execution-duration-seconds "Datomic transaction execution latencies in seconds." {:namespace "datomic" @@ -993,7 +994,7 @@ (s/fdef transact-async - :args (s/cat :conn ::ds/conn :tx-data ::ds/tx-data) + :args (s/cat :executor executor? :conn ::ds/conn :tx-data ::ds/tx-data) :ret deferred?) (defn transact-async @@ -1002,9 +1003,9 @@ Uses an executor with a maximum parallelism of 20 and times out after 10 seconds." - [conn tx-data] + [executor conn tx-data] (try - (-> (md/future-with tx-executor + (-> (md/future-with executor (with-open [_ (prom/timer execution-duration-seconds)] @(d/transact-async conn tx-data))) (md/chain' @@ -1037,9 +1038,9 @@ :ret (s/tuple string? string? keyword?)) (defn resource-tempid - "Returns a triple of resource type, logical id and tempid for `resources` - which have to be created in `db`." - {:arglists '([context resource])} + "Returns a triple of resource type, logical id and tempid when `resource` + has to be created in `db`." + {:arglists '([db resource])} [db {type "resourceType" id "id"}] (when-not (util/resource db type id) [type id (d/tempid (keyword "part" type))])) @@ -1311,14 +1312,16 @@ :ret deferred?) (defn annotate-codes - "Annotates single codes with value set bindings with there system and version. + "Annotates values of data type `code` with a value set binding with the + appropriate system and version. - Doesn't touch the other values. + Doesn't touch the other values. Returns the deferred, annotated resource. The resource has to have at least a `resourceType` and an `id`." {:arglists '([term-service db resource])} [term-service db {type "resourceType" id "id" :as resource}] (assert type) (assert id) - (-> (annotate-codes* {:term-service term-service :db db} (keyword type) resource) + (-> (annotate-codes* + {:term-service term-service :db db} (keyword type) resource) (md/chain' #(assoc % "resourceType" type)))) diff --git a/src/blaze/datomic/util.clj b/modules/datomic/src/blaze/datomic/util.clj similarity index 100% rename from src/blaze/datomic/util.clj rename to modules/datomic/src/blaze/datomic/util.clj diff --git a/src/blaze/datomic/value.clj b/modules/datomic/src/blaze/datomic/value.clj similarity index 99% rename from src/blaze/datomic/value.clj rename to modules/datomic/src/blaze/datomic/value.clj index 121eca6ef..2be0e6e91 100644 --- a/src/blaze/datomic/value.clj +++ b/modules/datomic/src/blaze/datomic/value.clj @@ -289,7 +289,7 @@ (criterium.core/quick-bench (OffsetDateTime/parse "2012-02-29T12:13:14+01:00")) - (let [(def (vec bytes) (write 42.23M))] + (let [bytes (write 42.23M)] (criterium.core/bench (read bytes))) (def bytes (write (quantity 1M "kg"))) diff --git a/test/blaze/datomic/pull_test.clj b/modules/datomic/test/blaze/datomic/pull_test.clj similarity index 62% rename from test/blaze/datomic/pull_test.clj rename to modules/datomic/test/blaze/datomic/pull_test.clj index 860db99d0..19b4a1180 100644 --- a/test/blaze/datomic/pull_test.clj +++ b/modules/datomic/test/blaze/datomic/pull_test.clj @@ -1,11 +1,11 @@ (ns blaze.datomic.pull-test (:require - [blaze.datomic.pull :refer :all] + [blaze.datomic.pull :refer [pull-resource]] [blaze.datomic.quantity :refer [quantity]] - [blaze.datomic.test-util :refer :all] + [blaze.datomic.test-util :as test-util] [blaze.datomic.value :as value] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :refer [deftest is testing use-fixtures]] [datomic.api :as d] [datomic-spec.test :as dst] [juxt.iota :refer [given]]) @@ -24,7 +24,7 @@ (use-fixtures :each fixture) -(defonce db (d/db (st/with-instrument-disabled (connect)))) +(defonce db (d/db (st/with-instrument-disabled (test-util/connect)))) (defn- b64-decode [s] @@ -34,51 +34,51 @@ (deftest pull-resource-test (testing "meta.versionId" - (let [[db] (with-resource db "Patient" "0")] + (let [[db] (test-util/with-resource db "Patient" "0")] (given (pull-resource db "Patient" "0") ;; this is the t of the last transaction. it could change if the ;; transactions before change ["meta" "versionId"] := "9838"))) (testing "meta.lastUpdated" - (let [[db] (with-resource db "Patient" "0")] + (let [[db] (test-util/with-resource db "Patient" "0")] (is (string? (get-in (pull-resource db "Patient" "0") ["meta" "lastUpdated"]))))) (testing "deleted" - (let [[db] (with-deleted-resource db "Patient" "0")] + (let [[db] (test-util/with-deleted-resource db "Patient" "0")] (given (meta (pull-resource db "Patient" "0")) :deleted := true))) (testing "primitive single-valued single-typed element" (testing "with boolean type" - (let [[db] (with-resource db "Patient" "0" :Patient/active true)] + (let [[db] (test-util/with-resource db "Patient" "0" :Patient/active true)] (given (pull-resource db "Patient" "0") "active" := true))) (testing "with code type" - (let [[db id] (with-gender-code db "male") - [db] (with-resource db "Patient" "0" :Patient/gender id)] + (let [[db id] (test-util/with-gender-code db "male") + [db] (test-util/with-resource db "Patient" "0" :Patient/gender id)] (given (pull-resource db "Patient" "0") "gender" := 'male))) (testing "with date type" - (let [[db] (with-resource db "Patient" "0" :Patient/birthDate + (let [[db] (test-util/with-resource db "Patient" "0" :Patient/birthDate (value/write (Year/of 2000)))] (given (pull-resource db "Patient" "0") "birthDate" := "2000"))) (testing "with base64Binary type" - (let [[db id] (with-non-primitive db :Attachment/data (value/write (b64-decode "aGFsbG8="))) - [db] (with-resource db "Patient" "0" :Patient/photo id)] + (let [[db id] (test-util/with-non-primitive db :Attachment/data (value/write (b64-decode "aGFsbG8="))) + [db] (test-util/with-resource db "Patient" "0" :Patient/photo id)] (given (pull-resource db "Patient" "0") ["photo" first "data"] := "aGFsbG8=")))) (testing "Coding" - (let [[db id] (with-icd10-code db "2016" "Q14") - [db id] (with-non-primitive db :Coding/code id) - [db id] (with-non-primitive db :CodeableConcept/coding id) - [db] (with-resource db "Observation" "0" :Observation/code id)] + (let [[db id] (test-util/with-icd10-code db "2016" "Q14") + [db id] (test-util/with-non-primitive db :Coding/code id) + [db id] (test-util/with-non-primitive db :CodeableConcept/coding id) + [db] (test-util/with-resource db "Observation" "0" :Observation/code id)] (given (pull-resource db "Observation" "0") ["code" "coding" first] := {"system" "http://hl7.org/fhir/sid/icd-10" @@ -88,7 +88,7 @@ (testing "Quantity" (let [[db] - (with-resource + (test-util/with-resource db "Observation" "0" :Observation/valueQuantity (value/write (quantity 1M "m")) :Observation/value :Observation/valueQuantity)] @@ -98,7 +98,7 @@ (testing "DateTime" (let [[db] - (with-resource + (test-util/with-resource db "Observation" "0" :Observation/valueDateTime (value/write (LocalDateTime/of 2019 5 8 18 21 42)) :Observation/value :Observation/valueDateTime)] @@ -107,23 +107,23 @@ (testing "Contact" - (let [[db id] (with-non-primitive db :HumanName/family "Doe") - [db id] (with-non-primitive db :Patient.contact/name id) - [db] (with-resource db "Patient" "0" :Patient/contact id)] + (let [[db id] (test-util/with-non-primitive db :HumanName/family "Doe") + [db id] (test-util/with-non-primitive db :Patient.contact/name id) + [db] (test-util/with-resource db "Patient" "0" :Patient/contact id)] (given (pull-resource db "Patient" "0") ["contact" first "name" "family"] := "Doe"))) (testing "Reference" - (let [[db id] (with-resource db "Organization" "0") - [db] (with-resource db "Patient" "0" :Patient/managingOrganization id)] + (let [[db id] (test-util/with-resource db "Organization" "0") + [db] (test-util/with-resource db "Patient" "0" :Patient/managingOrganization id)] (given (pull-resource db "Patient" "0") ["managingOrganization" "reference"] := "Organization/0"))) (testing "Contained resource" - (let [[db id] (with-non-primitive db :Patient/active true :local-id "1") - [db] (with-resource db "Observation" "0" + (let [[db id] (test-util/with-non-primitive db :Patient/active true :local-id "1") + [db] (test-util/with-resource db "Observation" "0" :Observation/contained id :Observation/subject id)] (given (pull-resource db "Observation" "0") diff --git a/test/blaze/datomic/schema_test.clj b/modules/datomic/test/blaze/datomic/schema_test.clj similarity index 97% rename from test/blaze/datomic/schema_test.clj rename to modules/datomic/test/blaze/datomic/schema_test.clj index c90bef758..5d5c7270b 100644 --- a/test/blaze/datomic/schema_test.clj +++ b/modules/datomic/test/blaze/datomic/schema_test.clj @@ -1,11 +1,10 @@ (ns blaze.datomic.schema-test (:require - [blaze.datomic.schema :refer :all] + [blaze.datomic.schema :refer [element-definition-tx-data path->ident]] [blaze.structure-definition :refer [read-structure-definitions]] [clojure.spec.test.alpha :as st] [clojure.string :as str] - [clojure.test :refer :all] - [juxt.iota :refer [given]])) + [clojure.test :refer [are deftest is testing]])) (st/instrument) @@ -479,4 +478,14 @@ [:db/add "Specimen.collection" :type/elements "Specimen.collection.bodySite"] #:db{:cardinality :db.cardinality/many :ident :Specimen.collection.index/bodySite - :valueType :db.type/ref}])))) + :valueType :db.type/ref}]))) + + (testing "ContactPoint" + (is (= (element-definition-tx-data + (structure-definition "ContactPoint") + (element-definition "ContactPoint")) + [{:db/id "ContactPoint" + :db/ident :ContactPoint} + {:db/id "part.ContactPoint" + :db/ident :part/ContactPoint} + [:db/add :db.part/db :db.install/partition "part.ContactPoint"]])))) diff --git a/test/blaze/datomic/transaction_test.clj b/modules/datomic/test/blaze/datomic/transaction_test.clj similarity index 83% rename from test/blaze/datomic/transaction_test.clj rename to modules/datomic/test/blaze/datomic/transaction_test.clj index 5a62e5ec4..e3155fadb 100644 --- a/test/blaze/datomic/transaction_test.clj +++ b/modules/datomic/test/blaze/datomic/transaction_test.clj @@ -1,14 +1,15 @@ (ns blaze.datomic.transaction-test (:require [blaze.datomic.quantity :refer [quantity]] - [blaze.datomic.test-util :refer :all] + [blaze.datomic.test-util :as test-util] [blaze.datomic.transaction :refer [annotate-codes resource-upsert resource-deletion coerce-value transact-async resource-codes-creation]] [blaze.datomic.value :as value] + [blaze.executors :as ex] [blaze.terminology-service :as ts] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :refer [deftest is testing use-fixtures]] [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.test :as dst] @@ -19,7 +20,10 @@ [java.util Base64])) -(defonce db (d/db (st/with-instrument-disabled (connect)))) +(defonce db (d/db (st/with-instrument-disabled (test-util/connect)))) + + +(defonce transaction-executor (ex/single-thread-executor)) (defn fixture [f] @@ -206,7 +210,7 @@ [:db.fn/cas tempid :instance/version nil -4]])))) (testing "Doesn't increment version on empty update" - (let [[db] (with-resource db "Patient" "0")] + (let [[db] (test-util/with-resource db "Patient" "0")] (is (empty? (resource-upsert @@ -214,7 +218,7 @@ {"id" "0" "resourceType" "Patient"}))))) (testing "Clear deletion bit on upsert" - (let [[db id] (with-deleted-resource db "Patient" "0")] + (let [[db id] (test-util/with-deleted-resource db "Patient" "0")] (is (= (resource-upsert @@ -239,7 +243,7 @@ (testing "primitive single-valued single-typed element" (testing "with boolean type" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (resource-upsert @@ -249,8 +253,8 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with code type" - (let [[db code-id] (with-gender-code db "male") - [db id] (with-resource db "Patient" "0")] + (let [[db code-id] (test-util/with-gender-code db "male") + [db id] (test-util/with-resource db "Patient" "0")] (is (= (resource-upsert @@ -263,7 +267,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with date type" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (mapv @@ -275,7 +279,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with unsignedInt type" - (let [[db id] (with-resource db "CodeSystem" "0")] + (let [[db id] (test-util/with-resource db "CodeSystem" "0")] (is (= (mapv @@ -287,7 +291,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with base64Binary type" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (mapv @@ -304,7 +308,7 @@ (testing "primitive single-valued choice-typed element" (testing "with boolean choice" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (resource-upsert @@ -315,7 +319,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with dateTime choice" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (mapv @@ -328,7 +332,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with string choice" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (resource-upsert @@ -341,7 +345,7 @@ (testing "primitive multi-valued single-typed element" (testing "with uri type" - (let [[db id] (with-resource db "ServiceRequest" "0")] + (let [[db id] (test-util/with-resource db "ServiceRequest" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -354,8 +358,8 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with code type" - (let [[db code-id] (with-code db "http://hl7.org/fhir/filter-operator" "=") - [db id] (with-resource db "CodeSystem" "0")] + (let [[db code-id] (test-util/with-code db "http://hl7.org/fhir/filter-operator" "=") + [db id] (test-util/with-resource db "CodeSystem" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] (resource-upsert @@ -369,8 +373,8 @@ [:db/add id :CodeSystem/filter :part/CodeSystem.filter] [:db.fn/cas id :instance/version -3 -7]]))) - (let [[db code-id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") - [db id] (with-resource db "AllergyIntolerance" "0")] + (let [[db code-id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") + [db id] (test-util/with-resource db "AllergyIntolerance" "0")] (is (= (resource-upsert db nil :server-assigned-id @@ -384,7 +388,7 @@ (testing "primitive single-valued element in multi-valued backbone element" (testing "with boolean type" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -400,7 +404,7 @@ (testing "non-primitive single-valued single-typed element" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] (resource-upsert @@ -415,7 +419,7 @@ (testing "non-primitive single-valued choice-typed element" (testing "with CodeableConcept choice" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -430,7 +434,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with Period choice" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -448,7 +452,7 @@ (testing "non-primitive multi-valued single-typed element" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -463,8 +467,8 @@ (testing "Coding" (testing "without version" (let [[db code-id] - (with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "AMB") - [db id] (with-resource db "Encounter" "0")] + (test-util/with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "AMB") + [db id] (test-util/with-resource db "Encounter" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -481,8 +485,8 @@ (testing "with version" (let [[db code-id] - (with-code db "http://hl7.org/fhir/sid/icd-10" "2016" "Q14") - [db id] (with-resource db "Observation" "0")] + (test-util/with-code db "http://hl7.org/fhir/sid/icd-10" "2016" "Q14") + [db id] (test-util/with-resource db "Observation" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -503,8 +507,8 @@ (testing "with userSelected" (let [[db code-id] - (with-code db "http://hl7.org/fhir/sid/icd-10" "2016" "Q14") - [db id] (with-resource db "Observation" "0")] + (test-util/with-code db "http://hl7.org/fhir/sid/icd-10" "2016" "Q14") + [db id] (test-util/with-resource db "Observation" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -526,9 +530,9 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with subject-code index" - (let [[db code-id] (with-code db "http://loinc.org" "39156-5") - [db obs-id] (with-resource db "Observation" "0") - [db pat-id] (with-resource db "Patient" "0")] + (let [[db code-id] (test-util/with-code db "http://loinc.org" "39156-5") + [db obs-id] (test-util/with-resource db "Observation" "0") + [db pat-id] (test-util/with-resource db "Patient" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -551,8 +555,8 @@ [:db.fn/cas obs-id :instance/version -3 -7]]))))) (testing "CodeSystem with code in concept" - (let [[db code-id] (with-code db "http://hl7.org/fhir/administrative-gender" "male") - [db id] (with-resource db "CodeSystem" "0")] + (let [[db code-id] (test-util/with-code db "http://hl7.org/fhir/administrative-gender" "male") + [db id] (test-util/with-resource db "CodeSystem" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -570,8 +574,8 @@ (testing "CodeSystem with version and code in concept" - (let [[db code-id] (with-code db "http://hl7.org/fhir/administrative-gender" "4.0.0" "male") - [db id] (with-resource db "CodeSystem" "0")] + (let [[db code-id] (test-util/with-code db "http://hl7.org/fhir/administrative-gender" "4.0.0" "male") + [db id] (test-util/with-resource db "CodeSystem" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -591,8 +595,8 @@ (testing "CodeSystem with code in content uses http://hl7.org/fhir/codesystem-content-mode" - (let [[db code-id] (with-code db "http://hl7.org/fhir/codesystem-content-mode" "complete") - [db id] (with-resource db "CodeSystem" "0")] + (let [[db code-id] (test-util/with-code db "http://hl7.org/fhir/codesystem-content-mode" "complete") + [db id] (test-util/with-resource db "CodeSystem" "0")] (is (= (resource-upsert @@ -610,9 +614,9 @@ (testing "CodeSystem with sub-concept" - (let [[db foo-id] (with-code db "http://something" "foo") - [db bar-id] (with-code db "http://something" "bar") - [db id] (with-resource db "CodeSystem" "0")] + (let [[db foo-id] (test-util/with-code db "http://something" "foo") + [db bar-id] (test-util/with-code db "http://something" "bar") + [db id] (test-util/with-resource db "CodeSystem" "0")] (is (= (with-redefs [d/tempid (tempid)] @@ -634,13 +638,13 @@ (testing "ValueSet with code in compose include" - (let [[db code-id] (with-code db "http://loinc.org" "2.36" "14647-2") + (let [[db code-id] (test-util/with-code db "http://loinc.org" "2.36" "14647-2") [db include-id] - (with-non-primitive + (test-util/with-non-primitive db :ValueSet.compose.include/system "http://loinc.org" :ValueSet.compose.include/version "2.36") - [db compose-id] (with-non-primitive db :ValueSet.compose/include include-id) - [db id] (with-resource db "ValueSet" "0" :ValueSet/compose compose-id)] + [db compose-id] (test-util/with-non-primitive db :ValueSet.compose/include include-id) + [db id] (test-util/with-resource db "ValueSet" "0" :ValueSet/compose compose-id)] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -660,13 +664,13 @@ (testing "ValueSet with code in expansion contains" - (let [[db code-id] (with-code db "http://loinc.org" "2.50" "14647-2") + (let [[db code-id] (test-util/with-code db "http://loinc.org" "2.50" "14647-2") [db contains-id] - (with-non-primitive + (test-util/with-non-primitive db :ValueSet.expansion.contains/system "http://loinc.org" :ValueSet.expansion.contains/version "2.50") - [db expansion-id] (with-non-primitive db :ValueSet.expansion/contains contains-id) - [db id] (with-resource db "ValueSet" "0" :ValueSet/expansion expansion-id)] + [db expansion-id] (test-util/with-non-primitive db :ValueSet.expansion/contains contains-id) + [db id] (test-util/with-resource db "ValueSet" "0" :ValueSet/expansion expansion-id)] (is (= (resource-upsert @@ -683,7 +687,7 @@ (testing "special Quantity type" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (mapv @@ -702,7 +706,7 @@ (testing "special Quantity type with integer decimal value" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (mapv @@ -721,7 +725,7 @@ (testing "special Quantity type with unit in unit" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (mapv @@ -739,8 +743,8 @@ (testing "single-valued special Reference type" (testing "with resource resolvable in db" - (let [[db patient-id] (with-resource db "Patient" "0") - [db observation-id] (with-resource db "Observation" "0")] + (let [[db patient-id] (test-util/with-resource db "Patient" "0") + [db observation-id] (test-util/with-resource db "Observation" "0")] (is (= (resource-upsert @@ -753,7 +757,7 @@ (testing "with resource resolvable in tempids" (let [patient-id (d/tempid :part/Patient) - [db observation-id] (with-resource db "Observation" "0")] + [db observation-id] (test-util/with-resource db "Observation" "0")] (is (= (resource-upsert @@ -766,8 +770,8 @@ (testing "multi-valued special Reference type" - (let [[db organization-id] (with-resource db "Organization" "0") - [db patient-id] (with-resource db "Patient" "0")] + (let [[db organization-id] (test-util/with-resource db "Organization" "0") + [db patient-id] (test-util/with-resource db "Patient" "0")] (is (= (resource-upsert @@ -781,7 +785,7 @@ (testing "Contact" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -798,7 +802,7 @@ (testing "Contained resources" - (let [[db id] (with-resource db "Observation" "0")] + (let [[db id] (test-util/with-resource db "Observation" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -819,9 +823,9 @@ (testing "ConceptMap with source code" - (let [[db code-id] (with-code db "http://foo" "bar") - [db group-id] (with-non-primitive db :ConceptMap.group/source "http://foo") - [db id] (with-resource db "ConceptMap" "0" :ConceptMap/group group-id)] + (let [[db code-id] (test-util/with-code db "http://foo" "bar") + [db group-id] (test-util/with-non-primitive db :ConceptMap.group/source "http://foo") + [db id] (test-util/with-resource db "ConceptMap" "0" :ConceptMap/group group-id)] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -839,8 +843,8 @@ (testing "ConceptMap with target code" - (let [[db code-id] (with-code db "http://foo" "bar") - [db id] (with-resource db "ConceptMap" "0")] + (let [[db code-id] (test-util/with-code db "http://foo" "bar") + [db id] (test-util/with-resource db "ConceptMap" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -862,7 +866,7 @@ (testing "String typed extension" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -882,9 +886,9 @@ (testing "Code typed extension" ;; TODO: resolve the value set binding here - (let [[db draft-id] (with-code db "draft") - [db extension-id] (with-non-primitive db :Extension/url "http://foo") - [db id] (with-resource db "CodeSystem" "0" :CodeSystem/extension extension-id)] + (let [[db draft-id] (test-util/with-code db "draft") + [db extension-id] (test-util/with-non-primitive db :Extension/url "http://foo") + [db id] (test-util/with-resource db "CodeSystem" "0" :CodeSystem/extension extension-id)] (is (= (resource-upsert @@ -900,7 +904,7 @@ (testing "ValueSet compose include system" - (let [[db id] (with-resource db "ValueSet" "0")] + (let [[db id] (test-util/with-resource db "ValueSet" "0")] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -922,7 +926,7 @@ (testing "primitive single-valued single-typed element" (testing "with boolean type" - (let [[db] (with-resource db "Patient" "0" :Patient/active true)] + (let [[db] (test-util/with-resource db "Patient" "0" :Patient/active true)] (is (empty? (resource-upsert @@ -930,8 +934,8 @@ {"id" "0" "resourceType" "Patient" "active" true}))))) (testing "with code type" - (let [[db id] (with-gender-code db "male") - [db] (with-resource db "Patient" "0" :Patient/gender id)] + (let [[db id] (test-util/with-gender-code db "male") + [db] (test-util/with-resource db "Patient" "0" :Patient/gender id)] (is (empty? (resource-upsert @@ -941,7 +945,7 @@ "gender" (with-meta 'male {:system "http://hl7.org/fhir/administrative-gender"})}))))) (testing "with date type" - (let [[db] (with-resource db "Patient" "0" :Patient/birthDate + (let [[db] (test-util/with-resource db "Patient" "0" :Patient/birthDate (value/write (Year/of 2000)))] (is (empty? @@ -951,7 +955,7 @@ (testing "with dateTime type" (let [[db] - (with-resource + (test-util/with-resource db "CodeSystem" "0" :CodeSystem/date (value/write (LocalDate/of 2016 1 28)))] (is @@ -961,7 +965,7 @@ {"id" "0" "resourceType" "CodeSystem" "date" "2016-01-28"})))) (let [[db] - (with-resource + (test-util/with-resource db "CodeSystem" "0" :CodeSystem/date (value/write (OffsetDateTime/of 2018 12 27 22 37 54 0 (ZoneOffset/ofHours 11))))] (is @@ -973,8 +977,8 @@ ;; TODO: doesn't work because of Zulu printing or the other way around (comment - (let [[db id] - (with-resource + (let [[db] + (test-util/with-resource db "CodeSystem" "0" :CodeSystem/date (value/write (OffsetDateTime/of 2018 06 05 14 06 2 0 (ZoneOffset/ofHours 0))))] (is @@ -988,7 +992,7 @@ (testing "primitive single-valued choice-typed element" (testing "with string choice" (let [[db] - (with-resource + (test-util/with-resource db "Observation" "0" :Observation/valueString "foo" :Observation/value :Observation/valueString)] @@ -1001,9 +1005,9 @@ (testing "non-primitive single-valued choice-typed element" (testing "with CodeableConcept choice" - (let [[db id] (with-non-primitive db :CodeableConcept/text "foo") + (let [[db id] (test-util/with-non-primitive db :CodeableConcept/text "foo") [db] - (with-resource db "Observation" "0" + (test-util/with-resource db "Observation" "0" :Observation/valueCodeableConcept id :Observation/value :Observation/valueCodeableConcept)] (is @@ -1018,7 +1022,7 @@ (testing "primitive multi-valued single-typed element" (testing "with uri type" (let [[db] - (with-resource + (test-util/with-resource db "ServiceRequest" "0" :ServiceRequest/instantiatesUri "foo")] (is (empty? @@ -1029,8 +1033,8 @@ "instantiatesUri" ["foo"]}))))) (testing "with code type" - (let [[db id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") - [db] (with-resource db "AllergyIntolerance" "0" + (let [[db id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") + [db] (test-util/with-resource db "AllergyIntolerance" "0" :AllergyIntolerance/category id)] (is (empty? @@ -1043,8 +1047,8 @@ (testing "non-primitive multi-valued single-typed element" - (let [[db id] (with-non-primitive db :HumanName/family "Doe") - [db] (with-resource db "Patient" "0" :Patient/name id)] + (let [[db id] (test-util/with-non-primitive db :HumanName/family "Doe") + [db] (test-util/with-resource db "Patient" "0" :Patient/name id)] (is (empty? (resource-upsert @@ -1054,10 +1058,10 @@ (testing "Coding" (testing "with version" - (let [[db id] (with-icd10-code db "2016" "Q14") - [db id] (with-non-primitive db :Coding/code id) - [db id] (with-non-primitive db :CodeableConcept/coding id) - [db] (with-resource db "Observation" "0" :Observation/code id)] + (let [[db id] (test-util/with-icd10-code db "2016" "Q14") + [db id] (test-util/with-non-primitive db :Coding/code id) + [db id] (test-util/with-non-primitive db :CodeableConcept/coding id) + [db] (test-util/with-resource db "Observation" "0" :Observation/code id)] (is (empty? (resource-upsert @@ -1071,10 +1075,10 @@ "code" "Q14"}]}}))))) (testing "with userSelected" - (let [[db id] (with-icd10-code db "2016" "Q14") - [db id] (with-non-primitive db :Coding/code id :Coding/userSelected true) - [db id] (with-non-primitive db :CodeableConcept/coding id) - [db] (with-resource db "Observation" "0" :Observation/code id)] + (let [[db id] (test-util/with-icd10-code db "2016" "Q14") + [db id] (test-util/with-non-primitive db :Coding/code id :Coding/userSelected true) + [db id] (test-util/with-non-primitive db :CodeableConcept/coding id) + [db] (test-util/with-resource db "Observation" "0" :Observation/code id)] (is (empty? (resource-upsert @@ -1091,7 +1095,7 @@ (testing "special Quantity type" (let [[db] - (with-resource + (test-util/with-resource db "Observation" "0" :Observation/valueQuantity (value/write (quantity 1M "m")) :Observation/value :Observation/valueQuantity)] @@ -1105,8 +1109,8 @@ (testing "single-valued special Reference type" - (let [[db id] (with-resource db "Patient" "0") - [db] (with-resource db "Observation" "0" :Observation/subject id)] + (let [[db id] (test-util/with-resource db "Patient" "0") + [db] (test-util/with-resource db "Observation" "0" :Observation/subject id)] (is (empty? (resource-upsert @@ -1117,10 +1121,10 @@ (testing "CodeSystem with contact" - (let [[db id] (with-code db "http://hl7.org/fhir/contact-point-system" "url") - [db id] (with-non-primitive db :ContactPoint/system id) - [db id] (with-non-primitive db :ContactDetail/telecom id) - [db] (with-resource db "CodeSystem" "0" :CodeSystem/contact id)] + (let [[db id] (test-util/with-code db "http://hl7.org/fhir/contact-point-system" "url") + [db id] (test-util/with-non-primitive db :ContactPoint/system id) + [db id] (test-util/with-non-primitive db :ContactDetail/telecom id) + [db] (test-util/with-resource db "CodeSystem" "0" :CodeSystem/contact id)] (is (empty? (resource-upsert @@ -1133,8 +1137,8 @@ (testing "Contained resources" - (let [[db id] (with-non-primitive db :Patient/active true :local-id "0") - [db] (with-resource db "Patient" "0" :Patient/contained id)] + (let [[db id] (test-util/with-non-primitive db :Patient/active true :local-id "0") + [db] (test-util/with-resource db "Patient" "0" :Patient/contained id)] (is (empty? (resource-upsert @@ -1148,8 +1152,8 @@ (testing "ignores display on Reference" - (let [[db actor-id] (with-resource db "Location" "0") - [db] (with-resource db "Schedule" "0" :Schedule/actor actor-id)] + (let [[db actor-id] (test-util/with-resource db "Location" "0") + [db] (test-util/with-resource db "Schedule" "0" :Schedule/actor actor-id)] (is (empty? (with-redefs [d/tempid (fn [partition] partition)] @@ -1167,7 +1171,7 @@ (testing "primitive single-valued single-typed element" (testing "with boolean type" - (let [[db id] (with-resource db "Patient" "0" :Patient/active false)] + (let [[db id] (test-util/with-resource db "Patient" "0" :Patient/active false)] (is (= (resource-upsert @@ -1177,9 +1181,9 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with code type" - (let [[db male-id] (with-gender-code db "male") - [db female-id] (with-gender-code db "female") - [db id] (with-resource db "Patient" "0" :Patient/gender male-id)] + (let [[db male-id] (test-util/with-gender-code db "male") + [db female-id] (test-util/with-gender-code db "female") + [db id] (test-util/with-resource db "Patient" "0" :Patient/gender male-id)] (is (= (resource-upsert @@ -1192,7 +1196,7 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with date type" - (let [[db id] (with-resource db "Patient" "0" :Patient/birthDate + (let [[db id] (test-util/with-resource db "Patient" "0" :Patient/birthDate (value/write (Year/of 2000)))] (is (= @@ -1208,7 +1212,7 @@ (testing "primitive multi-valued single-typed element" (testing "with one value" (let [[db id] - (with-resource + (test-util/with-resource db "ServiceRequest" "0" :ServiceRequest/instantiatesUri "foo")] (is (= (resource-upsert @@ -1222,7 +1226,7 @@ (testing "with multiple values" (let [[db id] - (with-resource + (test-util/with-resource db "ServiceRequest" "0" :ServiceRequest/instantiatesUri #{"one" "two" "three"})] (is @@ -1236,9 +1240,9 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with code type" - (let [[db medication-id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") - [db food-id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "food") - [db id] (with-resource db "AllergyIntolerance" "0" + (let [[db medication-id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") + [db food-id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "food") + [db id] (test-util/with-resource db "AllergyIntolerance" "0" :AllergyIntolerance/category medication-id)] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -1256,7 +1260,7 @@ (testing "single-valued choice-typed element" (testing "with string choice" (let [[db id] - (with-resource db "Observation" "0" + (test-util/with-resource db "Observation" "0" :Observation/valueString "foo" :Observation/value :Observation/valueString)] (is @@ -1270,7 +1274,7 @@ (testing "switch from string choice to boolean choice" (let [[db id] - (with-resource db "Observation" "0" + (test-util/with-resource db "Observation" "0" :Observation/valueString "foo" :Observation/value :Observation/valueString)] (is @@ -1285,7 +1289,7 @@ (testing "switch from string choice to CodeableConcept choice" (let [[db id] - (with-resource db "Observation" "0" + (test-util/with-resource db "Observation" "0" :Observation/valueString "foo" :Observation/value :Observation/valueString)] (is @@ -1304,9 +1308,9 @@ (testing "non-primitive single-valued single-typed element" (let [[db status-id] - (with-non-primitive db :CodeableConcept/text "married") + (test-util/with-non-primitive db :CodeableConcept/text "married") [db id] - (with-resource db "Patient" "0" :Patient/maritalStatus status-id)] + (test-util/with-resource db "Patient" "0" :Patient/maritalStatus status-id)] (is (= (resource-upsert @@ -1320,9 +1324,9 @@ (testing "non-primitive multi-valued single-typed element" (testing "with primitive single-valued single-typed child element" - (let [[db name-id] (with-non-primitive db :HumanName/family "foo") + (let [[db name-id] (test-util/with-non-primitive db :HumanName/family "foo") [db patient-id] - (with-resource db "Patient" "0" :Patient/name name-id)] + (test-util/with-resource db "Patient" "0" :Patient/name name-id)] (is (= (resource-upsert @@ -1332,9 +1336,9 @@ [:db.fn/cas patient-id :instance/version -3 -7]])))) (testing "with primitive multi-valued single-typed child element" - (let [[db name-id] (with-non-primitive db :HumanName/given "foo") + (let [[db name-id] (test-util/with-non-primitive db :HumanName/given "foo") [db patient-id] - (with-resource db "Patient" "0" :Patient/name name-id)] + (test-util/with-resource db "Patient" "0" :Patient/name name-id)] (is (= (resource-upsert @@ -1344,9 +1348,9 @@ [:db/add name-id :HumanName/given "bar"] [:db.fn/cas patient-id :instance/version -3 -7]]))) - (let [[db name-id] (with-non-primitive db :HumanName/given "foo") + (let [[db name-id] (test-util/with-non-primitive db :HumanName/given "foo") [db patient-id] - (with-resource db "Patient" "0" :Patient/name name-id)] + (test-util/with-resource db "Patient" "0" :Patient/name name-id)] (is (= (resource-upsert @@ -1356,11 +1360,11 @@ [:db.fn/cas patient-id :instance/version -3 -7]]))))) (testing "Coding" - (let [[db amb-id] (with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "AMB") - [db emer-id] (with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "EMER") - [db coding-id] (with-non-primitive db :Coding/code amb-id) + (let [[db amb-id] (test-util/with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "AMB") + [db emer-id] (test-util/with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "EMER") + [db coding-id] (test-util/with-non-primitive db :Coding/code amb-id) [db encounter-id] - (with-resource db "Encounter" "0" :Encounter/class coding-id)] + (test-util/with-resource db "Encounter" "0" :Encounter/class coding-id)] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -1376,9 +1380,9 @@ (testing "single-valued special Reference type" - (let [[db patient-0-id] (with-resource db "Patient" "0") - [db patient-1-id] (with-resource db "Patient" "1") - [db observation-id] (with-resource db "Observation" "0" :Observation/subject patient-0-id)] + (let [[db patient-0-id] (test-util/with-resource db "Patient" "0") + [db patient-1-id] (test-util/with-resource db "Patient" "1") + [db observation-id] (test-util/with-resource db "Observation" "0" :Observation/subject patient-0-id)] (is (= (resource-upsert @@ -1392,9 +1396,9 @@ (testing "Contained resources" (testing "with changes inside the contained resource" - (let [[db contained-id] (with-non-primitive db :Patient/active false + (let [[db contained-id] (test-util/with-non-primitive db :Patient/active false :local-id "0") - [db id] (with-resource db "Observation" "0" + [db id] (test-util/with-resource db "Observation" "0" :Observation/contained contained-id :Observation/subject contained-id)] (is @@ -1412,11 +1416,11 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with changes inside the container resource" - (let [[db contained-id] (with-non-primitive db :Patient/active true + (let [[db contained-id] (test-util/with-non-primitive db :Patient/active true :local-id "0") - [db preliminary-id] (with-code db "http://hl7.org/fhir/observation-status" "preliminary") - [db final-id] (with-code db "http://hl7.org/fhir/observation-status" "final") - [db id] (with-resource db "Observation" "0" + [db preliminary-id] (test-util/with-code db "http://hl7.org/fhir/observation-status" "preliminary") + [db final-id] (test-util/with-code db "http://hl7.org/fhir/observation-status" "final") + [db id] (test-util/with-resource db "Observation" "0" :Observation/status preliminary-id :Observation/contained contained-id :Observation/subject contained-id)] @@ -1439,17 +1443,17 @@ (testing "Don't reuse old entities or new entities more than once" (let [[db component-1-id] - (with-non-primitive + (test-util/with-non-primitive db :Observation.component/valueQuantity (value/write (quantity 1M "")) :Observation.component/value :Observation.component/valueQuantity) [db component-2-id] - (with-non-primitive + (test-util/with-non-primitive db :Observation.component/valueQuantity (value/write (quantity 2M "")) :Observation.component/value :Observation.component/valueQuantity) [db observation-id] - (with-resource db "Observation" "0" :Observation/component + (test-util/with-resource db "Observation" "0" :Observation/component #{component-1-id component-2-id})] (is (= @@ -1480,9 +1484,9 @@ (testing "multi-valued code element" - (let [[db medication-id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") - [db food-id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "food") - [db id] (with-resource db "AllergyIntolerance" "0" + (let [[db medication-id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") + [db food-id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "food") + [db id] (test-util/with-resource db "AllergyIntolerance" "0" :AllergyIntolerance/category medication-id)] (is (= (with-redefs [d/tempid (fn [partition] partition)] @@ -1501,7 +1505,7 @@ (testing "primitive single-valued single-typed element" (testing "with boolean type" - (let [[db id] (with-resource db "Patient" "0" :Patient/active false)] + (let [[db id] (test-util/with-resource db "Patient" "0" :Patient/active false)] (is (= (resource-upsert @@ -1511,9 +1515,9 @@ [:db.fn/cas id :instance/version -3 -7]])))) (testing "with code type" - (let [[db gender-id] (with-gender-code db "male") + (let [[db gender-id] (test-util/with-gender-code db "male") [db patient-id] - (with-resource db "Patient" "0" :Patient/gender gender-id)] + (test-util/with-resource db "Patient" "0" :Patient/gender gender-id)] (is (= (resource-upsert @@ -1523,7 +1527,7 @@ [:db.fn/cas patient-id :instance/version -3 -7]])))) (testing "with date type" - (let [[db id] (with-resource db "Patient" "0" :Patient/birthDate + (let [[db id] (test-util/with-resource db "Patient" "0" :Patient/birthDate (value/write (Year/of 2000)))] (is (= @@ -1537,9 +1541,9 @@ (testing "non-primitive single-valued single-typed element" (let [[db status-id] - (with-non-primitive db :CodeableConcept/text "married") + (test-util/with-non-primitive db :CodeableConcept/text "married") [db patient-id] - (with-resource db "Patient" "0" :Patient/maritalStatus status-id)] + (test-util/with-resource db "Patient" "0" :Patient/maritalStatus status-id)] (is (= (resource-upsert @@ -1551,8 +1555,8 @@ (testing "non-primitive multi-valued element" - (let [[db name-id] (with-non-primitive db :HumanName/family "Doe") - [db patient-id] (with-resource db "Patient" "0" :Patient/name name-id)] + (let [[db name-id] (test-util/with-non-primitive db :HumanName/family "Doe") + [db patient-id] (test-util/with-resource db "Patient" "0" :Patient/name name-id)] (is (= (resource-upsert @@ -1562,8 +1566,8 @@ [:db/retract patient-id :Patient/name name-id] [:db.fn/cas patient-id :instance/version -3 -7]]))) - (let [[db name-id] (with-non-primitive db :HumanName/family "Doe") - [db patient-id] (with-resource db "Patient" "0" :Patient/name name-id)] + (let [[db name-id] (test-util/with-non-primitive db :HumanName/family "Doe") + [db patient-id] (test-util/with-resource db "Patient" "0" :Patient/name name-id)] (is (= (resource-upsert @@ -1576,7 +1580,7 @@ (testing "single-valued choice-typed element" (let [[db id] - (with-resource db "Observation" "0" + (test-util/with-resource db "Observation" "0" :Observation/valueString "foo" :Observation/value :Observation/valueString)] (is @@ -1591,10 +1595,10 @@ (testing "primitive single-valued element in single-valued backbone element" (let [[db software-id] - (with-non-primitive + (test-util/with-non-primitive db :TerminologyCapabilities.software/name "foo") [db capabilities-id] - (with-resource + (test-util/with-resource db "TerminologyCapabilities" "0" :TerminologyCapabilities/software software-id)] (is @@ -1610,9 +1614,9 @@ (testing "primitive single-valued element in multi-valued backbone element" (let [[db communication-id] - (with-non-primitive db :Patient.communication/preferred true) + (test-util/with-non-primitive db :Patient.communication/preferred true) [db patient-id] - (with-resource + (test-util/with-resource db "Patient" "0" :Patient/communication communication-id)] (is (= @@ -1627,11 +1631,11 @@ (testing "Coding" (let [[db code-id] - (with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" + (test-util/with-code db "http://terminology.hl7.org/CodeSystem/v3-ActCode" "AMB") - [db coding-id] (with-non-primitive db :Coding/code code-id) + [db coding-id] (test-util/with-non-primitive db :Coding/code code-id) [db encounter-id] - (with-resource db "Encounter" "0" :Encounter/class coding-id)] + (test-util/with-resource db "Encounter" "0" :Encounter/class coding-id)] (is (= (resource-upsert @@ -1644,11 +1648,11 @@ (testing "Contained resources" (testing "retracts all contained resources" - (let [[db contained-1-id] (with-non-primitive db :Patient/active true + (let [[db contained-1-id] (test-util/with-non-primitive db :Patient/active true :local-id "1") - [db contained-2-id] (with-non-primitive db :Patient/active false + [db contained-2-id] (test-util/with-non-primitive db :Patient/active false :local-id "2") - [db id] (with-resource db "Patient" "0" :Patient/contained + [db id] (test-util/with-resource db "Patient" "0" :Patient/contained #{contained-1-id contained-2-id})] (is (= @@ -1670,7 +1674,7 @@ (testing "Fails" (testing "on non-existing reference target" - (let [[db] (with-resource db "Observation" "0")] + (let [[db] (test-util/with-resource db "Observation" "0")] (try (resource-upsert db nil :server-assigned-id @@ -1684,14 +1688,14 @@ (deftest resource-deletion-test (testing "Decrements version and sets deletion bit" - (let [[db id] (with-resource db "Patient" "0")] + (let [[db id] (test-util/with-resource db "Patient" "0")] (is (= (resource-deletion db "Patient" "0") [[:db.fn/cas id :instance/version -3 -5]])))) (testing "Does nothing on subsequent delete" - (let [[db] (with-deleted-resource db "Patient" "0")] + (let [[db] (test-util/with-deleted-resource db "Patient" "0")] (is (empty? (resource-deletion db "Patient" "0"))))) @@ -1699,7 +1703,7 @@ (testing "primitive single-valued single-typed element" (testing "with boolean type" - (let [[db id] (with-resource db "Patient" "0" :Patient/active true)] + (let [[db id] (test-util/with-resource db "Patient" "0" :Patient/active true)] (is (= (resource-deletion db "Patient" "0") @@ -1707,9 +1711,9 @@ [:db/retract id :Patient/active true]])))) (testing "with code type" - (let [[db gender-id] (with-gender-code db "male") + (let [[db gender-id] (test-util/with-gender-code db "male") [db patient-id] - (with-resource db "Patient" "0" :Patient/gender gender-id)] + (test-util/with-resource db "Patient" "0" :Patient/gender gender-id)] (is (= (resource-deletion db "Patient" "0") @@ -1719,7 +1723,7 @@ (testing "primitive multi-valued single-typed element" (testing "with one value" (let [[db id] - (with-resource + (test-util/with-resource db "ServiceRequest" "0" :ServiceRequest/instantiatesUri "foo")] (is (= (resource-deletion db "ServiceRequest" "0") @@ -1728,7 +1732,7 @@ (testing "with multiple values" (let [[db id] - (with-resource + (test-util/with-resource db "ServiceRequest" "0" :ServiceRequest/instantiatesUri #{"one" "two"})] (is @@ -1738,9 +1742,9 @@ [:db/retract id :ServiceRequest/instantiatesUri "two"]})))) (testing "with code type" - (let [[db medication-id] (with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") + (let [[db medication-id] (test-util/with-code db "http://hl7.org/fhir/allergy-intolerance-category" "medication") [db id] - (with-resource + (test-util/with-resource db "AllergyIntolerance" "0" :AllergyIntolerance/category medication-id)] (is @@ -1750,9 +1754,9 @@ (testing "non-primitive single-valued single-typed element" (let [[db status-id] - (with-non-primitive db :CodeableConcept/text "married") + (test-util/with-non-primitive db :CodeableConcept/text "married") [db patient-id] - (with-resource db "Patient" "0" :Patient/maritalStatus status-id)] + (test-util/with-resource db "Patient" "0" :Patient/maritalStatus status-id)] (is (= (resource-deletion db "Patient" "0") @@ -1761,8 +1765,8 @@ [:db/retract patient-id :Patient/maritalStatus status-id]])))) (testing "non-primitive multi-valued element" - (let [[db name-id] (with-non-primitive db :HumanName/family "Doe") - [db patient-id] (with-resource db "Patient" "0" :Patient/name name-id)] + (let [[db name-id] (test-util/with-non-primitive db :HumanName/family "Doe") + [db patient-id] (test-util/with-resource db "Patient" "0" :Patient/name name-id)] (is (= (resource-deletion db "Patient" "0") @@ -2069,11 +2073,14 @@ (deftest transact-async-test (testing "Returns error deferred with anomaly on CAS Failed" - (let [conn (connect)] + (let [conn (test-util/connect)] @(d/transact-async conn [{:Patient/id "0" :instance/version 0}]) @(d/transact-async conn [[:db.fn/cas [:Patient/id "0"] :instance/version 0 1]]) - @(-> (transact-async conn [[:db.fn/cas [:Patient/id "0"] :instance/version 0 1]]) + @(-> (transact-async + transaction-executor + conn + [[:db.fn/cas [:Patient/id "0"] :instance/version 0 1]]) (md/catch' (fn [{::anom/keys [category]}] (is (= ::anom/conflict category)))))))) diff --git a/test/blaze/datomic/util_test.clj b/modules/datomic/test/blaze/datomic/util_test.clj similarity index 92% rename from test/blaze/datomic/util_test.clj rename to modules/datomic/test/blaze/datomic/util_test.clj index 9ffaf0240..287386071 100644 --- a/test/blaze/datomic/util_test.clj +++ b/modules/datomic/test/blaze/datomic/util_test.clj @@ -1,9 +1,11 @@ (ns blaze.datomic.util-test (:require [blaze.datomic.test-util :as test-util] - [blaze.datomic.util :refer :all] + [blaze.datomic.util + :refer + [initial-version? instance-version system-version type-total type-version]] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :refer [deftest is testing use-fixtures]] [datomic-spec.test :as dst])) diff --git a/test/blaze/datomic/value_test.clj b/modules/datomic/test/blaze/datomic/value_test.clj similarity index 78% rename from test/blaze/datomic/value_test.clj rename to modules/datomic/test/blaze/datomic/value_test.clj index 84865c0d9..a6fc1e4f9 100644 --- a/test/blaze/datomic/value_test.clj +++ b/modules/datomic/test/blaze/datomic/value_test.clj @@ -1,12 +1,12 @@ (ns blaze.datomic.value-test (:require - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] - [clojure.test.check.generators :as gen] - [clojure.test.check.properties :as prop] [blaze.datomic.quantity :refer [quantity]] [blaze.datomic.value :refer [read write]] - [blaze.test-util :refer [satisfies-prop]]) + [clojure.spec.test.alpha :as st] + [clojure.test :refer [are deftest is testing]] + [clojure.test.check :as tc] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop]) (:refer-clojure :exclude [read])) @@ -20,6 +20,15 @@ (BigDecimal/valueOf ^long unscaled scale))))) +(defmacro satisfies-prop [num-tests prop] + `(let [result# (tc/quick-check ~num-tests ~prop)] + (if (instance? Throwable (:result result#)) + (throw (:result result#)) + (if (true? (:result result#)) + (is :success) + (is (clojure.pprint/pprint result#)))))) + + (deftest decimal-test (testing "Read/Write" (satisfies-prop 10000 diff --git a/modules/datomic/tests.edn b/modules/datomic/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/datomic/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/executor/deps.edn b/modules/executor/deps.edn new file mode 100644 index 000000000..5aeab72af --- /dev/null +++ b/modules/executor/deps.edn @@ -0,0 +1 @@ +{:deps {}} diff --git a/src/blaze/executors.clj b/modules/executor/src/blaze/executors.clj similarity index 96% rename from src/blaze/executors.clj rename to modules/executor/src/blaze/executors.clj index 377a2aff6..139cad4d5 100644 --- a/src/blaze/executors.clj +++ b/modules/executor/src/blaze/executors.clj @@ -51,5 +51,8 @@ (Thread. ^Runnable r ^String (thread-name name-template)))))) +(s/fdef single-thread-executor + :args (s/cat)) + (defn single-thread-executor [] (Executors/newSingleThreadExecutor)) diff --git a/modules/extern-terminology-service/README.md b/modules/extern-terminology-service/README.md new file mode 100644 index 000000000..d2e2fdc51 --- /dev/null +++ b/modules/extern-terminology-service/README.md @@ -0,0 +1,3 @@ +# Blaze Extern Terminology Service + +This module contains an implementation of the protocol `blaze.terminology-service/TermService`. It forwards requests to an external terminology service. diff --git a/modules/extern-terminology-service/deps.edn b/modules/extern-terminology-service/deps.edn new file mode 100644 index 000000000..fc913e96d --- /dev/null +++ b/modules/extern-terminology-service/deps.edn @@ -0,0 +1,21 @@ +{:deps + {blaze/fhir-client + {:local/root "../fhir-client"} + + blaze/module-base + {:local/root "../module-base"} + + blaze/terminology-service + {:local/root "../terminology-service"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:mvn/version "0.7.0"} + + org.clojure/core.cache + {:mvn/version "0.8.1"} + + prom-metrics + {:mvn/version "0.5-alpha2"}}} diff --git a/src/blaze/terminology_service/extern.clj b/modules/extern-terminology-service/src/blaze/terminology_service/extern.clj similarity index 69% rename from src/blaze/terminology_service/extern.clj rename to modules/extern-terminology-service/src/blaze/terminology_service/extern.clj index 82f9bba35..98f28eddd 100644 --- a/src/blaze/terminology_service/extern.clj +++ b/modules/extern-terminology-service/src/blaze/terminology_service/extern.clj @@ -2,12 +2,13 @@ (:require [aleph.http :as http] [aleph.http.client-middleware :as client-middleware] - [blaze.executors :refer [executor?]] [blaze.fhir-client :as client] + [blaze.module :refer [defcollector]] [blaze.terminology-service :as ts :refer [term-service?]] [clojure.core.cache :as cache] [clojure.spec.alpha :as s] [cognitect.anomalies :as anom] + [integrant.core :as ig] [manifold.deferred :as md] [prometheus.alpha :as prom :refer [defcounter defhistogram]] [taoensso.timbre :as log]) @@ -123,8 +124,12 @@ (s/def ::proxy-options - (s/keys :opt-un [:proxy-options/host :proxy-options/port - :proxy-options/user :proxy-options/password])) + (s/keys + :opt-un + [:proxy-options/host + :proxy-options/port + :proxy-options/user + :proxy-options/password])) (s/def ::milli-second @@ -139,3 +144,74 @@ (defn term-service [base proxy-options connection-timeout request-timeout] (->TermService base (opts proxy-options connection-timeout request-timeout))) + + +(s/def ::uri + string?) + + +(s/def ::connection-timeout + (s/nilable ::milli-second)) + + +(s/def ::request-timeout + (s/nilable ::milli-second)) + + +(defmethod ig/pre-init-spec :blaze.terminology-service/extern [_] + (s/keys + :req-un + [::uri] + :opt-un + [:proxy-options/host + :proxy-options/port + :proxy-options/user + :proxy-options/password + ::connection-timeout + ::request-timeout])) + + +(defmethod ig/init-key :blaze.terminology-service/extern + [_ + {:keys + [uri + proxy-host + proxy-port + proxy-user + proxy-password + connection-timeout + request-timeout]}] + (log/info + (cond-> + (str "Init terminology server connection: " uri) + proxy-host + (str " using proxy host " proxy-host) + proxy-port + (str ", port " proxy-port) + proxy-user + (str ", user " proxy-user) + proxy-password + (str ", password ***") + connection-timeout + (str ", connection timeout " connection-timeout " ms") + request-timeout + (str ", request timeout " request-timeout " ms"))) + (term-service + uri + (cond-> {} + proxy-host (assoc :host proxy-host) + proxy-port (assoc :port proxy-port) + proxy-user (assoc :user proxy-user) + proxy-password (assoc :password proxy-password)) + connection-timeout request-timeout)) + + +(derive :blaze.terminology-service/extern :blaze/terminology-service) + + +(defcollector errors-total [_] + errors-total) + + +(defcollector request-duration-seconds [_] + request-duration-seconds) diff --git a/modules/fhir-client/deps.edn b/modules/fhir-client/deps.edn new file mode 100644 index 000000000..0cae2bfab --- /dev/null +++ b/modules/fhir-client/deps.edn @@ -0,0 +1,27 @@ +{:deps + {aleph + {:mvn/version "0.4.7-alpha1" + :exclusions + [io.netty/netty-codec + io.netty/netty-resolver + io.netty/netty-handler + io.netty/netty-transport + io.netty/netty-transport-native-epoll]} + + cheshire + {:mvn/version "5.9.0"} + + com.cognitect/anomalies + {:mvn/version "0.1.12"} + + io.netty/netty-codec-http + {:mvn/version "4.1.39.Final"} + + io.netty/netty-handler-proxy + {:mvn/version "4.1.39.Final"} + + io.netty/netty-resolver-dns + {:mvn/version "4.1.39.Final"} + + io.netty/netty-transport-native-epoll$linux-x86_64 + {:mvn/version "4.1.39.Final"}}} diff --git a/src/blaze/fhir_client.clj b/modules/fhir-client/src/blaze/fhir_client.clj similarity index 100% rename from src/blaze/fhir_client.clj rename to modules/fhir-client/src/blaze/fhir_client.clj diff --git a/modules/interaction/deps.edn b/modules/interaction/deps.edn new file mode 100644 index 000000000..71c7e71bc --- /dev/null +++ b/modules/interaction/deps.edn @@ -0,0 +1,38 @@ +{:deps + {blaze/executor + {:local/root "../executor"} + + blaze/rest-util + {:local/root "../rest-util"} + + blaze/spec + {:local/root "../spec"} + + com.cognitect/anomalies + {:mvn/version "0.1.12"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:mvn/version "0.7.0"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {blaze/datomic-test-util + {:local/root "../datomic-test-util"} + + lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/src/blaze/handler/fhir/capabilities.clj b/modules/interaction/src/blaze/interaction/capabilities.clj similarity index 91% rename from src/blaze/handler/fhir/capabilities.clj rename to modules/interaction/src/blaze/interaction/capabilities.clj index 0cd1321a1..38b5d4fc3 100644 --- a/src/blaze/handler/fhir/capabilities.clj +++ b/modules/interaction/src/blaze/interaction/capabilities.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.capabilities +(ns blaze.interaction.capabilities "FHIR capabilities interaction. https://www.hl7.org/fhir/http.html#capabilities @@ -7,6 +7,8 @@ readability." (:require [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] + [blaze.spec] + [blaze.structure-definition] [clojure.spec.alpha :as s] [ring.util.response :as ring])) @@ -50,8 +52,11 @@ (s/fdef handler - :args (s/cat :base-url string? :version string? - :structure-definitions (s/coll-of :fhir.un/StructureDefinition)) + :args + (s/cat + :base-url :blaze/base-url + :version string? + :structure-definitions (s/coll-of :fhir.un/StructureDefinition)) :ret :handler.fhir/capabilities) (defn handler diff --git a/src/blaze/handler/fhir/create.clj b/modules/interaction/src/blaze/interaction/create.clj similarity index 61% rename from src/blaze/handler/fhir/create.clj rename to modules/interaction/src/blaze/interaction/create.clj index 474e2079a..3ca165664 100644 --- a/src/blaze/handler/fhir/create.clj +++ b/modules/interaction/src/blaze/interaction/create.clj @@ -1,8 +1,9 @@ -(ns blaze.handler.fhir.create +(ns blaze.interaction.create "FHIR create interaction. https://www.hl7.org/fhir/http.html#create" (:require + [blaze.executors :refer [executor?]] [blaze.fhir.response.create :as response] [blaze.handler.fhir.util :as handler-fhir-util] [blaze.handler.util :as handler-util] @@ -12,8 +13,10 @@ [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [manifold.deferred :as md] - [reitit.core :as reitit])) + [reitit.core :as reitit] + [taoensso.timbre :as log])) (defn- validate-resource [type body] @@ -34,15 +37,22 @@ body)) -(defn- handler-intern [conn term-service] - (fn [{{:keys [type]} :path-params :keys [headers body] ::reitit/keys [router]}] +(defn- handler-intern [transaction-executor conn term-service] + (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match + :keys [headers body] + ::reitit/keys [router]}] (let [return-preference (handler-util/preference headers "return") id (str (d/squuid))] (-> (validate-resource type body) (md/chain' #(assoc % "id" id)) (md/chain' #(handler-fhir-util/upsert-resource - conn term-service (d/db conn) :server-assigned-id %)) + transaction-executor + conn + term-service + (d/db conn) + :server-assigned-id + %)) (md/chain' #(response/build-created-response router return-preference (:db-after %) type id)) @@ -53,11 +63,21 @@ (s/fdef handler - :args (s/cat :conn ::ds/conn :term-service term-service?) + :args + (s/cat + :transaction-executor executor? + :conn ::ds/conn + :term-service term-service?) :ret :handler.fhir/create) (defn handler "" - [conn term-service] - (-> (handler-intern conn term-service) + [transaction-executor conn term-service] + (-> (handler-intern transaction-executor conn term-service) (wrap-observe-request-duration "create"))) + + +(defmethod ig/init-key :blaze.interaction/create + [_ {:database/keys [transaction-executor conn] :keys [term-service]}] + (log/info "Init FHIR create interaction handler") + (handler transaction-executor conn term-service)) diff --git a/src/blaze/handler/fhir/delete.clj b/modules/interaction/src/blaze/interaction/delete.clj similarity index 59% rename from src/blaze/handler/fhir/delete.clj rename to modules/interaction/src/blaze/interaction/delete.clj index ff8faf32f..d8ed2949f 100644 --- a/src/blaze/handler/fhir/delete.clj +++ b/modules/interaction/src/blaze/interaction/delete.clj @@ -1,9 +1,10 @@ -(ns blaze.handler.fhir.delete +(ns blaze.interaction.delete "FHIR delete interaction. https://www.hl7.org/fhir/http.html#delete" (:require [blaze.datomic.util :as util] + [blaze.executors :refer [executor?]] [blaze.handler.fhir.util :as handler-fhir-util] [blaze.handler.util :as handler-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] @@ -11,16 +12,25 @@ [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [manifold.deferred :as md] + [reitit.core :as reitit] [ring.util.response :as ring] - [ring.util.time :as ring-time])) + [ring.util.time :as ring-time] + [taoensso.timbre :as log])) -(defn- handler-intern [conn] - (fn [{{:keys [type id]} :path-params}] +(defn- handler-intern [transaction-executor conn] + (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match + {:keys [id]} :path-params}] (let [db (d/db conn)] (if (util/resource db type id) - (-> (handler-fhir-util/delete-resource conn db type id) + (-> (handler-fhir-util/delete-resource + transaction-executor + conn + db + type + id) (md/chain' (fn [{db :db-after}] (let [last-modified (:db/txInstant (util/basis-transaction db))] @@ -37,11 +47,17 @@ (s/fdef handler - :args (s/cat :conn ::ds/conn) + :args (s/cat :transaction-executor executor? :conn ::ds/conn) :ret :handler.fhir/delete) (defn handler "" - [conn] - (-> (handler-intern conn) + [transaction-executor conn] + (-> (handler-intern transaction-executor conn) (wrap-observe-request-duration "delete"))) + + +(defmethod ig/init-key :blaze.interaction/delete + [_ {:database/keys [transaction-executor conn]}] + (log/info "Init FHIR delete interaction handler") + (handler transaction-executor conn)) diff --git a/src/blaze/handler/fhir/history_instance.clj b/modules/interaction/src/blaze/interaction/history/instance.clj similarity index 85% rename from src/blaze/handler/fhir/history_instance.clj rename to modules/interaction/src/blaze/interaction/history/instance.clj index 7b014a773..fe53c7345 100644 --- a/src/blaze/handler/fhir/history_instance.clj +++ b/modules/interaction/src/blaze/interaction/history/instance.clj @@ -1,21 +1,23 @@ -(ns blaze.handler.fhir.history-instance +(ns blaze.interaction.history.instance "FHIR history interaction on a single resource. https://www.hl7.org/fhir/http.html#history" (:require [blaze.datomic.util :as util] - [blaze.handler.fhir.history.util :as history-util] [blaze.handler.fhir.util :as fhir-util] [blaze.handler.util :as handler-util] + [blaze.interaction.history.util :as history-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] [clojure.spec.alpha :as s] [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [manifold.deferred :as md] [reitit.core :as reitit] [ring.middleware.params :refer [wrap-params]] - [ring.util.response :as ring])) + [ring.util.response :as ring] + [taoensso.timbre :as log])) (defn- resource-eid [db type id] @@ -80,8 +82,9 @@ (defn- handler-intern [conn] (fn [{::reitit/keys [router match] :keys [query-params] - {:keys [type id]} :path-params}] - (-> (history-util/db conn (fhir-util/t query-params)) + {{:fhir.resource/keys [type]} :data} ::reitit/match + {:keys [id]} :path-params}] + (-> (handler-util/db conn (fhir-util/t query-params)) (md/chain' #(handle router match query-params % type id))))) @@ -98,3 +101,9 @@ (-> (handler-intern conn) (wrap-params) (wrap-observe-request-duration "history-instance"))) + + +(defmethod ig/init-key :blaze.interaction.history/instance + [_ {:database/keys [conn]}] + (log/info "Init FHIR history instance interaction handler") + (handler conn)) diff --git a/src/blaze/handler/fhir/history_system.clj b/modules/interaction/src/blaze/interaction/history/system.clj similarity index 89% rename from src/blaze/handler/fhir/history_system.clj rename to modules/interaction/src/blaze/interaction/history/system.clj index edd4b0bd8..27fdcc5bb 100644 --- a/src/blaze/handler/fhir/history_system.clj +++ b/modules/interaction/src/blaze/interaction/history/system.clj @@ -1,19 +1,22 @@ -(ns blaze.handler.fhir.history-system +(ns blaze.interaction.history.system "FHIR history interaction on thw whole system. https://www.hl7.org/fhir/http.html#history" (:require [blaze.datomic.util :as datomic-util] - [blaze.handler.fhir.history.util :as history-util] + [blaze.handler.util :as util] [blaze.handler.fhir.util :as fhir-util] + [blaze.interaction.history.util :as history-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] [clojure.spec.alpha :as s] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [manifold.deferred :as md] [reitit.core :as reitit] [ring.middleware.params :refer [wrap-params]] - [ring.util.response :as ring])) + [ring.util.response :as ring] + [taoensso.timbre :as log])) (defn- total @@ -95,7 +98,7 @@ (defn- handler-intern [conn] (fn [{::reitit/keys [router match] :keys [query-params]}] - (-> (history-util/db conn (fhir-util/t query-params)) + (-> (util/db conn (fhir-util/t query-params)) (md/chain' #(handle router match query-params %))))) @@ -112,3 +115,9 @@ (-> (handler-intern conn) (wrap-params) (wrap-observe-request-duration "history-system"))) + + +(defmethod ig/init-key :blaze.interaction.history/system + [_ {:database/keys [conn]}] + (log/info "Init FHIR history system interaction handler") + (handler conn)) diff --git a/src/blaze/handler/fhir/history_type.clj b/modules/interaction/src/blaze/interaction/history/type.clj similarity index 87% rename from src/blaze/handler/fhir/history_type.clj rename to modules/interaction/src/blaze/interaction/history/type.clj index cb7a3a68c..8283d394e 100644 --- a/src/blaze/handler/fhir/history_type.clj +++ b/modules/interaction/src/blaze/interaction/history/type.clj @@ -1,19 +1,22 @@ -(ns blaze.handler.fhir.history-type - "FHIR history interaction on thw whole system. +(ns blaze.interaction.history.type + "FHIR history interaction on the whole system. https://www.hl7.org/fhir/http.html#history" (:require [blaze.datomic.util :as datomic-util] - [blaze.handler.fhir.history.util :as history-util] + [blaze.handler.util :as util] [blaze.handler.fhir.util :as fhir-util] + [blaze.interaction.history.util :as history-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] [clojure.spec.alpha :as s] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] + [manifold.deferred :as md] [reitit.core :as reitit] [ring.middleware.params :refer [wrap-params]] [ring.util.response :as ring] - [manifold.deferred :as md])) + [taoensso.timbre :as log])) (defn- total @@ -97,8 +100,8 @@ (defn- handler-intern [conn] (fn [{::reitit/keys [router match] :keys [query-params] - {:keys [type]} :path-params}] - (-> (history-util/db conn (fhir-util/t query-params)) + {{:fhir.resource/keys [type]} :data} ::reitit/match}] + (-> (util/db conn (fhir-util/t query-params)) (md/chain' #(handle router match query-params % type))))) @@ -115,3 +118,9 @@ (-> (handler-intern conn) (wrap-params) (wrap-observe-request-duration "history-type"))) + + +(defmethod ig/init-key :blaze.interaction.history/type + [_ {:database/keys [conn]}] + (log/info "Init FHIR history type interaction handler") + (handler conn)) diff --git a/src/blaze/handler/fhir/history/util.clj b/modules/interaction/src/blaze/interaction/history/util.clj similarity index 88% rename from src/blaze/handler/fhir/history/util.clj rename to modules/interaction/src/blaze/interaction/history/util.clj index 29510930e..7992e46a4 100644 --- a/src/blaze/handler/fhir/history/util.clj +++ b/modules/interaction/src/blaze/interaction/history/util.clj @@ -1,13 +1,12 @@ -(ns blaze.handler.fhir.history.util +(ns blaze.interaction.history.util (:require [blaze.datomic.pull :as pull] [blaze.datomic.util :as datomic-util] - [blaze.handler.fhir.spec] [blaze.handler.fhir.util :as fhir-util] + [blaze.interaction.spec] [clojure.spec.alpha :as s] [datomic.api :as d] [datomic-spec.core :as ds] - [manifold.deferred :as md] [reitit.core :as reitit]) (:import [java.time Instant] @@ -52,11 +51,13 @@ (s/fdef nav-url - :args (s/cat :match :fhir.router/match - :query-params (s/map-of string? string?) - :t nat-int? - :transaction ::ds/entity - :eid (s/nilable ::ds/entity-id))) + :args + (s/cat + :match :fhir.router/match + :query-params (s/map-of string? string?) + :t nat-int? + :transaction ::ds/entity + :eid (s/nilable ::ds/entity-id))) (defn nav-url "Returns a nav URL with the entry of `transaction` and `eid` (optional) as @@ -116,16 +117,6 @@ (assoc :resource (pull/pull-resource* db type resource))))) -(s/fdef db - :args (s/cat :conn ::ds/conn :t (s/nilable nat-int?)) - :ret md/deferred?) - -(defn db [conn t] - (if t - (-> (d/sync conn t) (md/chain #(d/as-of % t))) - (d/db conn))) - - (s/fdef tx-db :args (s/cat :db ::ds/db :since-t (s/nilable nat-int?) :page-t (s/nilable nat-int?)) :ret ::ds/db) diff --git a/src/blaze/middleware/fhir/type.clj b/modules/interaction/src/blaze/interaction/middleware/type.clj similarity index 93% rename from src/blaze/middleware/fhir/type.clj rename to modules/interaction/src/blaze/interaction/middleware/type.clj index 5ac3f733c..90773e6b6 100644 --- a/src/blaze/middleware/fhir/type.clj +++ b/modules/interaction/src/blaze/interaction/middleware/type.clj @@ -1,4 +1,4 @@ -(ns blaze.middleware.fhir.type +(ns blaze.interaction.middleware.type (:require [blaze.datomic.util :as util] [blaze.handler.util :as handler-util] diff --git a/src/blaze/handler/fhir/read.clj b/modules/interaction/src/blaze/interaction/read.clj similarity index 85% rename from src/blaze/handler/fhir/read.clj rename to modules/interaction/src/blaze/interaction/read.clj index 5d956fab1..6d3d78821 100644 --- a/src/blaze/handler/fhir/read.clj +++ b/modules/interaction/src/blaze/interaction/read.clj @@ -1,18 +1,20 @@ -(ns blaze.handler.fhir.read +(ns blaze.interaction.read "FHIR read interaction. https://www.hl7.org/fhir/http.html#read" (:require [blaze.datomic.pull :as pull] - [blaze.datomic.util :as util] [blaze.handler.util :as handler-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] [clojure.spec.alpha :as s] [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] + [manifold.deferred :as md] + [reitit.core :as reitit] [ring.util.response :as ring] - [manifold.deferred :as md]) + [taoensso.timbre :as log]) (:import [java.time ZonedDateTime ZoneId] [java.time.format DateTimeFormatter])) @@ -46,7 +48,8 @@ (defn- handler-intern [conn] - (fn [{{:keys [type id vid]} :path-params}] + (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match + {:keys [id vid]} :path-params}] (-> (db conn vid) (md/chain' (fn [db] @@ -88,3 +91,9 @@ (-> (handler-intern conn) (wrap-interaction-name) (wrap-observe-request-duration))) + + +(defmethod ig/init-key :blaze.interaction/read + [_ {:database/keys [conn]}] + (log/info "Init FHIR read interaction handler") + (handler conn)) diff --git a/src/blaze/handler/fhir/search.clj b/modules/interaction/src/blaze/interaction/search_type.clj similarity index 85% rename from src/blaze/handler/fhir/search.clj rename to modules/interaction/src/blaze/interaction/search_type.clj index a195fd6be..e66edc1c4 100644 --- a/src/blaze/handler/fhir/search.clj +++ b/modules/interaction/src/blaze/interaction/search_type.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.search +(ns blaze.interaction.search-type "FHIR search interaction. https://www.hl7.org/fhir/http.html#search" @@ -10,9 +10,11 @@ [clojure.spec.alpha :as s] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [reitit.core :as reitit] [ring.middleware.params :refer [wrap-params]] - [ring.util.response :as ring])) + [ring.util.response :as ring] + [taoensso.timbre :as log])) ;; TODO: improve quick hack @@ -68,7 +70,9 @@ (defn- handler-intern [conn] - (fn [{{:keys [type]} :path-params :keys [params] ::reitit/keys [router]}] + (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match + :keys [params] + ::reitit/keys [router]}] (-> (search router (d/db conn) type params) (ring/response)))) @@ -86,3 +90,9 @@ (-> (handler-intern conn) (wrap-params) (wrap-observe-request-duration "search-type"))) + + +(defmethod ig/init-key :blaze.interaction/search-type + [_ {:database/keys [conn]}] + (log/info "Init FHIR search-type interaction handler") + (handler conn)) diff --git a/src/blaze/handler/fhir/spec.clj b/modules/interaction/src/blaze/interaction/spec.clj similarity index 66% rename from src/blaze/handler/fhir/spec.clj rename to modules/interaction/src/blaze/interaction/spec.clj index cc8d3e734..1b2b71be3 100644 --- a/src/blaze/handler/fhir/spec.clj +++ b/modules/interaction/src/blaze/interaction/spec.clj @@ -1,7 +1,8 @@ -(ns blaze.handler.fhir.spec +(ns blaze.interaction.spec (:require [blaze.spec] - [clojure.spec.alpha :as s])) + [clojure.spec.alpha :as s] + [integrant.core :as ig])) (s/def :fhir.router.match/data diff --git a/src/blaze/handler/fhir/transaction.clj b/modules/interaction/src/blaze/interaction/transaction.clj similarity index 89% rename from src/blaze/handler/fhir/transaction.clj rename to modules/interaction/src/blaze/interaction/transaction.clj index b25585110..49ac16c21 100644 --- a/src/blaze/handler/fhir/transaction.clj +++ b/modules/interaction/src/blaze/interaction/transaction.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.transaction +(ns blaze.interaction.transaction "FHIR batch/transaction interaction. https://www.hl7.org/fhir/http.html#transaction" @@ -7,20 +7,22 @@ [blaze.datomic.pull :as pull] [blaze.datomic.transaction :as tx] [blaze.datomic.util :as util] - [blaze.executors :as ex] + [blaze.executors :as ex :refer [executor?]] [blaze.handler.fhir.util :as fhir-util] [blaze.handler.util :as handler-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] [blaze.terminology-service :refer [term-service?]] [clojure.spec.alpha :as s] + [clojure.string :as str] [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [manifold.deferred :as md] [reitit.core :as reitit] - [reitit.ring :as reitit-ring] + [reitit.ring] [ring.util.response :as ring] - [clojure.string :as str]) + [taoensso.timbre :as log]) (:import [java.time.format DateTimeFormatter])) @@ -304,8 +306,8 @@ (defn- transact-resources - [{:keys [conn db] :as context} request-entries] - (-> (tx/transact-async conn (bundle/tx-data db request-entries)) + [{:keys [executor conn db] :as context} request-entries] + (-> (tx/transact-async executor conn (bundle/tx-data db request-entries)) (md/chain' (fn [tx-result] (mapv @@ -314,20 +316,20 @@ (defmethod process "transaction" - [{:keys [conn term-service db] :as context} _ request-entries] + [{:keys [executor conn term-service db] :as context} _ request-entries] (-> (bundle/annotate-codes term-service db request-entries) (md/chain' (fn [request-entries] (let [code-tx-data (bundle/code-tx-data db request-entries)] (if (empty? code-tx-data) (transact-resources context request-entries) - (-> (tx/transact-async conn code-tx-data) + (-> (tx/transact-async executor conn code-tx-data) (md/chain' (fn [{db :db-after}] (transact-resources (assoc context :db db) request-entries)))))))))) -(defn- handler-intern [conn term-service executor] +(defn- handler-intern [transaction-executor conn term-service executor] (fn [{{:strs [type] :as bundle} :body :keys [headers] ::reitit/keys [router]}] (let [db (d/db conn)] (-> (md/future-with executor @@ -335,7 +337,8 @@ (md/chain' (let [context {:router router - :handler (reitit-ring/ring-handler router) + :handler (reitit.ring/ring-handler router) + :executor transaction-executor :conn conn :term-service term-service :db db @@ -362,12 +365,32 @@ (s/fdef handler - :args (s/cat :conn ::ds/conn :term-service term-service? :executor ex/executor?) + :args + (s/cat + :transaction-executor executor? + :conn ::ds/conn + :term-service term-service? + :executor executor?) :ret :handler.fhir/transaction) (defn handler "" - [conn term-service executor] - (-> (handler-intern conn term-service executor) + [transaction-executor conn term-service executor] + (-> (handler-intern transaction-executor conn term-service executor) (wrap-interaction-name) (wrap-observe-request-duration))) + + +(defmethod ig/init-key :blaze.interaction.transaction/handler + [_ {:database/keys [transaction-executor conn] :keys [term-service executor]}] + (log/info "Init FHIR transaction interaction handler") + (handler transaction-executor conn term-service executor)) + + +(defmethod ig/init-key ::executor + [_ _] + (log/info "Init FHIR transaction interaction executor") + (ex/cpu-bound-pool "transaction-interaction-%d")) + + +(derive ::executor :blaze.metrics/thread-pool-executor) diff --git a/src/blaze/handler/fhir/update.clj b/modules/interaction/src/blaze/interaction/update.clj similarity index 73% rename from src/blaze/handler/fhir/update.clj rename to modules/interaction/src/blaze/interaction/update.clj index e7fe259f3..b247ceffa 100644 --- a/src/blaze/handler/fhir/update.clj +++ b/modules/interaction/src/blaze/interaction/update.clj @@ -1,10 +1,11 @@ -(ns blaze.handler.fhir.update +(ns blaze.interaction.update "FHIR update interaction. https://www.hl7.org/fhir/http.html#update" (:require [blaze.datomic.pull :as pull] [blaze.datomic.util :as util] + [blaze.executors :refer [executor?]] [blaze.handler.fhir.util :as fhir-util] [blaze.handler.util :as handler-util] [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] @@ -13,10 +14,12 @@ [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.core :as ds] + [integrant.core :as ig] [manifold.deferred :as md] [reitit.core :as reitit] [ring.util.response :as ring] - [ring.util.time :as ring-time])) + [ring.util.time :as ring-time] + [taoensso.timbre :as log])) (defn- validate-resource [type id body] @@ -66,14 +69,21 @@ "Location" (fhir-util/versioned-instance-url router type id vid))))) -(defn- handler-intern [conn term-service] - (fn [{{:keys [type id]} :path-params :keys [headers body] +(defn- handler-intern [transaction-executor conn term-service] + (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match + {:keys [id]} :path-params + :keys [headers body] ::reitit/keys [router]}] (let [db (d/db conn)] (-> (validate-resource type id body) (md/chain' #(fhir-util/upsert-resource - conn term-service db :client-assigned-id %)) + transaction-executor + conn + term-service + db + :client-assigned-id + %)) (md/chain' #(build-response router headers type id (util/resource db type id) %)) @@ -84,11 +94,21 @@ (s/fdef handler - :args (s/cat :conn ::ds/conn :term-service term-service?) + :args + (s/cat + :transaction-executor executor? + :conn ::ds/conn + :term-service term-service?) :ret :handler.fhir/update) (defn handler "" - [conn term-service] - (-> (handler-intern conn term-service) + [transaction-executor conn term-service] + (-> (handler-intern transaction-executor conn term-service) (wrap-observe-request-duration "update"))) + + +(defmethod ig/init-key :blaze.interaction/update + [_ {:database/keys [transaction-executor conn] :keys [term-service]}] + (log/info "Init FHIR update interaction handler") + (handler transaction-executor conn term-service)) diff --git a/modules/interaction/test/blaze/interaction/capabilities_test.clj b/modules/interaction/test/blaze/interaction/capabilities_test.clj new file mode 100644 index 000000000..cf8ab7e6d --- /dev/null +++ b/modules/interaction/test/blaze/interaction/capabilities_test.clj @@ -0,0 +1,19 @@ +(ns blaze.interaction.capabilities-test + (:require + [blaze.interaction.capabilities :refer [handler]] + [clojure.spec.test.alpha :as st] + [clojure.test :as test :refer [deftest is]] + [taoensso.timbre :as log])) + + +(defn fixture [f] + (st/instrument) + (log/with-merged-config {:level :error} (f)) + (st/unstrument)) + + +(test/use-fixtures :each fixture) + + +(deftest handler-test + (is (map? @((handler "foo" "bar" []) {})))) diff --git a/test/blaze/handler/fhir/create_test.clj b/modules/interaction/test/blaze/interaction/create_test.clj similarity index 58% rename from test/blaze/handler/fhir/create_test.clj rename to modules/interaction/test/blaze/interaction/create_test.clj index 4fee87994..a75fca373 100644 --- a/test/blaze/handler/fhir/create_test.clj +++ b/modules/interaction/test/blaze/interaction/create_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.create-test +(ns blaze.interaction.create-test "Specifications relevant for the FHIR create interaction: https://www.hl7.org/fhir/http.html#create @@ -6,12 +6,12 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.create :refer [handler]] - [blaze.handler.fhir.test-util :as fhir-test-util] - [blaze.fhir.response.create-test :as create-test] + [blaze.fhir.response.create :as response-create] + [blaze.interaction.create :refer [handler]] + [blaze.interaction.test-util :as test-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [manifold.deferred :as md] [reitit.core :as reitit] @@ -26,19 +26,42 @@ {:spec {`handler (s/fspec - :args (s/cat :conn #{::conn} :term-service #{::term-service}))}}) + :args + (s/cat + :transaction-executor #{::transaction-executor} + :conn #{::conn} + :term-service #{::term-service}))}}) (log/with-merged-config {:level :error} (f)) (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) + + +(defn stub-build-created-response + [router return-preference-spec db type id response] + (st/instrument + [`response-create/build-created-response] + {:spec + {`response-create/build-created-response + (s/fspec + :args + (s/cat + :router #{router} + :return-preference return-preference-spec + :db #{db} + :type #{type} + :id #{id}) + :ret #{response})} + :stub + #{`response-create/build-created-response}})) (deftest handler-test (testing "Returns Error on type mismatch" (let [{:keys [status body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient"} + @((handler ::transaction-executor ::conn ::term-service) + {::reitit/match {:data {:fhir.resource/type "Patient"}} :body {"resourceType" "Observation"}})] (is (= 400 status)) @@ -58,50 +81,54 @@ (let [id #uuid "6f9c4f5e-a9b3-40fb-871c-7b0ccddb3c99"] (datomic-test-util/stub-db ::conn ::db-before) (datomic-test-util/stub-squuid id) - (fhir-test-util/stub-upsert-resource - ::conn ::term-service ::db-before :server-assigned-id + (test-util/stub-upsert-resource + ::transaction-executor + ::conn + ::term-service + ::db-before + :server-assigned-id {"resourceType" "Patient" "id" (str id)} (md/success-deferred {:db-after ::db-after})) (testing "with no Prefer header" - (create-test/stub-build-created-response + (stub-build-created-response ::router nil? ::db-after "Patient" (str id) ::response) (is (= ::response - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} :body {"resourceType" "Patient"}})))) (testing "with return=minimal Prefer header" - (create-test/stub-build-created-response + (stub-build-created-response ::router #{"minimal"} ::db-after "Patient" (str id) ::response) (is (= ::response - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} :headers {"prefer" "return=minimal"} :body {"resourceType" "Patient"}})))) (testing "with return=representation Prefer header" - (create-test/stub-build-created-response + (stub-build-created-response ::router #{"representation"} ::db-after "Patient" (str id) ::response) (is (= ::response - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} :headers {"prefer" "return=representation"} :body {"resourceType" "Patient"}})))) (testing "with return=OperationOutcome Prefer header" - (create-test/stub-build-created-response + (stub-build-created-response ::router #{"OperationOutcome"} ::db-after "Patient" (str id) ::response) (is (= ::response - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} :headers {"prefer" "return=OperationOutcome"} :body {"resourceType" "Patient"}}))))))) diff --git a/test/blaze/handler/fhir/delete_test.clj b/modules/interaction/test/blaze/interaction/delete_test.clj similarity index 59% rename from test/blaze/handler/fhir/delete_test.clj rename to modules/interaction/test/blaze/interaction/delete_test.clj index 2ac736aa7..a43031534 100644 --- a/test/blaze/handler/fhir/delete_test.clj +++ b/modules/interaction/test/blaze/interaction/delete_test.clj @@ -1,16 +1,17 @@ -(ns blaze.handler.fhir.delete-test +(ns blaze.interaction.delete-test "Specifications relevant for the FHIR update interaction: https://www.hl7.org/fhir/http.html#delete" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.test-util :as fhir-test-util] - [blaze.handler.fhir.delete :refer [handler]] + [blaze.handler.fhir.util :as fhir-util] + [blaze.interaction.delete :refer [handler]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [manifold.deferred :as md] + [reitit.core :as reitit] [taoensso.timbre :as log])) @@ -22,13 +23,34 @@ {:spec {`handler (s/fspec - :args (s/cat :conn #{::conn}))}}) + :args + (s/cat + :transaction-executor #{::transaction-executor} + :conn #{::conn}))}}) (datomic-test-util/stub-db ::conn ::db) (log/with-merged-config {:level :error} (f)) (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) + + +(defn stub-delete-resource [transaction-executor conn db type id tx-result] + (st/instrument + [`fhir-util/delete-resource] + {:spec + {`fhir-util/delete-resource + (s/fspec + :args + (s/cat + :transaction-executor #{transaction-executor} + :conn #{conn} + :db #{db} + :type #{type} + :id #{id}) + :ret #{tx-result})} + :stub + #{`fhir-util/delete-resource}})) (deftest handler-test @@ -36,8 +58,9 @@ (datomic-test-util/stub-resource ::db #{"Patient"} #{"0"} nil?) (let [{:keys [status body]} - @((handler ::conn) - {:path-params {:type "Patient" :id "0"}})] + @((handler ::transaction-executor ::conn) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 404 status)) @@ -50,15 +73,21 @@ (testing "Returns No Content on successful deletion" (datomic-test-util/stub-resource ::db #{"Patient"} #{"0"} #{::patient}) - (fhir-test-util/stub-delete-resource - ::conn ::db "Patient" "0" (md/success-deferred {:db-after ::db-after})) + (stub-delete-resource + ::transaction-executor + ::conn + ::db + "Patient" + "0" + (md/success-deferred {:db-after ::db-after})) (datomic-test-util/stub-basis-transaction ::db-after {:db/txInstant #inst "2019-05-14T13:58:20.060-00:00"}) (datomic-test-util/stub-basis-t ::db-after 42) (let [{:keys [status headers body]} - @((handler ::conn) - {:path-params {:type "Patient" :id "0"}})] + @((handler ::transaction-executor ::conn) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 204 status)) @@ -74,15 +103,21 @@ (testing "Returns No Content on already deleted resource" (datomic-test-util/stub-resource ::db #{"Patient"} #{"0"} #{::patient}) - (fhir-test-util/stub-delete-resource - ::conn ::db "Patient" "0" (md/success-deferred {:db-after ::db})) + (stub-delete-resource + ::transaction-executor + ::conn + ::db + "Patient" + "0" + (md/success-deferred {:db-after ::db})) (datomic-test-util/stub-basis-transaction ::db {:db/txInstant #inst "2019-05-14T13:58:20.060-00:00"}) (datomic-test-util/stub-basis-t ::db 42) (let [{:keys [status headers body]} - @((handler ::conn) - {:path-params {:type "Patient" :id "0"}})] + @((handler ::transaction-executor ::conn) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 204 status)) diff --git a/test/blaze/handler/fhir/history_instance_test.clj b/modules/interaction/test/blaze/interaction/history/instance_test.clj similarity index 54% rename from test/blaze/handler/fhir/history_instance_test.clj rename to modules/interaction/test/blaze/interaction/history/instance_test.clj index f02b07cd4..f98d7889e 100644 --- a/test/blaze/handler/fhir/history_instance_test.clj +++ b/modules/interaction/test/blaze/interaction/history/instance_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.history-instance-test +(ns blaze.interaction.history.instance-test "Specifications relevant for the FHIR history interaction: https://www.hl7.org/fhir/http.html#history @@ -6,12 +6,12 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.history.test-util :as history-test-util] - [blaze.handler.fhir.history-instance :refer [handler]] - [blaze.handler.fhir.test-util :as fhir-test-util] + [blaze.interaction.history.test-util :as history-test-util] + [blaze.interaction.history.instance :refer [handler]] + [blaze.interaction.test-util :as test-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [reitit.core :as reitit] [taoensso.timbre :as log])) @@ -30,19 +30,20 @@ (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) -(deftest handler-test-0 +(deftest handler-test (testing "Returns Not Found on Non-Existing Resource" - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (datomic-test-util/stub-resource ::db #{"Patient"} #{"0"} nil?) (let [{:keys [status body]} @((handler ::conn) {:query-params ::query-params - :path-params {:type "Patient" :id "0"}})] + :path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 404 status)) @@ -50,49 +51,48 @@ (is (= "error" (-> body :issue first :severity))) - (is (= "not-found" (-> body :issue first :code)))))) - + (is (= "not-found" (-> body :issue first :code))))) -(deftest handler-test (testing "Returns History with one Patient" - (let [patient {:instance/version ::foo}] - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (let [patient {:instance/version ::foo} + match {:data {:fhir.resource/type "Patient"}}] + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (datomic-test-util/stub-resource ::db #{"Patient"} #{"0"} #{{:db/id 0}}) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-instance-transaction-history ::db 0 [::tx]) - (fhir-test-util/stub-page-size ::query-params 50) + (test-util/stub-page-size ::query-params 50) (datomic-test-util/stub-as-of-t ::db nil?) (datomic-test-util/stub-basis-t ::db 173105) (datomic-test-util/stub-entity ::db #{0} #{patient}) (datomic-test-util/stub-ordinal-version patient 1) (history-test-util/stub-nav-link - ::match ::query-params 173105 ::tx nil? + match ::query-params 173105 ::tx nil? (constantly ::self-link-url)) (history-test-util/stub-build-entry - ::router ::db #{::tx} #{0} (constantly ::entry))) + ::router ::db #{::tx} #{0} (constantly ::entry)) - (let [{:keys [status body]} - @((handler ::conn) - {::reitit/router ::router - ::reitit/match ::match - :query-params ::query-params - :path-params {:type "Patient" :id "0"}})] + (let [{:keys [status body]} + @((handler ::conn) + {::reitit/router ::router + ::reitit/match match + :query-params ::query-params + :path-params {:id "0"}})] - (is (= 200 status)) + (is (= 200 status)) - (is (= "Bundle" (:resourceType body))) + (is (= "Bundle" (:resourceType body))) - (is (= "history" (:type body))) + (is (= "history" (:type body))) - (is (= 1 (:total body))) + (is (= 1 (:total body))) - (is (= 1 (count (:entry body)))) + (is (= 1 (count (:entry body)))) - (is (= "self" (-> body :link first :relation))) + (is (= "self" (-> body :link first :relation))) - (is (= ::self-link-url (-> body :link first :url))) + (is (= ::self-link-url (-> body :link first :url))) - (is (= ::entry (-> body :entry first)))))) + (is (= ::entry (-> body :entry first))))))) diff --git a/test/blaze/handler/fhir/history_system_test.clj b/modules/interaction/test/blaze/interaction/history/system_test.clj similarity index 85% rename from test/blaze/handler/fhir/history_system_test.clj rename to modules/interaction/test/blaze/interaction/history/system_test.clj index 37890f3b7..a1f296e5a 100644 --- a/test/blaze/handler/fhir/history_system_test.clj +++ b/modules/interaction/test/blaze/interaction/history/system_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.history-system-test +(ns blaze.interaction.history.system-test "Specifications relevant for the FHIR history interaction: https://www.hl7.org/fhir/http.html#history @@ -6,12 +6,12 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.history.test-util :as history-test-util] - [blaze.handler.fhir.test-util :as fhir-test-util] - [blaze.handler.fhir.history-system :refer [handler]] + [blaze.interaction.history.system :refer [handler]] + [blaze.interaction.history.test-util :as history-test-util] + [blaze.interaction.test-util :as test-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [reitit.core :as reitit] [taoensso.timbre :as log])) @@ -30,18 +30,18 @@ (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) -(deftest handler-test-0 +(deftest handler-test (testing "Returns empty History" - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-system-transaction-history ::db []) - (fhir-test-util/stub-page-size ::query-params 50) + (test-util/stub-page-size ::query-params 50) (history-test-util/stub-page-eid ::query-params nil?) (datomic-test-util/stub-as-of-t ::db nil?) (datomic-test-util/stub-basis-t ::db 125346) @@ -61,19 +61,17 @@ (is (= 0 (:total body))) - (is (empty? (:entry body)))))) + (is (empty? (:entry body))))) - -(deftest handler-test-1 (testing "Returns History with one Patient" (let [tx {:db/id ::tx-eid}] - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-system-transaction-history ::db [tx]) - (fhir-test-util/stub-page-size ::query-params 50) + (test-util/stub-page-size ::query-params 50) (history-test-util/stub-page-eid ::query-params nil?) (datomic-test-util/stub-entity-db #{tx} ::db) (datomic-test-util/stub-datoms @@ -108,19 +106,17 @@ (is (= ::self-link-url (-> body :link first :url))) - (is (= ::entry (-> body :entry first)))))) - + (is (= ::entry (-> body :entry first))))) -(deftest handler-test-2 (testing "Returns History with two Patients in one Transaction" (let [tx {:db/id ::tx-eid}] - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-system-transaction-history ::db [tx]) - (fhir-test-util/stub-page-size ::query-params 50) + (test-util/stub-page-size ::query-params 50) (history-test-util/stub-page-eid ::query-params nil?) (datomic-test-util/stub-entity-db #{tx} ::db) (datomic-test-util/stub-datoms @@ -159,20 +155,18 @@ (is (= ::self-link-url (-> body :link first :url))) - (is (= [::entry-1 ::entry-2] (:entry body)))))) + (is (= [::entry-1 ::entry-2] (:entry body))))) - -(deftest handler-test-3 (testing "Returns History with two Patients in two Transactions" (let [tx-1 {:db/id ::tx-1-eid} tx-2 {:db/id ::tx-2-eid}] - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-system-transaction-history ::db [tx-1 tx-2]) - (fhir-test-util/stub-page-size ::query-params 50) + (test-util/stub-page-size ::query-params 50) (history-test-util/stub-page-eid ::query-params nil?) (datomic-test-util/stub-entity-db #{tx-1 tx-2} ::db) (datomic-test-util/stub-datoms @@ -214,19 +208,17 @@ (is (= ::self-link-url (-> body :link first :url))) - (is (= [::entry-1 ::entry-2] (:entry body)))))) - + (is (= [::entry-1 ::entry-2] (:entry body))))) -(deftest handler-test-4 (testing "Returns History with next Link" (let [tx {:db/id ::tx-eid}] - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-system-transaction-history ::db [tx]) - (fhir-test-util/stub-page-size ::query-params 1) + (test-util/stub-page-size ::query-params 1) (history-test-util/stub-page-eid ::query-params nil?) (datomic-test-util/stub-entity-db #{tx} ::db) (datomic-test-util/stub-datoms diff --git a/test/blaze/handler/fhir/history/test_util.clj b/modules/interaction/test/blaze/interaction/history/test_util.clj similarity index 86% rename from test/blaze/handler/fhir/history/test_util.clj rename to modules/interaction/test/blaze/interaction/history/test_util.clj index 81cfe7b6c..e3b861197 100644 --- a/test/blaze/handler/fhir/history/test_util.clj +++ b/modules/interaction/test/blaze/interaction/history/test_util.clj @@ -1,6 +1,6 @@ -(ns blaze.handler.fhir.history.test-util +(ns blaze.interaction.history.test-util (:require - [blaze.handler.fhir.history.util :as util] + [blaze.interaction.history.util :as util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [clojure.test :refer :all])) @@ -72,18 +72,6 @@ #{`util/since-t}})) -(defn stub-db [conn t-spec db] - (st/instrument - [`util/db] - {:spec - {`util/db - (s/fspec - :args (s/cat :conn #{conn} :t t-spec) - :ret #{db})} - :stub - #{`util/db}})) - - (defn stub-tx-db [db since-t-spec page-t-spec tx-db] (st/instrument [`util/tx-db] diff --git a/test/blaze/handler/fhir/history_type_test.clj b/modules/interaction/test/blaze/interaction/history/type_test.clj similarity index 60% rename from test/blaze/handler/fhir/history_type_test.clj rename to modules/interaction/test/blaze/interaction/history/type_test.clj index 9b66af3bd..beb73f30d 100644 --- a/test/blaze/handler/fhir/history_type_test.clj +++ b/modules/interaction/test/blaze/interaction/history/type_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.history-type-test +(ns blaze.interaction.history.type-test "Specifications relevant for the FHIR history interaction: https://www.hl7.org/fhir/http.html#history @@ -6,12 +6,12 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.history.test-util :as history-test-util] - [blaze.handler.fhir.history-type :refer [handler]] - [blaze.handler.fhir.test-util :as fhir-test-util] + [blaze.interaction.history.test-util :as history-test-util] + [blaze.interaction.history.type :refer [handler]] + [blaze.interaction.test-util :as test-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [reitit.core :as reitit] [taoensso.timbre :as log])) @@ -30,19 +30,20 @@ (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) -(deftest handler-test-1 +(deftest handler-test (testing "Returns History with one Patient" - (let [tx {:db/id ::tx-eid}] - (fhir-test-util/stub-t ::query-params nil?) - (history-test-util/stub-db ::conn nil? ::db) + (let [tx {:db/id ::tx-eid} + match {:data {:fhir.resource/type "Patient"}}] + (test-util/stub-t ::query-params nil?) + (test-util/stub-db ::conn nil? ::db) (history-test-util/stub-page-t ::query-params nil?) (history-test-util/stub-since-t ::db ::query-params nil?) (history-test-util/stub-tx-db ::db nil? nil? ::db) (datomic-test-util/stub-type-transaction-history ::db "Patient" [tx]) - (fhir-test-util/stub-page-size ::query-params 50) + (test-util/stub-page-size ::query-params 50) (history-test-util/stub-page-eid ::query-params nil?) (datomic-test-util/stub-entity-db #{tx} ::db) (datomic-test-util/stub-datoms @@ -53,26 +54,26 @@ (datomic-test-util/stub-type-version ::db "Patient" 1) (datomic-test-util/stub-resource-type* ::db ::patient-eid "Patient") (history-test-util/stub-nav-link - ::match ::query-params 152026 tx #{::patient-eid} + match ::query-params 152026 tx #{::patient-eid} (constantly ::self-link-url)) (history-test-util/stub-build-entry - ::router ::db #{tx} #{::patient-eid} (constantly ::entry))) + ::router ::db #{tx} #{::patient-eid} (constantly ::entry)) - (let [{:keys [status body]} - @((handler ::conn) - {::reitit/router ::router - ::reitit/match ::match - :query-params ::query-params - :path-params {:type "Patient"}})] + (let [{:keys [status body]} + @((handler ::conn) + {::reitit/router ::router + ::reitit/match match + :query-params ::query-params + :path-params {:type "Patient"}})] - (is (= 200 status)) + (is (= 200 status)) - (is (= "Bundle" (:resourceType body))) + (is (= "Bundle" (:resourceType body))) - (is (= "history" (:type body))) + (is (= "history" (:type body))) - (is (= 1 (:total body))) + (is (= 1 (:total body))) - (is (= 1 (count (:entry body)))) + (is (= 1 (count (:entry body)))) - (is (= ::entry (-> body :entry first)))))) + (is (= ::entry (-> body :entry first))))))) diff --git a/test/blaze/handler/fhir/history/util_test.clj b/modules/interaction/test/blaze/interaction/history/util_test.clj similarity index 87% rename from test/blaze/handler/fhir/history/util_test.clj rename to modules/interaction/test/blaze/interaction/history/util_test.clj index 024bafe8c..c5cad5565 100644 --- a/test/blaze/handler/fhir/history/util_test.clj +++ b/modules/interaction/test/blaze/interaction/history/util_test.clj @@ -1,9 +1,10 @@ -(ns blaze.handler.fhir.history.util-test +(ns blaze.interaction.history.util-test (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.history.util :refer [build-entry nav-url]] - [blaze.handler.fhir.test-util :as test-util] - [clojure.test :refer :all] + [blaze.handler.fhir.util :as fhir-util] + [blaze.interaction.history.util :refer [build-entry nav-url]] + [blaze.interaction.test-util :as test-util] + [clojure.test :as test :refer [deftest is testing]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [datomic-spec.test :as dst])) @@ -12,24 +13,31 @@ (defn fixture [f] (st/instrument) (dst/instrument) - (st/instrument - [`build-entry] - {:spec - {`build-entry - (s/fspec - :args (s/cat :router #{::router} :db #{::db} :transaction some? - :resource-eid some?))}}) (f) (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) -(def transaction {:db/id 0}) +(defn stub-type-url [router type url] + (st/instrument + [`fhir-util/type-url] + {:spec + {`fhir-util/type-url + (s/fspec + :args (s/cat :router #{router} :type #{type}) + :ret #{url})} + :stub + #{`fhir-util/type-url}})) + + +(def ^:private transaction {:db/id 0}) (deftest build-entry-test + (st/unstrument `build-entry) + (testing "Initial version with server assigned id" (datomic-test-util/stub-as-of ::db 0 ::as-of-db) (datomic-test-util/stub-entity ::as-of-db #{::resource-eid} #{::resource}) @@ -41,7 +49,7 @@ (datomic-test-util/stub-pull-resource* ::as-of-db "Patient" ::resource #{::pulled-resource}) (test-util/stub-instance-url ::router "Patient" "0" ::patient-url) - (test-util/stub-type-url ::router "Patient" ::patient-type-url) + (stub-type-url ::router "Patient" ::patient-type-url) (is (= diff --git a/test/blaze/middleware/fhir/type_test.clj b/modules/interaction/test/blaze/interaction/middleware/type_test.clj similarity index 76% rename from test/blaze/middleware/fhir/type_test.clj rename to modules/interaction/test/blaze/interaction/middleware/type_test.clj index 3ed89779b..1faa54360 100644 --- a/test/blaze/middleware/fhir/type_test.clj +++ b/modules/interaction/test/blaze/interaction/middleware/type_test.clj @@ -1,30 +1,25 @@ -(ns blaze.middleware.fhir.type-test +(ns blaze.interaction.middleware.type-test (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.middleware.fhir.type :refer [wrap-type]] - [clojure.spec.alpha :as s] + [blaze.interaction.middleware.type :refer [wrap-type]] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [taoensso.timbre :as log])) (defn fixture [f] (st/instrument) - (st/instrument - [`wrap-type] - {:spec - {`wrap-type - (s/fspec - :args (s/cat :handler fn? :conn #{::conn}))}}) - (datomic-test-util/stub-db ::conn ::db) (log/with-merged-config {:level :error} (f)) (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) (deftest wrap-type-test + (st/unstrument `wrap-type) + (datomic-test-util/stub-db ::conn ::db) + (testing "Returns Not Found on Non-Existing Resource Type" (datomic-test-util/stub-cached-entity ::db #{:Patient} nil?) diff --git a/test/blaze/handler/fhir/read_test.clj b/modules/interaction/test/blaze/interaction/read_test.clj similarity index 84% rename from test/blaze/handler/fhir/read_test.clj rename to modules/interaction/test/blaze/interaction/read_test.clj index 76c7e6bba..db1e7d207 100644 --- a/test/blaze/handler/fhir/read_test.clj +++ b/modules/interaction/test/blaze/interaction/read_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.read-test +(ns blaze.interaction.read-test "Specifications relevant for the FHIR read interaction: https://www.hl7.org/fhir/http.html#read @@ -6,12 +6,12 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.read :refer [handler]] + [blaze.interaction.read :refer [handler]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] - [datomic.api :as d] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] + [reitit.core :as reitit] [taoensso.timbre :as log]) (:import [java.time Instant])) @@ -30,7 +30,7 @@ (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) (deftest handler-test @@ -40,7 +40,8 @@ (let [{:keys [status body]} @((handler ::conn) - {:path-params {:type "Patient" :id "0"}})] + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 404 status)) @@ -54,7 +55,8 @@ (testing "Returns Not Found on Invalid Version ID" (let [{:keys [status body]} @((handler ::conn) - {:path-params {:type "Patient" :id "0" :vid "a"}})] + {:path-params {:id "0" :vid "a"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 404 status)) @@ -76,7 +78,8 @@ (let [{:keys [status body headers]} @((handler ::conn) - {:path-params {:type "Patient" :id "0"}})] + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 410 status)) @@ -104,7 +107,8 @@ (let [{:keys [status headers body]} @((handler ::conn) - {:path-params {:type "Patient" :id "0"}})] + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 200 status)) @@ -129,7 +133,8 @@ (let [{:keys [status headers body]} @((handler ::conn) - {:path-params {:type "Patient" :id "0" :vid "42"}})] + {:path-params {:id "0" :vid "42"} + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 200 status)) diff --git a/test/blaze/handler/fhir/search_test.clj b/modules/interaction/test/blaze/interaction/search_type_test.clj similarity index 82% rename from test/blaze/handler/fhir/search_test.clj rename to modules/interaction/test/blaze/interaction/search_type_test.clj index e092d90e4..53ff60712 100644 --- a/test/blaze/handler/fhir/search_test.clj +++ b/modules/interaction/test/blaze/interaction/search_type_test.clj @@ -1,14 +1,14 @@ -(ns blaze.handler.fhir.search-test +(ns blaze.interaction.search-type-test "Specifications relevant for the FHIR search interaction: https://www.hl7.org/fhir/http.html#search" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.search :refer [handler]] - [blaze.handler.fhir.test-util :as fhir-test-util] + [blaze.interaction.search-type :refer [handler]] + [blaze.interaction.test-util :as test-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic.api :as d] [datomic-spec.test :as dst] [reitit.core :as reitit] @@ -29,7 +29,7 @@ (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) (deftest handler-test @@ -47,12 +47,12 @@ (datomic-test-util/stub-entity ::db #{143757} #{::patient}) (datomic-test-util/stub-pull-resource* ::db "Patient" ::patient #{patient}) (datomic-test-util/stub-type-total ::db "Patient" 1) - (fhir-test-util/stub-instance-url ::router "Patient" "0" ::full-url) + (test-util/stub-instance-url ::router "Patient" "0" ::patient-url) (let [{:keys [status body]} @((handler ::conn) {::reitit/router ::router - :path-params {:type "Patient"}})] + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 200 status)) @@ -69,7 +69,7 @@ (is (= 1 (count (:entry body))))) (testing "The entry has the right fullUrl" - (is (= ::full-url (-> body :entry first :fullUrl)))) + (is (= ::patient-url (-> body :entry first :fullUrl)))) (testing "The entry has the right resource" (is (= patient (-> body :entry first :resource))))))) @@ -79,7 +79,7 @@ (let [{:keys [status body]} @((handler ::conn) - {:path-params {:type "Patient"} + {::reitit/match {:data {:fhir.resource/type "Patient"}} :params {"_summary" "count"}})] (is (= 200 status)) @@ -98,7 +98,7 @@ (let [{:keys [status body]} @((handler ::conn) - {:path-params {:type "Patient"} + {::reitit/match {:data {:fhir.resource/type "Patient"}} :params {"_count" "0"}})] (is (= 200 status)) @@ -126,12 +126,12 @@ #{`d/datoms}}) (datomic-test-util/stub-entity ::db #{143757} #{::patient}) (datomic-test-util/stub-pull-resource* ::db "Patient" ::patient #{patient}) - (fhir-test-util/stub-instance-url ::router "Patient" "0" ::full-url) + (test-util/stub-instance-url ::router "Patient" "0" ::patient-url) (let [{:keys [status body]} @((handler ::conn) {::reitit/router ::router - :path-params {:type "Patient"}})] + ::reitit/match {:data {:fhir.resource/type "Patient"}}})] (is (= 200 status)) @@ -145,7 +145,7 @@ (is (= 1 (count (:entry body))))) (testing "The entry has the right fullUrl" - (is (= ::full-url (-> body :entry first :fullUrl)))) + (is (= ::patient-url (-> body :entry first :fullUrl)))) (testing "The entry has the right resource" (is (= patient (-> body :entry first :resource)))))))) diff --git a/modules/interaction/test/blaze/interaction/test_util.clj b/modules/interaction/test/blaze/interaction/test_util.clj new file mode 100644 index 000000000..ffd9fe723 --- /dev/null +++ b/modules/interaction/test/blaze/interaction/test_util.clj @@ -0,0 +1,86 @@ +(ns blaze.interaction.test-util + (:require + [blaze.handler.util :as util] + [blaze.handler.fhir.util :as fhir-util] + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as st])) + + +(defn stub-instance-url [router type id url] + (st/instrument + [`fhir-util/instance-url] + {:spec + {`fhir-util/instance-url + (s/fspec + :args (s/cat :router #{router} :type #{type} :id #{id}) + :ret #{url})} + :stub + #{`fhir-util/instance-url}})) + + +(defn stub-page-size [query-params page-size] + (st/instrument + [`fhir-util/page-size] + {:spec + {`fhir-util/page-size + (s/fspec + :args (s/cat :query-params #{query-params}) + :ret #{page-size})} + :stub + #{`fhir-util/page-size}})) + + +(defn stub-t [query-params t-spec] + (st/instrument + [`fhir-util/t] + {:spec + {`fhir-util/t + (s/fspec + :args (s/cat :query-params #{query-params}) + :ret t-spec)} + :stub + #{`fhir-util/t}})) + + +(defn stub-db [conn t-spec db] + (st/instrument + [`util/db] + {:spec + {`util/db + (s/fspec + :args (s/cat :conn #{conn} :t t-spec) + :ret #{db})} + :stub + #{`util/db}})) + + +(defn stub-upsert-resource + [transaction-executor conn term-service db creation-mode resource tx-result] + (st/instrument + [`fhir-util/upsert-resource] + {:spec + {`fhir-util/upsert-resource + (s/fspec + :args + (s/cat + :transaction-executor #{transaction-executor} + :conn #{conn} + :term-service #{term-service} + :db #{db} + :creation-mode #{creation-mode} + :resource #{resource}) + :ret #{tx-result})} + :stub + #{`fhir-util/upsert-resource}})) + + +(defn stub-versioned-instance-url [router type id vid url] + (st/instrument + [`fhir-util/versioned-instance-url] + {:spec + {`fhir-util/versioned-instance-url + (s/fspec + :args (s/cat :router #{router} :type #{type} :id #{id} :vid #{vid}) + :ret #{url})} + :stub + #{`fhir-util/versioned-instance-url}})) diff --git a/test/blaze/handler/fhir/transaction_test.clj b/modules/interaction/test/blaze/interaction/transaction_test.clj similarity index 85% rename from test/blaze/handler/fhir/transaction_test.clj rename to modules/interaction/test/blaze/interaction/transaction_test.clj index 4e31d6fe4..0b59138da 100644 --- a/test/blaze/handler/fhir/transaction_test.clj +++ b/modules/interaction/test/blaze/interaction/transaction_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.transaction-test +(ns blaze.interaction.transaction-test "Specifications relevant for the FHIR batch/transaction interaction: https://www.hl7.org/fhir/http.html#transaction @@ -6,17 +6,15 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.bundle :as bundle] - [blaze.bundle-test :as bundle-test] [blaze.datomic.test-util :as datomic-test-util] [blaze.datomic.util :as util] - [blaze.executors :as ex] + [blaze.executors :as ex :refer [executor?]] [blaze.handler.fhir.util :as fhir-util] - [blaze.handler.fhir.test-util :as fhir-test-util] - [blaze.handler.fhir.transaction :refer [handler]] - [blaze.handler.test-util :as test-util] + [blaze.interaction.test-util :as test-util] + [blaze.interaction.transaction :refer [handler]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [manifold.deferred :as md] [reitit.core :as reitit] @@ -34,15 +32,18 @@ {:spec {`handler (s/fspec - :args (s/cat :conn #{::conn} - :term-service #{::term-service} - :executor ex/executor?))}}) + :args + (s/cat + :transaction-executor #{::transaction-executor} + :conn #{::conn} + :term-service #{::term-service} + :executor executor?))}}) (datomic-test-util/stub-db ::conn ::db-before) (log/with-merged-config {:level :error} (f)) (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) (defonce executor (ex/single-thread-executor)) @@ -84,6 +85,18 @@ #{`bundle/tx-data}})) +(defn- stub-annotate-codes [term-service db] + (st/instrument + [`bundle/annotate-codes] + {:spec + {`bundle/annotate-codes + (s/fspec + :args (s/cat :term-service #{term-service} :db #{db} :entries some?))} + :replace + {`bundle/annotate-codes + (fn [_ _ entries] entries)}})) + + (defn- given-types-available [& types] (datomic-test-util/stub-cached-entity ::db-before (into #{} (map keyword) types) some?)) @@ -92,7 +105,7 @@ (deftest handler-test (testing "Returns Error on missing request" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -111,7 +124,7 @@ (testing "Returns Error on missing request url" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -131,7 +144,7 @@ (testing "Returns Error on missing request method" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -152,7 +165,7 @@ (testing "Returns Error on unknown method" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -175,7 +188,7 @@ (testing "Returns Error on unsupported method" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -198,7 +211,7 @@ (testing "Returns Error on missing type" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -223,7 +236,7 @@ (datomic-test-util/stub-cached-entity ::db-before #{:Foo} nil?) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -248,7 +261,7 @@ (given-types-available "Patient") (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -275,7 +288,7 @@ (given-types-available "Patient") (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -309,7 +322,7 @@ (given-types-available "Patient") (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -353,17 +366,18 @@ (given-types-available "Patient") (datomic-test-util/stub-resource ::db-before #{"Patient"} #{"0"} nil?) - (bundle-test/stub-annotate-codes ::term-service ::db-before) + (stub-annotate-codes ::term-service ::db-before) (stub-code-tx-data ::db-before coll? []) (stub-tx-data ::db-before coll? ::tx-data) - (datomic-test-util/stub-transact-async ::conn ::tx-data {:db-after ::db-after}) + (datomic-test-util/stub-transact-async + ::transaction-executor ::conn ::tx-data {:db-after ::db-after}) (datomic-test-util/stub-basis-transaction ::db-after ::transaction) (stub-tx-instant ::transaction (Instant/ofEpochMilli 0)) (datomic-test-util/stub-basis-t ::db-after 42) - (fhir-test-util/stub-versioned-instance-url ::router "Patient" "0" "42" ::location) + (test-util/stub-versioned-instance-url ::router "Patient" "0" "42" ::location) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -400,18 +414,21 @@ (given-types-available "Patient") (datomic-test-util/stub-resource ::db-before #{"Patient"} #{"0"} #{::old-patient}) - (bundle-test/stub-annotate-codes ::term-service ::db-before) + (stub-annotate-codes ::term-service ::db-before) (stub-code-tx-data ::db-before coll? []) (stub-tx-data ::db-before coll? ::tx-data) (datomic-test-util/stub-transact-async - ::conn ::tx-data (md/success-deferred {:db-after ::db-after})) + ::transaction-executor + ::conn + ::tx-data + (md/success-deferred {:db-after ::db-after})) (datomic-test-util/stub-basis-transaction ::db-after ::transaction) (stub-tx-instant ::transaction (Instant/ofEpochMilli 0)) (datomic-test-util/stub-basis-t ::db-after 42) (testing "with no Prefer header" (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {:body {"resourceType" "Bundle" "type" "transaction" @@ -453,16 +470,19 @@ (given-types-available "Patient" "Observation") (datomic-test-util/stub-squuid id) - (bundle-test/stub-annotate-codes ::term-service ::db-before) + (stub-annotate-codes ::term-service ::db-before) (stub-code-tx-data ::db-before coll? []) (stub-tx-data ::db-before coll? ::tx-data) - (datomic-test-util/stub-transact-async ::conn ::tx-data {:db-after ::db-after}) + (datomic-test-util/stub-transact-async + ::transaction-executor ::conn ::tx-data {:db-after ::db-after}) (datomic-test-util/stub-resource - ::db-after #{"Patient" "Observation"} #{(str id)} #{{:instance/version 0}}) + ::db-after #{"Patient" "Observation"} #{(str id)} + #{{:instance/version 0}}) (datomic-test-util/stub-basis-transaction ::db-after ::transaction) (stub-tx-instant ::transaction (Instant/ofEpochMilli 0)) (datomic-test-util/stub-basis-t ::db-after 42) - (fhir-test-util/stub-versioned-instance-url ::router "Patient" (str id) "42" ::location) + (test-util/stub-versioned-instance-url + ::router "Patient" (str id) "42" ::location) (st/instrument [`fhir-util/versioned-instance-url] {:spec @@ -476,7 +496,7 @@ (keyword "location" type))}}) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -508,6 +528,18 @@ (-> body :entry second :response :lastModified))))))) +(defn- stub-match-by-path [router path match] + (st/instrument + [`reitit/match-by-path] + {:spec + {`reitit/match-by-path + (s/fspec + :args (s/cat :router #{router} :path #{path}) + :ret #{match})} + :stub + #{`reitit/match-by-path}})) + + (deftest handler-batch-create-test (given-types-available "Patient") @@ -519,11 +551,11 @@ (-> (ring/created "location" ::response-body) (ring/header "Last-Modified" "Mon, 24 Jun 2019 09:54:26 GMT") (ring/header "ETag" "etag"))))] - (test-util/stub-match-by-path + (stub-match-by-path ::router "Patient" {:result {:post {:handler handler}}})) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -556,11 +588,11 @@ (fn [_] (md/success-deferred (ring/bad-request ::operation-outcome)))] - (test-util/stub-match-by-path + (stub-match-by-path ::router "Patient" {:result {:post {:handler handler}}})) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -593,11 +625,11 @@ (-> (ring/response ::response-body) (ring/header "Last-Modified" "Mon, 24 Jun 2019 09:54:26 GMT") (ring/header "ETag" "etag"))))] - (test-util/stub-match-by-path + (stub-match-by-path ::router "Patient/0" {:result {:get {:handler handler}}})) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -626,11 +658,11 @@ (fn [_] (md/success-deferred (ring/bad-request ::operation-outcome)))] - (test-util/stub-match-by-path + (stub-match-by-path ::router "Patient/0" {:result {:get {:handler handler}}})) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -659,11 +691,11 @@ (fn [_] (md/success-deferred (ring/response ::response-body)))] - (test-util/stub-match-by-path + (stub-match-by-path ::router "Patient" {:result {:get {:handler handler}}})) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" @@ -695,11 +727,11 @@ (-> (ring/response ::response-body) (ring/header "Last-Modified" "Mon, 24 Jun 2019 09:54:26 GMT") (ring/header "ETag" "etag"))))] - (test-util/stub-match-by-path + (stub-match-by-path ::router "Patient/0" {:result {:put {:handler handler}}})) (let [{:keys [status body]} - @((handler ::conn ::term-service executor) + @((handler ::transaction-executor ::conn ::term-service executor) {::reitit/router ::router :body {"resourceType" "Bundle" diff --git a/test/blaze/handler/fhir/update_test.clj b/modules/interaction/test/blaze/interaction/update_test.clj similarity index 63% rename from test/blaze/handler/fhir/update_test.clj rename to modules/interaction/test/blaze/interaction/update_test.clj index 2d20c96e1..c40950c39 100644 --- a/test/blaze/handler/fhir/update_test.clj +++ b/modules/interaction/test/blaze/interaction/update_test.clj @@ -1,4 +1,4 @@ -(ns blaze.handler.fhir.update-test +(ns blaze.interaction.update-test "Specifications relevant for the FHIR update interaction: https://www.hl7.org/fhir/http.html#update @@ -6,11 +6,11 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.handler.fhir.test-util :as test-util] - [blaze.handler.fhir.update :refer [handler]] + [blaze.interaction.test-util :as test-util] + [blaze.interaction.update :refer [handler]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [deftest is testing]] [datomic-spec.test :as dst] [manifold.deferred :as md] [reitit.core :as reitit] @@ -25,21 +25,26 @@ {:spec {`handler (s/fspec - :args (s/cat :conn #{::conn} :term-service #{::term-service}))}}) + :args + (s/cat + :transaction-executor #{::transaction-executor} + :conn #{::conn} + :term-service #{::term-service}))}}) (datomic-test-util/stub-db ::conn ::db-before) (log/with-merged-config {:level :error} (f)) (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) (deftest handler-test (testing "Returns Error on type mismatch" (let [{:keys [status body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient" :id "0"} - :body {"resourceType" "Observation"}})] + @((handler ::transaction-executor ::conn ::term-service) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :body {"resourceType" "Observation"}})] (is (= 400 status)) @@ -56,9 +61,10 @@ (testing "Returns Error on ID mismatch" (let [{:keys [status body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient" :id "0"} - :body {"resourceType" "Patient" "id" "1"}})] + @((handler ::transaction-executor ::conn ::term-service) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :body {"resourceType" "Patient" "id" "1"}})] (is (= 400 status)) @@ -77,7 +83,12 @@ (let [resource {"resourceType" "Patient" "id" "0"}] (datomic-test-util/stub-resource ::db-before #{"Patient"} #{"0"} nil?) (test-util/stub-upsert-resource - ::conn ::term-service ::db-before :client-assigned-id resource + ::transaction-executor + ::conn + ::term-service + ::db-before + :client-assigned-id + resource (md/success-deferred {:db-after ::db-after})) (datomic-test-util/stub-basis-transaction ::db-after {:db/txInstant #inst "2019-05-14T13:58:20.060-00:00"}) @@ -88,10 +99,11 @@ (testing "with no Prefer header" (let [{:keys [status headers body]} - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient" :id "0"} - :body resource})] + :path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :body resource})] (testing "Returns 201" (is (= 201 status))) @@ -111,33 +123,36 @@ (testing "with return=minimal Prefer header" (let [{:keys [body]} - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient" :id "0"} - :headers {"prefer" "return=minimal"} - :body resource})] + :path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :headers {"prefer" "return=minimal"} + :body resource})] (testing "Contains no body" (is (nil? body))))) (testing "with return=representation Prefer header" (let [{:keys [body]} - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient" :id "0"} - :headers {"prefer" "return=representation"} - :body resource})] + :path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :headers {"prefer" "return=representation"} + :body resource})] (testing "Contains the resource as body" (is (= ::resource-after body))))) (testing "with return=OperationOutcome Prefer header" (let [{:keys [body]} - @((handler ::conn ::term-service) + @((handler ::transaction-executor ::conn ::term-service) {::reitit/router ::router - :path-params {:type "Patient" :id "0"} - :headers {"prefer" "return=OperationOutcome"} - :body resource})] + :path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :headers {"prefer" "return=OperationOutcome"} + :body resource})] (testing "Contains an OperationOutcome as body" (is (= {:resourceType "OperationOutcome"} body))))))) @@ -147,7 +162,12 @@ (let [resource {"resourceType" "Patient" "id" "0"}] (datomic-test-util/stub-resource ::db-before #{"Patient"} #{"0"} some?) (test-util/stub-upsert-resource - ::conn ::term-service ::db-before :client-assigned-id resource + ::transaction-executor + ::conn + ::term-service + ::db-before + :client-assigned-id + resource (md/success-deferred {:db-after ::db-after})) (datomic-test-util/stub-basis-transaction ::db-after {:db/txInstant #inst "2019-05-14T13:58:20.060-00:00"}) @@ -156,9 +176,10 @@ (testing "with no Prefer header" (let [{:keys [status headers body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient" :id "0"} - :body resource})] + @((handler ::transaction-executor ::conn ::term-service) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :body resource})] (testing "Returns 200" (is (= 200 status))) @@ -175,10 +196,11 @@ (testing "with return=minimal Prefer header" (let [{:keys [status body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient" :id "0"} - :headers {"prefer" "return=minimal"} - :body resource})] + @((handler ::transaction-executor ::conn ::term-service) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :headers {"prefer" "return=minimal"} + :body resource})] (testing "Returns 200" (is (= 200 status))) @@ -188,10 +210,11 @@ (testing "with return=representation Prefer header" (let [{:keys [status body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient" :id "0"} - :headers {"prefer" "return=representation"} - :body resource})] + @((handler ::transaction-executor ::conn ::term-service) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :headers {"prefer" "return=representation"} + :body resource})] (testing "Returns 200" (is (= 200 status))) @@ -201,10 +224,11 @@ (testing "with return=OperationOutcome Prefer header" (let [{:keys [status body]} - @((handler ::conn ::term-service) - {:path-params {:type "Patient" :id "0"} - :headers {"prefer" "return=OperationOutcome"} - :body resource})] + @((handler ::transaction-executor ::conn ::term-service) + {:path-params {:id "0"} + ::reitit/match {:data {:fhir.resource/type "Patient"}} + :headers {"prefer" "return=OperationOutcome"} + :body resource})] (testing "Returns 200" (is (= 200 status))) diff --git a/modules/interaction/tests.edn b/modules/interaction/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/interaction/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/module-base/deps.edn b/modules/module-base/deps.edn new file mode 100644 index 000000000..0577839fd --- /dev/null +++ b/modules/module-base/deps.edn @@ -0,0 +1,6 @@ +{:deps + {com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:mvn/version "0.7.0"}}} diff --git a/modules/module-base/src/blaze/module.clj b/modules/module-base/src/blaze/module.clj new file mode 100644 index 000000000..d01a8529b --- /dev/null +++ b/modules/module-base/src/blaze/module.clj @@ -0,0 +1,19 @@ +(ns blaze.module + (:require + [integrant.core :as ig])) + + +(defmacro defcollector + "Registers a metrics collector to the central registry." + [name bindings & body] + (let [key + (if (simple-symbol? name) + (keyword (str *ns*) (clojure.core/name name)) + (keyword (namespace name) (clojure.core/name name)))] + `(do + (defmethod ig/init-key ~key + ~(into ['_] bindings) + ~@body) + + (derive ~key :blaze.metrics/collector)))) + diff --git a/modules/openid-auth/deps.edn b/modules/openid-auth/deps.edn new file mode 100644 index 000000000..e44287264 --- /dev/null +++ b/modules/openid-auth/deps.edn @@ -0,0 +1,27 @@ +{:deps + {buddy/buddy-auth + {:git/url "https://github.com/alexanderkiel/buddy-auth.git" + :sha "56c0396a6d8640ebd588f2895e5e4583dc48b903"} + + cheshire + {:mvn/version "5.9.0"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:mvn/version "0.7.0"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/modules/openid-auth/src/blaze/openid_auth.clj b/modules/openid-auth/src/blaze/openid_auth.clj new file mode 100644 index 000000000..9becdf413 --- /dev/null +++ b/modules/openid-auth/src/blaze/openid_auth.clj @@ -0,0 +1,55 @@ +(ns blaze.openid-auth + "Verifies a signed JWT using OpenID Connect to provide + the public key used to sign the token." + (:require + [buddy.auth.backends :as backends] + [buddy.core.keys :as keys] + [cheshire.core :as json] + [clojure.spec.alpha :as s] + [integrant.core :as ig] + [taoensso.timbre :as log]) + (:import + [java.security PublicKey])) + + +(s/fdef public-key + :args (s/cat :jwks-json string?) + :ret (s/nilable #(instance? PublicKey %))) + + +(defn public-key [jwks-json] + "Take a the first jwk from jwks-json string and + convert it into a PublicKey." + (some-> jwks-json + (json/parse-string keyword) + :keys + first + keys/jwk->public-key)) + + +(s/fdef jwks-json + :args (s/cat :url string?) + :ret map?) + + +(defn jwks-json [url] + (let [well-known "/.well-known/openid-configuration" + jwks-json (some-> url + (str well-known) + slurp + json/parse-string + (get "jwks_uri") + slurp)] + (if (some? jwks-json) + jwks-json + (throw (ex-info "No jwk found" + {:cause (str "No jwk found at " url well-known)}))))) + + +(defmethod ig/init-key :blaze.openid-auth/backend + [_ {:openid-provider/keys [url]}] + (log/info "Enabled authentication using OpenID provider:" url) + (backends/jws + {:token-name "Bearer" + :secret (-> url jwks-json public-key) + :options {:alg :rs256}})) diff --git a/test/blaze/middleware/authentication_test.clj b/modules/openid-auth/test/blaze/openid_auth_test.clj similarity index 93% rename from test/blaze/middleware/authentication_test.clj rename to modules/openid-auth/test/blaze/openid_auth_test.clj index 152dbe81a..15fe979db 100644 --- a/test/blaze/middleware/authentication_test.clj +++ b/modules/openid-auth/test/blaze/openid_auth_test.clj @@ -1,9 +1,9 @@ -(ns blaze.middleware.authentication-test +(ns blaze.openid-auth-test (:require - [blaze.middleware.authentication :refer [public-key]] + [blaze.openid-auth :refer [public-key]] [clojure.test :refer :all]) (:import - (java.security PublicKey))) + [java.security PublicKey])) ;; The following json has been taken from https://samples.auth0.com/.well-known/jwks.json diff --git a/modules/openid-auth/tests.edn b/modules/openid-auth/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/openid-auth/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/operations/measure-evaluate-measure/README.md b/modules/operations/measure-evaluate-measure/README.md new file mode 100644 index 000000000..c7690c6c1 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/README.md @@ -0,0 +1,3 @@ +# Module - Operation Measure - Evaluate Measure + +https://www.hl7.org/fhir/operation-measure-evaluate-measure.html diff --git a/modules/operations/measure-evaluate-measure/deps.edn b/modules/operations/measure-evaluate-measure/deps.edn new file mode 100644 index 000000000..ab89004fb --- /dev/null +++ b/modules/operations/measure-evaluate-measure/deps.edn @@ -0,0 +1,38 @@ +{:deps + {blaze/cql + {:local/root "../../cql"} + + blaze/executor + {:local/root "../../executor"} + + blaze/module-base + {:local/root "../../module-base"} + + blaze/rest-util + {:local/root "../../rest-util"} + + blaze/thread-pool-executor-collector + {:local/root "../../thread-pool-executor-collector"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {blaze/datomic-test-util + {:local/root "../../datomic-test-util"} + + blaze/extern-terminology-service + {:local/root "../../extern-terminology-service"} + + lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj new file mode 100644 index 000000000..041846e60 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj @@ -0,0 +1,83 @@ +(ns blaze.fhir.operation.evaluate-measure + "Main entry point into the $evaluate-measure operation." + (:require + [blaze.executors :as ex :refer [executor?]] + [blaze.fhir.operation.evaluate-measure.handler.impl :as impl] + [blaze.fhir.operation.evaluate-measure.measure :as measure] + [blaze.fhir.operation.evaluate-measure.middleware.params + :refer [wrap-coerce-params]] + [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] + [blaze.module :refer [defcollector]] + [blaze.terminology-service :refer [term-service?]] + [blaze.thread-pool-executor-collector + :refer [thread-pool-executor-collector]] + [clojure.spec.alpha :as s] + [datomic-spec.core :as ds] + [integrant.core :as ig] + [ring.middleware.params :refer [wrap-params]] + [taoensso.timbre :as log]) + (:import + [java.time Clock])) + + +(s/def :handler.fhir.operation/evaluate-measure fn?) + + +(s/fdef handler + :args + (s/cat + :clock #(instance? Clock %) + :transaction-executor executor? + :conn ::ds/conn + :term-service term-service? + :executor executor?) + :ret :handler.fhir.operation/evaluate-measure) + +(defn handler + "" + [clock transaction-executor conn term-service executor] + (-> (impl/handler clock transaction-executor conn term-service executor) + (wrap-coerce-params) + (wrap-params) + (wrap-observe-request-duration "operation-evaluate-measure"))) + + +(s/def ::clock + #(instance? Clock %)) + + +(s/def ::term-service + term-service?) + + +(s/def ::executor + executor?) + + +(defmethod ig/pre-init-spec ::handler [_] + (s/keys :req-un [::clock ::term-service ::executor])) + + +(defmethod ig/init-key ::handler + [_ + {:database/keys [transaction-executor conn] + :keys [clock term-service executor]}] + (log/info "Init FHIR $evaluate-measure operation handler") + (handler clock transaction-executor conn term-service executor)) + + +(defmethod ig/init-key ::executor + [_ _] + (log/info "Init FHIR $evaluate-measure operation executor") + (ex/cpu-bound-pool "evaluate-measure-operation-%d")) + + +(derive ::executor :blaze.metrics/thread-pool-executor) + + +(defcollector compile-duration-seconds [_] + measure/compile-duration-seconds) + + +(defcollector evaluate-duration-seconds [_] + measure/evaluate-duration-seconds) diff --git a/src/blaze/fhir/operation/evaluate_measure/cql.clj b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj similarity index 100% rename from src/blaze/fhir/operation/evaluate_measure/cql.clj rename to modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj diff --git a/src/blaze/fhir/operation/evaluate_measure/handler/impl.clj b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/handler/impl.clj similarity index 73% rename from src/blaze/fhir/operation/evaluate_measure/handler/impl.clj rename to modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/handler/impl.clj index 5f96f37dc..21a03c003 100644 --- a/src/blaze/fhir/operation/evaluate_measure/handler/impl.clj +++ b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/handler/impl.clj @@ -1,13 +1,12 @@ (ns blaze.fhir.operation.evaluate-measure.handler.impl (:require [blaze.datomic.util :as datomic-util] - [blaze.executors :as ex] + [blaze.executors :refer [executor?]] [blaze.fhir.operation.evaluate-measure.measure :refer [evaluate-measure]] [blaze.fhir.response.create :as response] [blaze.handler.fhir.util :as fhir-util] [blaze.handler.util :as handler-util] [blaze.terminology-service :refer [term-service?]] - [blaze.util :refer [anom-let]] [clojure.spec.alpha :as s] [cognitect.anomalies :as anom] [datomic.api :as d] @@ -24,7 +23,7 @@ (defn- handle - [clock conn term-service db executor + [clock transaction-executor conn term-service db executor {::reitit/keys [router] :keys [request-method headers] {:strs [periodStart periodEnd]} :query-params} measure] @@ -43,7 +42,12 @@ (let [id (str (d/squuid)) return-preference (handler-util/preference headers "return")] (-> (fhir-util/upsert-resource - conn term-service db :server-assigned-id (assoc result "id" id)) + transaction-executor + conn + term-service + db + :server-assigned-id + (assoc result "id" id)) (md/chain' #(response/build-created-response router return-preference (:db-after %) "MeasureReport" id)) @@ -51,12 +55,15 @@ (s/fdef handler - :args (s/cat :clock #(instance? Clock %) - :conn ::ds/conn - :term-service term-service? - :executor ex/executor?)) + :args + (s/cat + :clock #(instance? Clock %) + :transaction-executor executor? + :conn ::ds/conn + :term-service term-service? + :executor executor?)) -(defn handler [clock conn term-service executor] +(defn handler [clock transaction-executor conn term-service executor] (fn [{{:keys [id]} :path-params :as request}] (let [db (d/db conn)] (if-let [measure (datomic-util/resource db "Measure" id)] @@ -65,7 +72,15 @@ {:fhir/issue "deleted"}) (ring/response) (ring/status 410)) - (handle clock conn term-service db executor request measure)) + (handle + clock + transaction-executor + conn + term-service + db + executor + request + measure)) (handler-util/error-response {::anom/category ::anom/not-found :fhir/issue "not-found"}))))) diff --git a/src/blaze/fhir/operation/evaluate_measure/measure.clj b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/measure.clj similarity index 100% rename from src/blaze/fhir/operation/evaluate_measure/measure.clj rename to modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/measure.clj diff --git a/src/blaze/fhir/operation/evaluate_measure/middleware/params.clj b/modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/middleware/params.clj similarity index 100% rename from src/blaze/fhir/operation/evaluate_measure/middleware/params.clj rename to modules/operations/measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/middleware/params.clj diff --git a/test/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj similarity index 56% rename from test/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj index c6a6ee1ac..a003505a3 100644 --- a/test/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/handler/impl_test.clj @@ -1,11 +1,11 @@ (ns blaze.fhir.operation.evaluate-measure.handler.impl-test (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.executors :as ex] + [blaze.executors :as ex :refer [executor?]] [blaze.fhir.operation.evaluate-measure.handler.impl :refer [handler]] [blaze.fhir.operation.evaluate-measure.measure-test :as measure-test] - [blaze.fhir.response.create-test :as create-test] - [blaze.handler.fhir.test-util :as fhir-test-util] + [blaze.fhir.response.create :as fhir-response-create] + [blaze.handler.fhir.util :as fhir-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [clojure.test :refer :all] @@ -15,17 +15,20 @@ [java.time Clock Instant ZoneOffset OffsetDateTime])) -(defn fixture [f] +(defn- fixture [f] (st/instrument) (st/instrument [`handler] {:spec {`handler (s/fspec - :args (s/cat :clock #(instance? Clock %) - :conn #{::conn} - :term-service #{::term-service} - :executor ex/executor?))}}) + :args + (s/cat + :clock #(instance? Clock %) + :transaction-executor executor? + :conn #{::conn} + :term-service #{::term-service} + :executor executor?))}}) (datomic-test-util/stub-db ::conn ::db) (log/with-merged-config {:level :error} (f)) (st/unstrument)) @@ -37,15 +40,50 @@ (def base-uri "http://localhost:8080") (def clock (Clock/fixed Instant/EPOCH (ZoneOffset/ofHours 0))) (def now (OffsetDateTime/ofInstant Instant/EPOCH (ZoneOffset/ofHours 0))) +(defonce transaction-executor (ex/single-thread-executor)) (defonce executor (ex/single-thread-executor)) +(defn stub-upsert-resource + [conn term-service db creation-mode resource tx-result] + (st/instrument + [`fhir-util/upsert-resource] + {:spec + {`fhir-util/upsert-resource + (s/fspec + :args + (s/cat + :transaction-executor #{transaction-executor} + :conn #{conn} + :term-service #{term-service} + :db #{db} + :creation-mode #{creation-mode} + :resource #{resource}) + :ret #{tx-result})} + :stub + #{`fhir-util/upsert-resource}})) + + +(defn stub-build-created-response + [router return-preference-spec db type id response] + (st/instrument + [`fhir-response-create/build-created-response] + {:spec + {`fhir-response-create/build-created-response + (s/fspec + :args (s/cat :router #{router} :return-preference return-preference-spec + :db #{db} :type #{type} :id #{id}) + :ret #{response})} + :stub + #{`fhir-response-create/build-created-response}})) + + (deftest handler-test (testing "Returns Not Found on Non-Existing Measure" (datomic-test-util/stub-resource ::db #{"Measure"} #{"0"} nil?) (let [{:keys [status body]} - ((handler clock ::conn ::term-service executor) + ((handler clock transaction-executor ::conn ::term-service executor) {:path-params {:type "Measure" :id "0"}})] (is (= 404 status)) @@ -62,7 +100,7 @@ (datomic-test-util/stub-deleted? ::measure true?) (let [{:keys [status body]} - ((handler clock ::conn ::term-service executor) + ((handler clock transaction-executor ::conn ::term-service executor) {:path-params {:type "Measure" :id "0"}})] (is (= 410 status)) @@ -79,10 +117,11 @@ (datomic-test-util/stub-deleted? ::measure false?) (testing "as GET request" - (measure-test/stub-evaluate-measure now ::db "2014" "2015" ::measure ::measure-report) + (measure-test/stub-evaluate-measure + now ::db "2014" "2015" ::measure ::measure-report) (let [{:keys [status body]} - @((handler clock ::conn ::term-service executor) + @((handler clock transaction-executor ::conn ::term-service executor) {::reitit/router ::router :request-method :get :path-params {:type "Measure" :id "0"} @@ -97,11 +136,19 @@ (testing "as POST request" (measure-test/stub-evaluate-measure now ::db "2014" "2015" ::measure {}) (datomic-test-util/stub-squuid "0") - (fhir-test-util/stub-upsert-resource ::conn ::term-service ::db :server-assigned-id {"id" "0"} {:db-after ::db-after}) - (create-test/stub-build-created-response ::router nil? ::db-after "MeasureReport" "0" ::response) + (stub-upsert-resource + ::conn ::term-service ::db :server-assigned-id {"id" "0"} + {:db-after ::db-after}) + (stub-build-created-response + ::router nil? ::db-after "MeasureReport" "0" ::response) (is (= ::response - @((handler clock ::conn ::term-service executor) + @((handler + clock + transaction-executor + ::conn + ::term-service + executor) {::reitit/router ::router :request-method :post :path-params {:type "Measure" :id "0"} diff --git a/test/blaze/fhir/operation/evaluate_measure/measure_test.clj b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj similarity index 98% rename from test/blaze/fhir/operation/evaluate_measure/measure_test.clj rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj index 978db8b9a..96fb972dc 100644 --- a/test/blaze/fhir/operation/evaluate_measure/measure_test.clj +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj @@ -229,9 +229,13 @@ "q10" 1 "q11" 1 "q12" 1 - "q13" 1)) + "q13" 1 + "q14" 1 + "q15" 1 + "q16" 1 + "q17" 2)) (comment - (evaluate "q13") + (evaluate "q16") (clojure.repl/pst) ) diff --git a/test/blaze/fhir/operation/evaluate_measure/q1-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q1-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q1-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q1-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q1-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q1-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q1-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q1-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q10-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q10-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q10-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q10-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q10-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q10-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q10-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q10-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q11-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q11-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q11-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q11-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q11-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q11-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q11-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q11-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q12-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q12-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q12-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q12-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q12-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q12-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q12-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q12-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q13-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q13-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q13-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q13-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q13-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q13-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q13-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q13-query.cql diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-data.json new file mode 100644 index 000000000..75ef8800f --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-data.json @@ -0,0 +1,135 @@ +{ + "resourceType": "bundle", + "type": "transaction", + "entry": [ + { + "resource": { + "resourceType": "Patient", + "id": "0", + "birthDate": "1990" + }, + "request": { + "method": "PUT", + "url": "Patient/0" + } + }, + { + "resource": { + "resourceType": "Patient", + "id": "1", + "birthDate": "2010" + }, + "request": { + "method": "PUT", + "url": "Patient/1" + } + }, + { + "request": { + "method": "PUT", + "url": "Condition/0" + }, + "resource": { + "code": { + "coding": [ + { + "code": "Z78.8", + "system": "http://hl7.org/fhir/sid/icd-10", + "version": "2016" + } + ] + }, + "id": "0", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/Condition" + ] + }, + "onsetDateTime": "2019-06-17", + "resourceType": "Condition", + "subject": { + "reference": "Patient/0" + } + } + }, + { + "request": { + "method": "PUT", + "url": "Condition/1" + }, + "resource": { + "code": { + "coding": [ + { + "code": "Z78.1", + "system": "http://hl7.org/fhir/sid/icd-10", + "version": "2016" + } + ] + }, + "id": "1", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/Condition" + ] + }, + "onsetDateTime": "2019-06-17", + "resourceType": "Condition", + "subject": { + "reference": "Patient/1" + } + } + }, + { + "resource": { + "resourceType": "Measure", + "id": "0", + "url": "0", + "status": "active", + "subjectCodeableConcept": { + "coding": [ + { + "system": "http://hl7.org/fhir/resource-types", + "code": "Patient" + } + ] + }, + "library": [ + "0" + ], + "scoring": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-scoring", + "code": "cohort" + } + ] + }, + "group": [ + { + "population": [ + { + "code": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-population", + "code": "initial-population" + } + ] + }, + "criteria": { + "language": "text/cql", + "expression": "InInitialPopulation" + } + } + ] + } + ] + }, + "request": { + "method": "PUT", + "url": "Measure/0" + } + } + ] +} diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-query.cql new file mode 100644 index 000000000..a07a7c722 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q14-query.cql @@ -0,0 +1,10 @@ +library Retrieve +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +context Patient + +define InInitialPopulation: + exists( + from [Condition] C + where AgeInYearsAt(FHIRHelpers.ToDateTime(C.onset)) between 18 and 45) diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-data.json new file mode 100644 index 000000000..5c175d8f3 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-data.json @@ -0,0 +1,79 @@ +{ + "resourceType": "bundle", + "type": "transaction", + "entry": [ + { + "resource": { + "resourceType": "Patient", + "id": "0", + "birthDate": "1940" + }, + "request": { + "method": "PUT", + "url": "Patient/0" + } + }, + { + "resource": { + "resourceType": "Patient", + "id": "1", + "birthDate": "1960" + }, + "request": { + "method": "PUT", + "url": "Patient/1" + } + }, + { + "resource": { + "resourceType": "Measure", + "id": "0", + "url": "0", + "status": "active", + "subjectCodeableConcept": { + "coding": [ + { + "system": "http://hl7.org/fhir/resource-types", + "code": "Patient" + } + ] + }, + "library": [ + "0" + ], + "scoring": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-scoring", + "code": "cohort" + } + ] + }, + "group": [ + { + "population": [ + { + "code": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-population", + "code": "initial-population" + } + ] + }, + "criteria": { + "language": "text/cql", + "expression": "InInitialPopulation" + } + } + ] + } + ] + }, + "request": { + "method": "PUT", + "url": "Measure/0" + } + } + ] +} diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-query.cql new file mode 100644 index 000000000..78cd02afc --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q15-query.cql @@ -0,0 +1,8 @@ +library Retrieve +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +context Patient + +define InInitialPopulation: + AgeInYears() between 18 and 45 diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-data.json new file mode 100644 index 000000000..3250a9dc7 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-data.json @@ -0,0 +1,347 @@ +{ + "entry": [ + { + "fullUrl": "ae9bc152-dcd3-4041-9877-4e99c95a5ede", + "request": { + "method": "PUT", + "url": "Patient/0" + }, + "resource": { + "birthDate": "1989-11-18", + "gender": "male", + "id": "0", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/Patient" + ] + }, + "resourceType": "Patient" + } + }, + { + "fullUrl": "2d4b66c4-4107-4382-9f2b-6b39351c39f0", + "request": { + "method": "PUT", + "url": "Observation/0-bmi" + }, + "resource": { + "category": [ + { + "coding": [ + { + "code": "vital-signs", + "system": "http://terminology.hl7.org/CodeSystem/observation-category" + } + ] + } + ], + "code": { + "coding": [ + { + "code": "39156-5", + "system": "http://loinc.org" + } + ] + }, + "effectiveDateTime": "2005-06-17", + "id": "0-bmi", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/Bmi" + ] + }, + "resourceType": "Observation", + "status": "final", + "subject": { + "reference": "Patient/0" + }, + "valueQuantity": { + "code": "kg/m2", + "system": "http://unitsofmeasure.org", + "unit": "kg/m2", + "value": 36.68645245341373 + } + } + }, + { + "fullUrl": "4e488e86-9160-4901-b51f-9de780ff18cb", + "request": { + "method": "PUT", + "url": "Observation/0-body-height" + }, + "resource": { + "category": [ + { + "coding": [ + { + "code": "vital-signs", + "system": "http://terminology.hl7.org/CodeSystem/observation-category" + } + ] + } + ], + "code": { + "coding": [ + { + "code": "8302-2", + "system": "http://loinc.org" + } + ] + }, + "effectiveDateTime": "2005-06-17", + "id": "0-body-height", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/BodyHeight" + ] + }, + "resourceType": "Observation", + "status": "final", + "subject": { + "reference": "Patient/0" + }, + "valueQuantity": { + "code": "cm", + "system": "http://unitsofmeasure.org", + "unit": "cm", + "value": 198.58090348834853 + } + } + }, + { + "fullUrl": "06df08da-6670-4a5b-a4e8-bd100205a4c5", + "request": { + "method": "PUT", + "url": "Observation/0-body-weight" + }, + "resource": { + "category": [ + { + "coding": [ + { + "code": "vital-signs", + "system": "http://terminology.hl7.org/CodeSystem/observation-category" + } + ] + } + ], + "code": { + "coding": [ + { + "code": "29463-7", + "system": "http://loinc.org" + } + ] + }, + "effectiveDateTime": "2005-06-17", + "id": "0-body-weight", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/BodyWeight" + ] + }, + "resourceType": "Observation", + "status": "final", + "subject": { + "reference": "Patient/0" + }, + "valueQuantity": { + "code": "kg", + "system": "http://unitsofmeasure.org", + "unit": "kg", + "value": 144.67073319145982 + } + } + }, + { + "fullUrl": "5cdada30-0afb-4a0e-8360-f28648672c40", + "request": { + "method": "PUT", + "url": "Condition/0-condition" + }, + "resource": { + "code": { + "coding": [ + { + "code": "Z77.8", + "system": "http://hl7.org/fhir/sid/icd-10", + "version": "2016" + } + ] + }, + "id": "0-condition", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/Condition" + ] + }, + "onsetDateTime": "2005-06-17", + "resourceType": "Condition", + "subject": { + "reference": "Patient/0" + } + } + }, + { + "fullUrl": "968b8484-db59-4c12-96d0-a88bdc4bbb5e", + "request": { + "method": "PUT", + "url": "Observation/0-tobacco-use" + }, + "resource": { + "code": { + "coding": [ + { + "code": "72166-2", + "system": "http://loinc.org" + } + ] + }, + "effectiveDateTime": "2005-06-17", + "id": "0-tobacco-use", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/TobaccoUse" + ] + }, + "resourceType": "Observation", + "status": "final", + "subject": { + "reference": "Patient/0" + }, + "valueCodeableConcept": { + "coding": [ + { + "code": "LA18977-1", + "system": "http://loinc.org" + } + ] + } + } + }, + { + "fullUrl": "9c535810-c70b-4d95-98a6-cd4b407c1a6f", + "request": { + "method": "PUT", + "url": "Specimen/0-specimen" + }, + "resource": { + "collection": { + "bodySite": { + "coding": [ + { + "code": "C26.1", + "system": "urn:oid:2.16.840.1.113883.6.43.1" + } + ] + }, + "collectedDateTime": "2005-06-17", + "fastingStatusCodeableConcept": { + "coding": [ + { + "code": "NF", + "system": "http://terminology.hl7.org/CodeSystem/v2-0916" + } + ] + } + }, + "extension": [ + { + "url": "https://fhir.bbmri.de/StructureDefinition/StorageTemperature", + "valueCodeableConcept": { + "coding": [ + { + "code": "temperature2to10", + "system": "https://fhir.bbmri.de/CodeSystem/StorageTemperature" + } + ] + } + }, + { + "url": "https://fhir.bbmri.de/StructureDefinition/SampleDiagnosis", + "valueCodeableConcept": { + "coding": [ + { + "code": "B59.8", + "system": "http://hl7.org/fhir/sid/icd-10" + } + ] + } + } + ], + "id": "0-specimen", + "meta": { + "profile": [ + "https://fhir.bbmri.de/StructureDefinition/Specimen" + ] + }, + "resourceType": "Specimen", + "subject": { + "reference": "Patient/0" + }, + "type": { + "coding": [ + { + "code": "whole-blood", + "system": "https://fhir.bbmri.de/CodeSystem/SampleMaterialType" + } + ] + } + } + }, + { + "resource": { + "resourceType": "Measure", + "id": "0", + "url": "0", + "status": "active", + "subjectCodeableConcept": { + "coding": [ + { + "system": "http://hl7.org/fhir/resource-types", + "code": "Specimen" + } + ] + }, + "library": [ + "0" + ], + "scoring": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-scoring", + "code": "cohort" + } + ] + }, + "group": [ + { + "population": [ + { + "code": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-population", + "code": "initial-population" + } + ] + }, + "criteria": { + "language": "text/cql", + "expression": "InInitialPopulation" + } + } + ] + } + ] + }, + "request": { + "method": "PUT", + "url": "Measure/0" + } + } + ], + "id": "13174b14-0167-4c59-8bc1-3ad1977d98bc", + "resourceType": "Bundle", + "type": "transaction" +} diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-query.cql new file mode 100644 index 000000000..59f33245d --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q16-query.cql @@ -0,0 +1,10 @@ +library Retrieve +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem FastingStatus: 'http://terminology.hl7.org/CodeSystem/v2-0916' + +context Specimen + +define InInitialPopulation: + Specimen.collection.fastingStatus.coding contains Code 'NF' from FastingStatus diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-data.json new file mode 100644 index 000000000..0d5e92d18 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-data.json @@ -0,0 +1,77 @@ +{ + "resourceType": "bundle", + "type": "transaction", + "entry": [ + { + "resource": { + "resourceType": "Patient", + "id": "0" + }, + "request": { + "method": "PUT", + "url": "Patient/0" + } + }, + { + "resource": { + "resourceType": "Patient", + "id": "1" + }, + "request": { + "method": "PUT", + "url": "Patient/1" + } + }, + { + "resource": { + "resourceType": "Measure", + "id": "0", + "url": "0", + "status": "active", + "subjectCodeableConcept": { + "coding": [ + { + "system": "http://hl7.org/fhir/resource-types", + "code": "Patient" + } + ] + }, + "library": [ + "0" + ], + "scoring": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-scoring", + "code": "cohort" + } + ] + }, + "group": [ + { + "population": [ + { + "code": { + "coding": [ + { + "system": "http://terminology.hl7.org/CodeSystem/measure-population", + "code": "initial-population" + } + ] + }, + "criteria": { + "language": "text/cql", + "expression": "InInitialPopulation" + } + } + ] + } + ] + }, + "request": { + "method": "PUT", + "url": "Measure/0" + } + } + ] +} diff --git a/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-query.cql new file mode 100644 index 000000000..c5d7a4316 --- /dev/null +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q17-query.cql @@ -0,0 +1,5 @@ +library Retrieve +using FHIR version '4.0.0' + +define InInitialPopulation: + true diff --git a/test/blaze/fhir/operation/evaluate_measure/q2-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q2-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q2-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q2-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q2-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q2-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q2-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q2-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q3-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q3-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q3-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q3-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q3-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q3-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q3-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q3-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q4-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q4-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q4-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q4-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q4-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q4-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q4-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q4-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q5-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q5-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q5-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q5-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q5-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q5-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q5-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q5-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q6-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q6-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q6-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q6-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q6-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q6-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q6-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q6-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q7-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q7-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q7-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q7-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q7-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q7-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q7-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q7-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q8-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q8-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q8-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q8-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q8-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q8-query.cql similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q8-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q8-query.cql diff --git a/test/blaze/fhir/operation/evaluate_measure/q9-data.json b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q9-data.json similarity index 100% rename from test/blaze/fhir/operation/evaluate_measure/q9-data.json rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q9-data.json diff --git a/test/blaze/fhir/operation/evaluate_measure/q9-query.cql b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q9-query.cql similarity index 80% rename from test/blaze/fhir/operation/evaluate_measure/q9-query.cql rename to modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q9-query.cql index 17df8886e..311e1fed3 100644 --- a/test/blaze/fhir/operation/evaluate_measure/q9-query.cql +++ b/modules/operations/measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/q9-query.cql @@ -10,4 +10,4 @@ define InInitialPopulation: exists( from Specimen.extension E where E.url = 'https://fhir.bbmri.de/StructureDefinition/StorageTemperature' - and E.value.coding contains Code 'temperatureRoom' from StorageTemperature) + and E.value.coding contains Code 'temperatureRoom' from StorageTemperature) diff --git a/modules/operations/measure-evaluate-measure/tests.edn b/modules/operations/measure-evaluate-measure/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/operations/measure-evaluate-measure/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/rest-api/deps.edn b/modules/rest-api/deps.edn new file mode 100644 index 000000000..5642eb291 --- /dev/null +++ b/modules/rest-api/deps.edn @@ -0,0 +1,54 @@ +{:deps + {blaze/module-base + {:local/root "../module-base"} + + blaze/spec + {:local/root "../spec"} + + blaze/rest-util + {:local/root "../rest-util"} + + blaze/structure-definition + {:local/root "../structure-definition"} + + buddy/buddy-auth + {:git/url "https://github.com/alexanderkiel/buddy-auth.git" + :sha "56c0396a6d8640ebd588f2895e5e4583dc48b903"} + + cheshire + {:mvn/version "5.9.0"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:mvn/version "0.7.0"} + + manifold + {:mvn/version "0.1.8"} + + org.clojars.akiel/datomic-spec + {:mvn/version "0.5.2"} + + prom-metrics + {:mvn/version "0.5-alpha2"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {com.datomic/datomic-free + {:mvn/version "0.9.5697"} + + lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/modules/rest-api/src/blaze/rest_api.clj b/modules/rest-api/src/blaze/rest_api.clj new file mode 100644 index 000000000..533cfc7e0 --- /dev/null +++ b/modules/rest-api/src/blaze/rest_api.clj @@ -0,0 +1,385 @@ +(ns blaze.rest-api + (:require + [blaze.bundle :as bundle] + [blaze.middleware.fhir.metrics :as metrics] + [blaze.module :refer [defcollector]] + [blaze.rest-api.middleware.auth-guard :refer [wrap-auth-guard]] + [blaze.rest-api.middleware.json :as json :refer [wrap-json]] + [blaze.rest-api.spec] + [blaze.spec] + [buddy.auth.middleware :refer [wrap-authentication]] + [buddy.auth.protocols :refer [IAuthentication]] + [clojure.spec.alpha :as s] + [integrant.core :as ig] + [reitit.ring] + [reitit.ring.spec] + [ring.util.response :as ring] + [taoensso.timbre :as log])) + + +(defn resolve-pattern + "Tries to find a resource pattern in `resource-patterns` according to the + name of the `structure-definition`. + + Falls back to the :default resource pattern if there is any." + {:arglists '([resource-patterns structure-definition])} + [resource-patterns {:keys [name]}] + (or + (some + #(when (= name (:blaze.rest-api.resource-pattern/type %)) %) + resource-patterns) + (some + #(when (= :default (:blaze.rest-api.resource-pattern/type %)) %) + resource-patterns))) + + +(defn resource-route + "Builds routes for one resource according to `structure-definition`. + + Returns nil if the resource has no match in `resource-patterns`. + + Route data contains resource type." + {:arglists '([resource-patterns structure-definition])} + [auth-backends resource-patterns {:keys [name] :as structure-definition}] + (when-let + [{:blaze.rest-api.resource-pattern/keys [interactions]} + (resolve-pattern resource-patterns structure-definition)] + [(str "/" name) + {:middleware + (cond-> [] + (seq auth-backends) + (conj wrap-auth-guard)) + :fhir.resource/type name} + ["" + (cond-> {:name (keyword name "type")} + (contains? interactions :search-type) + (assoc :get (-> interactions :search-type + :blaze.rest-api.interaction/handler)) + (contains? interactions :create) + (assoc :post (-> interactions :create + :blaze.rest-api.interaction/handler)))] + ["/_history" + (cond-> {} + (contains? interactions :history-type) + (assoc :get (-> interactions :history-type + :blaze.rest-api.interaction/handler)))] + ["/_search" + (cond-> {} + (contains? interactions :search-type) + (assoc :post (-> interactions :search-type + :blaze.rest-api.interaction/handler)))] + ["/{id}" + ["" + (cond-> {:name (keyword name "instance")} + (contains? interactions :read) + (assoc :get (-> interactions :read + :blaze.rest-api.interaction/handler)) + (contains? interactions :update) + (assoc :put (-> interactions :update + :blaze.rest-api.interaction/handler)) + (contains? interactions :delete) + (assoc :delete (-> interactions :delete + :blaze.rest-api.interaction/handler)))] + ["/_history" + ["" + (cond-> {:name (keyword name "history-instance")} + (contains? interactions :history-instance) + (assoc :get (-> interactions :history-instance + :blaze.rest-api.interaction/handler)))] + ["/{vid}" + (cond-> {:name (keyword name "versioned-instance")} + (contains? interactions :vread) + (assoc :get (-> interactions :vread + :blaze.rest-api.interaction/handler)))]]]])) + + +(s/def ::structure-definitions + (s/coll-of :fhir.un/StructureDefinition)) + + +(defn router + {:arglists '([config capabilities-handler])} + [{:keys + [base-url + context-path + structure-definitions + auth-backends + transaction-handler + history-system-handler + resource-patterns + operations] + :or {context-path ""}} + capabilities-handler] + (reitit.ring/router + (-> ["" + {:blaze/base-url (str base-url context-path) + :middleware + (cond-> [] + (seq auth-backends) + (conj #(apply wrap-authentication % auth-backends)))} + ["" + (cond-> + {:middleware + (cond-> [] + (seq auth-backends) + (conj wrap-auth-guard))} + (some? transaction-handler) + (assoc :post transaction-handler))] + ["/metadata" + {:get capabilities-handler}] + ["/_history" + (cond-> + {:middleware + (cond-> [] + (seq auth-backends) + (conj wrap-auth-guard))} + (some? history-system-handler) + (assoc :get history-system-handler))]] + (into + (comp + (filter #(= "resource" (:kind %))) + (remove :experimental) + (remove :abstract) + (map #(resource-route auth-backends resource-patterns %)) + (remove nil?)) + structure-definitions) + (into + (mapcat + (fn [{:blaze.rest-api.operation/keys + [code system-handler]}] + (when system-handler + [(str "/$" code) + {:middleware + (cond-> [] + (seq auth-backends) + (conj wrap-auth-guard)) + :get system-handler + :post system-handler}]))) + operations) + (into + (mapcat + (fn [{:blaze.rest-api.operation/keys + [code resource-types type-handler]}] + (when type-handler + (map + (fn [resource-type] + [(str "/" resource-type "/$" code) + {:middleware + (cond-> [] + (seq auth-backends) + (conj wrap-auth-guard)) + :get type-handler + :post type-handler}]) + resource-types)))) + operations) + (into + (mapcat + (fn [{:blaze.rest-api.operation/keys + [code resource-types instance-handler]}] + (when instance-handler + (map + (fn [resource-type] + [(str "/" resource-type "/{id}/$" code) + {:middleware + (cond-> [] + (seq auth-backends) + (conj wrap-auth-guard)) + :get instance-handler + :post instance-handler}]) + resource-types)))) + operations)) + {:path context-path + :syntax :bracket + :conflicts nil + :validate reitit.ring.spec/validate + :reitit.ring/default-options-handler + (fn [_] + (-> (ring/response nil) + (ring/status 405)))})) + + +(defn- capability-resource + {:arglists '([resource-patterns operations structure-definition])} + [resource-patterns operations {:keys [name] :as structure-definition}] + (when-let + [{:blaze.rest-api.resource-pattern/keys [interactions]} + (resolve-pattern resource-patterns structure-definition)] + (let [operations + (filter + #(some #{name} (:blaze.rest-api.operation/resource-types %)) + operations)] + (cond-> + {:type name + :interaction + (reduce + (fn [res code] + (if-let + [{:blaze.rest-api.interaction/keys [doc]} (get interactions code)] + (conj + res + (cond-> + {:code (clojure.core/name code)} + doc + (assoc :documentation doc))) + res)) + [] + [:read + :vread + :update + :delete + :history-instance + :history-type + :create + :search-type]) + :versioning "versioned" + :readHistory true + :updateCreate true + :conditionalCreate false + :conditionalRead "not-supported" + :conditionalUpdate false + :conditionalDelete "not-supported" + :referencePolicy + ["literal" + "enforced" + "local"] + :searchParam + [{:name "identifier" + :definition (str "http://hl7.org/fhir/SearchParameter/" name "-identifier") + :type "token"}]} + + (seq operations) + (assoc + :operation + (into + [] + (mapcat + (fn [{:blaze.rest-api.operation/keys + [code def-uri type-handler instance-handler]}] + (when (or type-handler instance-handler) + [{:name code + :definition def-uri}]))) + operations)))))) + + +(defn capabilities-handler + [{:keys + [base-url + version + context-path + structure-definitions + transaction-handler + history-system-handler + resource-patterns + operations] + :or {context-path ""}}] + (let [capability-statement + {:resourceType "CapabilityStatement" + :status "active" + :kind "instance" + :date "2019-08-28T00:00:00Z" + :software + {:name "Blaze" + :version version} + :implementation + {:description (str "Blaze running at " base-url context-path) + :url (str base-url context-path)} + :fhirVersion "4.0.0" + :format ["application/fhir+json"] + :rest + [{:mode "server" + :resource + (into + [] + (comp + (filter #(= "resource" (:kind %))) + (remove :experimental) + (remove :abstract) + (map #(capability-resource resource-patterns operations %)) + (remove nil?)) + structure-definitions) + :interaction + (cond-> [] + (some? transaction-handler) + (conj {:code "transaction"} {:code "batch"}) + (some? history-system-handler) + (conj {:code "history-system"}))}]}] + (fn [_] + (ring/response capability-statement)))) + + +(def default-handler + (reitit.ring/create-default-handler + {:not-found + (fn [_] + (ring/not-found + {:resourceType "OperationOutcome" + :issue + [{:severity "error" + :code "not-found"}]})) + :method-not-allowed + (fn [_] + (-> (ring/response + {:resourceType "OperationOutcome" + :issue + [{:severity "error" + :code "processing"}]}) + (ring/status 405))) + :not-acceptable + (fn [_] + (-> (ring/response + {:resourceType "OperationOutcome" + :issue + [{:severity "error" + :code "structure"}]}) + (ring/status 406)))})) + + +(defn handler + "Whole app Ring handler." + [config] + (-> (reitit.ring/ring-handler + (router config (capabilities-handler config)) + default-handler) + (wrap-json))) + + +(defmethod ig/pre-init-spec :blaze/rest-api [_] + (s/keys + :req-un + [:blaze/base-url + ::version + ::structure-definitions] + :opt-un + [::context-path + ::auth-backends + ::transaction-handler + ::history-system-handler + ::resource-patterns + ::operations])) + + +(defmethod ig/init-key :blaze/rest-api + [_ {:keys [base-url context-path] :as config}] + (log/info + "Init FHIR RESTful API with base URL:" (str base-url context-path)) + (handler config)) + + +(defcollector requests-total [_] + metrics/requests-total) + + +(defcollector request-duration-seconds [_] + metrics/request-duration-seconds) + + +(defcollector parse-duration-seconds [_] + json/parse-duration-seconds) + + +(defcollector generate-duration-seconds [_] + json/generate-duration-seconds) + + +(defcollector tx-data-duration-seconds [_] + bundle/tx-data-duration-seconds) diff --git a/modules/rest-api/src/blaze/rest_api/middleware/auth_guard.clj b/modules/rest-api/src/blaze/rest_api/middleware/auth_guard.clj new file mode 100644 index 000000000..d602a5e00 --- /dev/null +++ b/modules/rest-api/src/blaze/rest_api/middleware/auth_guard.clj @@ -0,0 +1,22 @@ +(ns blaze.rest-api.middleware.auth-guard + (:require + [buddy.auth :refer [authenticated?]] + [ring.util.response :as ring])) + + +(defn wrap-auth-guard + "If the request is unauthenticated return a 401 response." + [handler] + (fn [request] + (if (authenticated? request) + (handler request) + (-> (ring/response + {:resourceType "OperationOutcome" + :issue + [{:severity "error" + :code "login" + :details + {:coding + [{:system "http://terminology.hl7.org/CodeSystem/operation-outcome" + :code "MSG_AUTH_REQUIRED"}]}}]}) + (ring/status 401))))) diff --git a/src/blaze/middleware/json.clj b/modules/rest-api/src/blaze/rest_api/middleware/json.clj similarity index 96% rename from src/blaze/middleware/json.clj rename to modules/rest-api/src/blaze/rest_api/middleware/json.clj index 07afe1b50..cb6bb1689 100644 --- a/src/blaze/middleware/json.clj +++ b/modules/rest-api/src/blaze/rest_api/middleware/json.clj @@ -1,15 +1,15 @@ -(ns blaze.middleware.json +(ns blaze.rest-api.middleware.json (:require [blaze.handler.util :as handler-util] [cheshire.core :as json] [cheshire.parse :refer [*use-bigdecimals?*]] [clojure.java.io :as io] + [clojure.string :as str] [cognitect.anomalies :as anom] [manifold.deferred :as md] [prometheus.alpha :as prom] [ring.util.response :as ring] - [taoensso.timbre :as log] - [clojure.string :as str])) + [taoensso.timbre :as log])) (prom/defhistogram parse-duration-seconds diff --git a/modules/rest-api/src/blaze/rest_api/spec.clj b/modules/rest-api/src/blaze/rest_api/spec.clj new file mode 100644 index 000000000..06c52451f --- /dev/null +++ b/modules/rest-api/src/blaze/rest_api/spec.clj @@ -0,0 +1,115 @@ +(ns blaze.rest-api.spec + (:require + [blaze.spec] + [clojure.spec.alpha :as s] + [integrant.core :as ig]) + (:import + [buddy.auth.protocols IAuthentication])) + + +(s/def :blaze.rest-api/auth-backends + (s/coll-of #(satisfies? IAuthentication %))) + + +(s/def :blaze.rest-api/transaction-handler + fn?) + + +(s/def :blaze.rest-api/history-system-handler + fn?) + + +(s/def :blaze.rest-api.resource-pattern/type + (s/or :name string? :default #{:default})) + + +(def interaction-code? + #{:read + :vread + :update + :patch + :delete + :history-instance + :history-type + :create + :search-type}) + + +(s/def :blaze.rest-api.interaction/handler + (s/or :ref ig/ref? :handler fn?)) + + +(s/def :blaze.rest-api.interaction/doc + string?) + + +(s/def :blaze.rest-api/interaction + (s/keys + :req + [:blaze.rest-api.interaction/handler] + :opt + [:blaze.rest-api.interaction/doc])) + + +;; Interactions keyed there code +(s/def :blaze.rest-api.resource-pattern/interactions + (s/map-of interaction-code? :blaze.rest-api/interaction)) + + +(s/def :blaze.rest-api/resource-pattern + (s/keys + :req + [:blaze.rest-api.resource-pattern/type + :blaze.rest-api.resource-pattern/interactions])) + + +(s/def :blaze.rest-api/resource-patterns + (s/coll-of :blaze.rest-api/resource-pattern)) + + +(s/def :blaze.rest-api/version + string?) + + +(s/def :blaze.rest-api/context-path + string?) + + +(s/def :blaze.rest-api.operation/code + string?) + + +(s/def :blaze.rest-api.operation/def-uri + string?) + + +(s/def :blaze.rest-api.operation/resource-types + (s/coll-of string?)) + + +(s/def :blaze.rest-api.operation/system-handler + (s/or :ref ig/ref? :handler fn?)) + + +(s/def :blaze.rest-api.operation/type-handler + (s/or :ref ig/ref? :handler fn?)) + + +(s/def :blaze.rest-api.operation/instance-handler + (s/or :ref ig/ref? :handler fn?)) + + +(s/def :blaze.rest-api/operation + (s/keys + :req + [:blaze.rest-api.operation/code + :blaze.rest-api.operation/def-uri + :blaze.rest-api.operation/resource-types] + :opt + [:blaze.rest-api.operation/system-handler + :blaze.rest-api.operation/type-handler + :blaze.rest-api.operation/instance-handler])) + + +(s/def :blaze.rest-api/operations + (s/coll-of :blaze.rest-api/operation)) diff --git a/modules/rest-api/test/blaze/rest_api_test.clj b/modules/rest-api/test/blaze/rest_api_test.clj new file mode 100644 index 000000000..ae1135b76 --- /dev/null +++ b/modules/rest-api/test/blaze/rest_api_test.clj @@ -0,0 +1,184 @@ +(ns blaze.rest-api-test + (:require + [blaze.rest-api :as rest-api] + [clojure.spec.test.alpha :as st] + [clojure.test :as test :refer [are deftest is testing]] + [juxt.iota :refer [given]] + [reitit.core :as reitit] + [reitit.ring] + [taoensso.timbre :as log])) + + +(defn fixture [f] + (st/instrument) + (log/with-merged-config {:level :fatal} (f)) + (st/unstrument)) + + +(test/use-fixtures :each fixture) + + +(def config + #:blaze.rest-api + {}) + + +(def router + (rest-api/router + {:structure-definitions [{:kind "resource" :name "Patient"}] + :resource-patterns + [#:blaze.rest-api.resource-pattern + {:type :default + :interactions + {:read + #:blaze.rest-api.interaction + {:handler (fn [_] ::read)} + :vread + #:blaze.rest-api.interaction + {:handler (fn [_] ::vread)} + :update + #:blaze.rest-api.interaction + {:handler (fn [_] ::update)} + :delete + #:blaze.rest-api.interaction + {:handler (fn [_] ::delete)} + :history-instance + #:blaze.rest-api.interaction + {:handler (fn [_] ::history-instance)} + :history-type + #:blaze.rest-api.interaction + {:handler (fn [_] ::history-type)} + :create + #:blaze.rest-api.interaction + {:handler (fn [_] ::create)} + :search-type + #:blaze.rest-api.interaction + {:handler (fn [_] ::search-type)}}}]} + (fn [_]))) + + +(comment + (doseq [route (reitit/routes router)] + (prn route))) + + +(deftest router-test + (testing "Patient matches" + (are [path request-method handler] + (= handler + ((get-in + (reitit/match-by-path router path) + [:result request-method :handler]) + {})) + "/Patient" :get ::search-type + "/Patient" :post ::create + "/Patient/_history" :get ::history-type + "/Patient/_search" :post ::search-type + "/Patient/0" :get ::read + "/Patient/0" :put ::update + "/Patient/0" :delete ::delete + "/Patient/0/_history" :get ::history-instance + "/Patient/0/_history/42" :get ::vread)) + + (testing "Patient instance POST is not allowed" + (given ((reitit.ring/ring-handler router rest-api/default-handler) + {:uri "/Patient/0" :request-method :post}) + :status := 405 + [:body :resourceType] := "OperationOutcome" + [:body :issue 0 :severity] := "error" + [:body :issue 0 :code] := "processing")) + + (testing "Observations are not found" + (given ((reitit.ring/ring-handler router rest-api/default-handler) + {:uri "/Observation" :request-method :get}) + :status := 404 + [:body :resourceType] := "OperationOutcome" + [:body :issue 0 :severity] := "error" + [:body :issue 0 :code] := "not-found"))) + + +(deftest router-match-by-name-test + (are [name params path] + (= (reitit/match->path (reitit/match-by-name router name params)) path) + + :Patient/type + {} + "/Patient" + + :Patient/instance + {:id "23"} + "/Patient/23" + + :Patient/versioned-instance + {:id "23" :vid "42"} + "/Patient/23/_history/42")) + + +(deftest capabilities-handler-test + (testing "minimal config" + (given + (-> ((rest-api/capabilities-handler + {:base-url "base-url-131713" + :version "version-131640" + :structure-definitions + [{:kind "resource" :name "Patient"}]}) + {}) + :body) + :resourceType := "CapabilityStatement" + :status := "active" + :kind := "instance" + [:software :name] := "Blaze" + [:software :version] := "version-131640" + [:implementation :url] := "base-url-131713" + :fhirVersion := "4.0.0" + :format := ["application/fhir+json"])) + + (testing "one interaction" + (given + (-> ((rest-api/capabilities-handler + {:base-url "base-url-131713" + :version "version-131640" + :structure-definitions + [{:kind "resource" :name "Patient"}] + :resource-patterns + [#:blaze.rest-api.resource-pattern + {:type "Patient" + :interactions + {:read + #:blaze.rest-api.interaction + {:handler (fn [_])}}}]}) + {}) + :body) + :resourceType := "CapabilityStatement" + [:rest 0 :resource 0 :type] := "Patient" + [:rest 0 :resource 0 :interaction 0 :code] := "read")) + + (testing "one operation" + (given + (-> ((rest-api/capabilities-handler + {:base-url "base-url-131713" + :version "version-131640" + :structure-definitions + [{:kind "resource" :name "Measure"}] + :resource-patterns + [#:blaze.rest-api.resource-pattern + {:type "Measure" + :interactions + {:read + #:blaze.rest-api.interaction + {:handler (fn [_])}}}] + :operations + [#:blaze.rest-api.operation + {:code "evaluate-measure" + :def-uri + "http://hl7.org/fhir/OperationDefinition/Measure-evaluate-measure" + :resource-types ["Measure"] + :type-handler (fn [_]) + :instance-handler (fn [_])}]}) + {}) + :body) + :resourceType := "CapabilityStatement" + [:rest 0 :resource 0 :type] := "Measure" + [:rest 0 :resource 0 :operation 0 :name] := "evaluate-measure" + [:rest 0 :resource 0 :operation 0 :definition] := + "http://hl7.org/fhir/OperationDefinition/Measure-evaluate-measure"))) diff --git a/modules/rest-api/tests.edn b/modules/rest-api/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/rest-api/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/rest-util/deps.edn b/modules/rest-util/deps.edn new file mode 100644 index 000000000..1c4eef032 --- /dev/null +++ b/modules/rest-util/deps.edn @@ -0,0 +1,44 @@ +{:deps + {blaze/datomic + {:local/root "../datomic"} + + com.cognitect/anomalies + {:mvn/version "0.1.12"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + org.apache.httpcomponents/httpcore + {:mvn/version "4.4.12"} + + metosin/reitit-ring + {:mvn/version "0.3.9" + :exclusions [ring/ring-core]} + + ring/ring-core + {:mvn/version "1.7.1" + :exclusions + [clj-time/clj-time + commons-fileupload/commons-fileupload + crypto-equality/crypto-equality + crypto-random/crypto-random]}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {blaze/datomic-test-util + {:local/root "../datomic-test-util"} + + lambdaisland/kaocha + {:mvn/version "0.0-554"} + + org.clojars.akiel/iota + {:mvn/version "0.1"} + + org.clojure/test.check + {:mvn/version "0.10.0"}} + + :main-opts + ["-m" "kaocha.runner"]}}} diff --git a/src/blaze/bundle.clj b/modules/rest-util/src/blaze/bundle.clj similarity index 98% rename from src/blaze/bundle.clj rename to modules/rest-util/src/blaze/bundle.clj index b7f5df8c3..974c4c3b9 100644 --- a/src/blaze/bundle.clj +++ b/modules/rest-util/src/blaze/bundle.clj @@ -157,10 +157,10 @@ :version-increment (if (empty? tx-data) 0 1) :tx-data tx-data} - (and tempid (not (empty? tx-data))) + (and tempid (seq tx-data)) (assoc :tempid tempid) - (and (nil? tempid) (not (empty? tx-data))) + (and (nil? tempid) (seq tx-data)) (assoc :eid (:db/id (util/resource db type id)))))) diff --git a/src/blaze/fhir/response/create.clj b/modules/rest-util/src/blaze/fhir/response/create.clj similarity index 100% rename from src/blaze/fhir/response/create.clj rename to modules/rest-util/src/blaze/fhir/response/create.clj diff --git a/src/blaze/handler/fhir/util.clj b/modules/rest-util/src/blaze/handler/fhir/util.clj similarity index 71% rename from src/blaze/handler/fhir/util.clj rename to modules/rest-util/src/blaze/handler/fhir/util.clj index 0b29a8818..1a9037081 100644 --- a/src/blaze/handler/fhir/util.clj +++ b/modules/rest-util/src/blaze/handler/fhir/util.clj @@ -3,10 +3,10 @@ `delete-resource`." (:require [blaze.datomic.transaction :as tx] - [blaze.datomic.util :as util] + [blaze.datomic.util :as datomic-util] + [blaze.executors :refer [executor?]] [blaze.terminology-service :refer [term-service?]] [clojure.spec.alpha :as s] - [datomic.api :as d] [datomic-spec.core :as ds] [manifold.deferred :as md :refer [deferrable?]] [reitit.core :as reitit])) @@ -24,11 +24,11 @@ (defn- update-system-and-type-tx-data [db tempid {type "resourceType" id "id"}] - (let [resource (util/resource db type id)] + (let [resource (datomic-util/resource db type id)] (cond-> (increment-version type) - (or (nil? resource) (util/deleted? resource)) + (or (nil? resource) (datomic-util/deleted? resource)) (into (increment-total type)) (nil? resource) @@ -38,24 +38,32 @@ (conj [:db/add "datomic.tx" :tx/resources (:db/id resource)])))) -(defn- upsert-resource* [conn db creation-mode resource] +(defn- upsert-resource* [transaction-executor conn db creation-mode resource] (let [[type id tempid] (tx/resource-tempid db resource) tempids (when tempid {type {id tempid}}) tx-data (tx/resource-upsert db tempids creation-mode resource)] (if (empty? tx-data) {:db-after db} (tx/transact-async - conn (into tx-data (update-system-and-type-tx-data db tempid resource)))))) + transaction-executor + conn + (into tx-data (update-system-and-type-tx-data db tempid resource)))))) (s/fdef upsert-resource - :args (s/cat :conn ::ds/conn :term-service term-service? :db ::ds/db - :creation-mode ::tx/creation-mode - :resource ::tx/resource) + :args + (s/cat + :transaction-executor executor? + :conn ::ds/conn + :term-service term-service? + :db ::ds/db + :creation-mode ::tx/creation-mode + :resource ::tx/resource) :ret deferrable?) (defn upsert-resource - [conn term-service db creation-mode resource] + "Upserts `resource` and returns the deferred transaction result." + [transaction-executor conn term-service db creation-mode resource] (-> (tx/annotate-codes term-service db resource) (md/chain' (fn [resource] @@ -63,11 +71,21 @@ (md/chain' (fn [tx-data] (if (empty? tx-data) - (upsert-resource* conn db creation-mode resource) - (-> (tx/transact-async conn tx-data) + (upsert-resource* + transaction-executor + conn + db + creation-mode + resource) + (-> (tx/transact-async transaction-executor conn tx-data) (md/chain' (fn [{db :db-after}] - (upsert-resource* conn db creation-mode resource)))))))))))) + (upsert-resource* + transaction-executor + conn + db + creation-mode + resource)))))))))))) (defn- decrement-total [type] @@ -76,24 +94,32 @@ (defn- delete-system-and-type-tx-data [db type id] - (let [resource (util/resource db type id)] + (let [resource (datomic-util/resource db type id)] (-> (decrement-total type) (into (increment-version type)) (conj [:db/add "datomic.tx" :tx/resources (:db/id resource)])))) (s/fdef delete-resource - :args (s/cat :conn ::ds/conn :db ::ds/db :type string? :id string?)) + :args + (s/cat + :transaction-executor executor? + :conn ::ds/conn + :db ::ds/db + :type string? + :id string?)) (defn delete-resource - [conn db type id] + [transaction-executor conn db type id] (-> (md/future (tx/resource-deletion db type id)) (md/chain' (fn [tx-data] (if (empty? tx-data) {:db-after db} (tx/transact-async - conn (into tx-data (delete-system-and-type-tx-data db type id)))))))) + transaction-executor + conn + (into tx-data (delete-system-and-type-tx-data db type id)))))))) (s/fdef t diff --git a/src/blaze/handler/util.clj b/modules/rest-util/src/blaze/handler/util.clj similarity index 88% rename from src/blaze/handler/util.clj rename to modules/rest-util/src/blaze/handler/util.clj index 5031adb79..b49ddb702 100644 --- a/src/blaze/handler/util.clj +++ b/modules/rest-util/src/blaze/handler/util.clj @@ -3,12 +3,15 @@ (:require [clojure.core.protocols :refer [Datafiable]] [clojure.datafy :refer [datafy]] + [clojure.spec.alpha :as s] [clojure.string :as str] [cognitect.anomalies :as anom] + [datomic.api :as d] + [datomic-spec.core :as ds] [io.aviso.exception :as aviso] + [manifold.deferred :as md :refer [deferred?]] [ring.util.response :as ring] - [taoensso.timbre :as log] - [clojure.spec.alpha :as s]) + [taoensso.timbre :as log]) (:import [org.apache.http HeaderElement] [org.apache.http.message BasicHeaderValueParser])) @@ -156,3 +159,18 @@ :else (bundle-error-response {::anom/category ::anom/fault}))) + + +(s/fdef db + :args (s/cat :conn ::ds/conn :t (s/nilable nat-int?)) + :ret (s/or :deferred deferred? :db ::ds/db)) + +(defn db + "Retrieves a value of the database, optionally as of some point `t`. + + When `t` is non-nil, returns a deferred which will be realized when the + database with `t` is available." + [conn t] + (if t + (-> (d/sync conn t) (md/chain #(d/as-of % t))) + (d/db conn))) diff --git a/src/blaze/middleware/fhir/metrics.clj b/modules/rest-util/src/blaze/middleware/fhir/metrics.clj similarity index 100% rename from src/blaze/middleware/fhir/metrics.clj rename to modules/rest-util/src/blaze/middleware/fhir/metrics.clj diff --git a/test/blaze/bundle_test.clj b/modules/rest-util/test/blaze/bundle_test.clj similarity index 96% rename from test/blaze/bundle_test.clj rename to modules/rest-util/test/blaze/bundle_test.clj index 6422de6a8..8c98d923e 100644 --- a/test/blaze/bundle_test.clj +++ b/modules/rest-util/test/blaze/bundle_test.clj @@ -4,7 +4,7 @@ [blaze.datomic.test-util :as datomic-test-util] [blaze.terminology-service :as ts] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :refer [deftest is testing]] [cognitect.anomalies :as anom] [datomic.api :as d] [datomic-spec.test :as dst] @@ -275,15 +275,3 @@ [:db/add "datomic.tx" :tx/resources id] ::resource-upsert-tx-data ::resource-deletion-tx-data])))))) - - -(defn stub-annotate-codes [term-service db] - (st/instrument - [`annotate-codes] - {:spec - {`annotate-codes - (s/fspec - :args (s/cat :term-service #{term-service} :db #{db} :entries some?))} - :replace - {`annotate-codes - (fn [_ _ entries] entries)}})) diff --git a/test/blaze/fhir/response/create_test.clj b/modules/rest-util/test/blaze/fhir/response/create_test.clj similarity index 62% rename from test/blaze/fhir/response/create_test.clj rename to modules/rest-util/test/blaze/fhir/response/create_test.clj index 2f614fa25..84b98042a 100644 --- a/test/blaze/fhir/response/create_test.clj +++ b/modules/rest-util/test/blaze/fhir/response/create_test.clj @@ -1,23 +1,52 @@ (ns blaze.fhir.response.create-test (:require [blaze.datomic.test-util :as datomic-test-util] - [blaze.fhir.response.create :refer :all] - [blaze.handler.fhir.test-util :as test-util] + [blaze.fhir.response.create :refer [build-created-response]] + [blaze.handler.fhir.util :as fhir-util] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all])) + [clojure.test :as test :refer [deftest is testing]] + [taoensso.timbre :as log])) + + +(defn fixture [f] + (st/instrument) + (st/instrument + [`build-created-response] + {:spec + {`build-created-response + (s/fspec + :args (s/cat :router #{::router} :return-preference (s/nilable string?) + :db #{::db} :type string? :id string?))}}) + (log/with-merged-config {:level :error} (f)) + (st/unstrument)) + + +(test/use-fixtures :each fixture) + + +(defn stub-versioned-instance-url [router type id vid url] + (st/instrument + [`fhir-util/versioned-instance-url] + {:spec + {`fhir-util/versioned-instance-url + (s/fspec + :args (s/cat :router #{router} :type #{type} :id #{id} :vid #{vid}) + :ret #{url})} + :stub + #{`fhir-util/versioned-instance-url}})) (deftest build-created-response-test (datomic-test-util/stub-basis-transaction ::db {:db/txInstant #inst "2019-05-14T13:58:20.060-00:00"}) (datomic-test-util/stub-basis-t ::db 42) - (test-util/stub-versioned-instance-url ::router "Patient" "0" "42" ::location) + (stub-versioned-instance-url ::router "Patient" "0" "42" ::location) (datomic-test-util/stub-pull-resource ::db "Patient" "0" #{::resource}) (testing "with no Prefer header" (let [{:keys [status headers body]} - (build-created-response ::router nil? ::db "Patient" "0")] + (build-created-response ::router nil ::db "Patient" "0")] (testing "Returns 201" (is (= 201 status))) @@ -48,17 +77,3 @@ (testing "Contains the resource as body" (is (= ::resource body)))))) - - -(defn stub-build-created-response - [router return-preference-spec db type id response] - (st/instrument - [`build-created-response] - {:spec - {`build-created-response - (s/fspec - :args (s/cat :router #{router} :return-preference return-preference-spec - :db #{db} :type #{type} :id #{id}) - :ret #{response})} - :stub - #{`build-created-response}})) diff --git a/modules/rest-util/test/blaze/handler/fhir/util_test.clj b/modules/rest-util/test/blaze/handler/fhir/util_test.clj new file mode 100644 index 000000000..355d15f0a --- /dev/null +++ b/modules/rest-util/test/blaze/handler/fhir/util_test.clj @@ -0,0 +1,153 @@ +(ns blaze.handler.fhir.util-test + (:require + [blaze.datomic.transaction :as tx] + [blaze.handler.fhir.util + :refer [upsert-resource type-url instance-url versioned-instance-url]] + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as st] + [clojure.test :as test :refer [deftest is testing]] + [juxt.iota :refer [given]] + [manifold.deferred :as md] + [reitit.core :as reitit])) + + +(defn fixture [f] + (st/instrument) + (f) + (st/unstrument)) + + +(test/use-fixtures :each fixture) + + +(defn- stub-annotate-codes [term-service db resource result] + (st/instrument + `tx/annotate-codes + {:spec + {`tx/annotate-codes + (s/fspec + :args + (s/cat :term-service #{term-service} :db #{db} :resource #{resource}) + :ret #{result})} + :stub + #{`tx/annotate-codes}})) + + +(defn- stub-resource-codes-creation [db resource result] + (st/instrument + `tx/resource-codes-creation + {:spec + {`tx/resource-codes-creation + (s/fspec + :args (s/cat :db #{db} :resource #{resource}) + :ret #{result})} + :stub + #{`tx/resource-codes-creation}})) + + +(defn- stub-resource-tempid [db resource result-spec] + (st/instrument + `tx/resource-tempid + {:spec + {`tx/resource-tempid + (s/fspec + :args (s/cat :db #{db} :resource #{resource}) + :ret result-spec)} + :stub + #{`tx/resource-tempid}})) + + +(defn- stub-resource-upsert [db tempids-spec creation-mode resource result] + (st/instrument + `tx/resource-upsert + {:spec + {`tx/resource-upsert + (s/fspec + :args + (s/cat + :db #{db} + :tempids tempids-spec + :creation-mode #{creation-mode} + :resource #{resource}) + :ret #{result})} + :stub + #{`tx/resource-upsert}})) + + +(deftest upsert-resource-test + (st/unstrument `upsert-resource) + + (testing "Returns :db-after even when nothing has changed" + (let [resource + {"resourceType" "Patient" + "id" "0"}] + (stub-annotate-codes + ::term-service ::db resource (md/success-deferred resource)) + (stub-resource-codes-creation ::db resource []) + (stub-resource-tempid ::db resource nil?) + (stub-resource-upsert ::db nil? ::creation-mode resource []) + + (given + @(upsert-resource + ::transaction-executor + ::conn + ::term-service + ::db + ::creation-mode + resource) + :db-after := ::db)))) + + +(defn- stub-match-by-name [router name params match] + (st/instrument + [`reitit/match-by-name] + {:spec + {`reitit/match-by-name + (s/fspec + :args (s/cat :router #{router} :name #{name} + :params #{params}) + :ret #{match})} + :stub + #{`reitit/match-by-name}})) + + +(deftest type-url-test + (st/instrument + [`type-url] + {:spec + {`type-url + (s/fspec + :args (s/cat :router #{::router} :type #{::type}))}}) + (stub-match-by-name + ::router :fhir/type {:type ::type} + {:data {:blaze/base-url "base-url"} :path "path"}) + + (is (= "base-url/path" (type-url ::router ::type)))) + + +(deftest instance-url-test + (st/instrument + [`instance-url] + {:spec + {`instance-url + (s/fspec + :args (s/cat :router #{::router} :type #{::type} :id #{::id}))}}) + (stub-match-by-name + ::router :fhir/instance {:type ::type :id ::id} + {:data {:blaze/base-url "base-url"} :path "path"}) + + (is (= "base-url/path" (instance-url ::router ::type ::id)))) + + +(deftest versioned-instance-url-test + (st/instrument + [`versioned-instance-url] + {:spec + {`versioned-instance-url + (s/fspec + :args (s/cat :router #{::router} :type #{::type} :id #{::id} :vid #{::vid}))}}) + (stub-match-by-name + ::router :fhir/versioned-instance {:type ::type :id ::id :vid ::vid} + {:data {:blaze/base-url "base-url"} :path "path"}) + + (is (= "base-url/path" (versioned-instance-url ::router ::type ::id ::vid)))) diff --git a/test/blaze/handler/util_test.clj b/modules/rest-util/test/blaze/handler/util_test.clj similarity index 53% rename from test/blaze/handler/util_test.clj rename to modules/rest-util/test/blaze/handler/util_test.clj index fce3f23d6..b24e06f9b 100644 --- a/test/blaze/handler/util_test.clj +++ b/modules/rest-util/test/blaze/handler/util_test.clj @@ -1,7 +1,11 @@ (ns blaze.handler.util-test (:require - [blaze.handler.util :refer :all] - [clojure.test :refer :all])) + [blaze.handler.util :refer [preference]] + [clojure.test :refer [deftest is]] + [clojure.spec.test.alpha :as st])) + + +(st/instrument) (deftest preference-test diff --git a/modules/rest-util/test/blaze/middleware/fhir/metrics_test.clj b/modules/rest-util/test/blaze/middleware/fhir/metrics_test.clj new file mode 100644 index 000000000..ab4a34e7f --- /dev/null +++ b/modules/rest-util/test/blaze/middleware/fhir/metrics_test.clj @@ -0,0 +1,12 @@ +(ns blaze.middleware.fhir.metrics-test + (:require + [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] + [clojure.spec.test.alpha :as st] + [clojure.test :refer [deftest is]])) + + +(st/instrument) + + +(deftest wrap-observe-request-duration-test + (is (fn? (wrap-observe-request-duration identity)))) diff --git a/modules/rest-util/tests.edn b/modules/rest-util/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/rest-util/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/spec/deps.edn b/modules/spec/deps.edn new file mode 100644 index 000000000..024a763ea --- /dev/null +++ b/modules/spec/deps.edn @@ -0,0 +1 @@ +{:deps {}} \ No newline at end of file diff --git a/src/blaze/spec.clj b/modules/spec/src/blaze/spec.clj similarity index 62% rename from src/blaze/spec.clj rename to modules/spec/src/blaze/spec.clj index 106ad46c3..60843f640 100644 --- a/src/blaze/spec.clj +++ b/modules/spec/src/blaze/spec.clj @@ -7,106 +7,6 @@ (s/def :blaze/base-url string?) - -;; ---- FHIR Element Definition ----------------------------------------------- - -(s/def :ElementDefinition/path - string?) - - -(s/def :ElementDefinition/max - string?) - - -(s/def :ElementDefinition.type/code - string?) - - -(s/def :ElementDefinition.type/_code - map?) - - -(s/def :ElementDefinition/type - (s/coll-of - (s/keys :req [:ElementDefinition.type/code]))) - - -(s/def :ElementDefinition/isSummary - boolean?) - - -(s/def :ElementDefinition.un/type - (s/coll-of - (s/keys :req-un [(or :ElementDefinition.type/code - :ElementDefinition.type/_code)]))) - - -(s/def :ElementDefinition.binding/strength - string?) - - -(s/def :ElementDefinition.binding/valueSet - string?) - - -(s/def :ElementDefinition.un/binding - (s/keys :req-un [:ElementDefinition.binding/strength] - :opt-un [:ElementDefinition.binding/valueSet])) - - -(s/def :fhir/ElementDefinition - (s/keys :req [:ElementDefinition/path] - :opt [:ElementDefinition/max - :ElementDefinition/type])) - - -(s/def :fhir.un/ElementDefinition - (s/keys :req-un [:ElementDefinition/path] - :opt-un [:ElementDefinition/max - :ElementDefinition.un/type - :ElementDefinition.un/binding])) - - - -;; ---- FHIR Structure Definition --------------------------------------------- - -(s/def :StructureDefinition/name - string?) - - -(s/def :StructureDefinition/kind - #{"primitive-type" "complex-type" "resource" "logical"}) - - -(s/def :StructureDefinition.snapshot/element - (s/coll-of :fhir/ElementDefinition)) - - -(s/def :StructureDefinition.snapshot.un/element - (s/coll-of :fhir.un/ElementDefinition)) - - -(s/def :StructureDefinition/snapshot - (s/keys :req [:StructureDefinition.snapshot/element])) - - -(s/def :StructureDefinition.un/snapshot - (s/keys :req-un [:StructureDefinition.snapshot.un/element])) - - -(s/def :fhir/StructureDefinition - (s/keys :req [:StructureDefinition/name - :StructureDefinition/kind] - :opt [:StructureDefinition/snapshot])) - - -(s/def :fhir.un/StructureDefinition - (s/keys :req-un [:StructureDefinition/name - :StructureDefinition/kind] - :opt-un [:StructureDefinition.un/snapshot])) - - - ;; ---- FHIR ------------------------------------------------------------------ (s/def :fhir.coding/system @@ -160,10 +60,14 @@ :fhir.observation/valueQuantity])) -(s/def :fhir/resourceType +(s/def :fhir.resource/type string?) +(s/def :fhir/resourceType + :fhir.resource/type) + + (s/def :fhir/id string?) diff --git a/modules/structure-definition/deps.edn b/modules/structure-definition/deps.edn new file mode 100644 index 000000000..f2bc3616e --- /dev/null +++ b/modules/structure-definition/deps.edn @@ -0,0 +1,11 @@ +{:paths ["src" "resources"] + + :deps + {cheshire + {:mvn/version "5.9.0"} + + com.taoensso/timbre + {:mvn/version "4.10.0"} + + integrant + {:mvn/version "0.7.0"}}} diff --git a/resources/blaze/fhir/r4/structure-definitions/profiles-resources.json b/modules/structure-definition/resources/blaze/fhir/r4/structure_definitions/profiles-resources.json similarity index 100% rename from resources/blaze/fhir/r4/structure-definitions/profiles-resources.json rename to modules/structure-definition/resources/blaze/fhir/r4/structure_definitions/profiles-resources.json diff --git a/resources/blaze/fhir/r4/structure-definitions/profiles-types.json b/modules/structure-definition/resources/blaze/fhir/r4/structure_definitions/profiles-types.json similarity index 100% rename from resources/blaze/fhir/r4/structure-definitions/profiles-types.json rename to modules/structure-definition/resources/blaze/fhir/r4/structure_definitions/profiles-types.json diff --git a/modules/structure-definition/src/blaze/structure_definition.clj b/modules/structure-definition/src/blaze/structure_definition.clj new file mode 100644 index 000000000..760f1e3fc --- /dev/null +++ b/modules/structure-definition/src/blaze/structure_definition.clj @@ -0,0 +1,142 @@ +(ns blaze.structure-definition + (:require + [cheshire.core :as json] + [clojure.java.io :as io] + [clojure.spec.alpha :as s] + [integrant.core :as ig] + [taoensso.timbre :as log])) + + +;; ---- FHIR Element Definition ----------------------------------------------- + +(s/def :ElementDefinition/path + string?) + + +(s/def :ElementDefinition/max + string?) + + +(s/def :ElementDefinition.type/code + string?) + + +(s/def :ElementDefinition.type/_code + map?) + + +(s/def :ElementDefinition/type + (s/coll-of + (s/keys :req [:ElementDefinition.type/code]))) + + +(s/def :ElementDefinition/isSummary + boolean?) + + +(s/def :ElementDefinition.un/type + (s/coll-of + (s/keys :req-un [(or :ElementDefinition.type/code + :ElementDefinition.type/_code)]))) + + +(s/def :ElementDefinition.binding/strength + string?) + + +(s/def :ElementDefinition.binding/valueSet + string?) + + +(s/def :ElementDefinition.un/binding + (s/keys :req-un [:ElementDefinition.binding/strength] + :opt-un [:ElementDefinition.binding/valueSet])) + + +(s/def :fhir/ElementDefinition + (s/keys :req [:ElementDefinition/path] + :opt [:ElementDefinition/max + :ElementDefinition/type])) + + +(s/def :fhir.un/ElementDefinition + (s/keys :req-un [:ElementDefinition/path] + :opt-un [:ElementDefinition/max + :ElementDefinition.un/type + :ElementDefinition.un/binding])) + + + +;; ---- FHIR Structure Definition --------------------------------------------- + +(s/def :StructureDefinition/name + string?) + + +(s/def :StructureDefinition/kind + #{"primitive-type" "complex-type" "resource" "logical"}) + + +(s/def :StructureDefinition.snapshot/element + (s/coll-of :fhir/ElementDefinition)) + + +(s/def :StructureDefinition.snapshot.un/element + (s/coll-of :fhir.un/ElementDefinition)) + + +(s/def :StructureDefinition/snapshot + (s/keys :req [:StructureDefinition.snapshot/element])) + + +(s/def :StructureDefinition.un/snapshot + (s/keys :req-un [:StructureDefinition.snapshot.un/element])) + + +(s/def :fhir/StructureDefinition + (s/keys :req [:StructureDefinition/name + :StructureDefinition/kind] + :opt [:StructureDefinition/snapshot])) + + +(s/def :fhir.un/StructureDefinition + (s/keys :req-un [:StructureDefinition/name + :StructureDefinition/kind] + :opt-un [:StructureDefinition.un/snapshot])) + + + +;; ---- Read ------------------------------------------------------------------ + +(defn- read-bundle + "Reads a bundle from classpath named `resource-name`." + [resource-name] + (with-open [rdr (io/reader (io/resource resource-name))] + (json/parse-stream rdr keyword))) + + +(defn- extract [kind bundle] + (into + [] + (comp + (map :resource) + (filter #(= kind (:kind %)))) + (:entry bundle))) + + +(defn read-structure-definitions [] + (let [package "blaze/fhir/r4/structure_definitions"] + (into + (extract "complex-type" (read-bundle (str package "/profiles-types.json"))) + (into + [] + (remove #(= "Parameters" (:name %))) + (extract "resource" (read-bundle (str package "/profiles-resources.json"))))))) + + +(defmethod ig/init-key :blaze/structure-definition + [_ _] + (let [structure-definitions (read-structure-definitions)] + (log/info "Read structure definitions resulting in:" + (count structure-definitions) "structure definitions") + structure-definitions)) diff --git a/modules/terminology-service/README.md b/modules/terminology-service/README.md new file mode 100644 index 000000000..340995f33 --- /dev/null +++ b/modules/terminology-service/README.md @@ -0,0 +1,3 @@ +# Blaze Terminology Service + +This module contains the protocol `blaze.terminology-service/TermService` which is used by other Blaze modules. One of the implementations can be found in the module `extern-terminology-service`. diff --git a/modules/terminology-service/deps.edn b/modules/terminology-service/deps.edn new file mode 100644 index 000000000..d140dab1d --- /dev/null +++ b/modules/terminology-service/deps.edn @@ -0,0 +1,3 @@ +{:deps + {manifold + {:mvn/version "0.1.8"}}} diff --git a/src/blaze/terminology_service.clj b/modules/terminology-service/src/blaze/terminology_service.clj similarity index 100% rename from src/blaze/terminology_service.clj rename to modules/terminology-service/src/blaze/terminology_service.clj diff --git a/modules/thread-pool-executor-collector/deps.edn b/modules/thread-pool-executor-collector/deps.edn new file mode 100644 index 000000000..5cb740421 --- /dev/null +++ b/modules/thread-pool-executor-collector/deps.edn @@ -0,0 +1,6 @@ +{:deps + {blaze/module-base + {:local/root "../module-base"} + + prom-metrics + {:mvn/version "0.5-alpha2"}}} diff --git a/modules/thread-pool-executor-collector/src/blaze/thread_pool_executor_collector.clj b/modules/thread-pool-executor-collector/src/blaze/thread_pool_executor_collector.clj new file mode 100644 index 000000000..bce629ead --- /dev/null +++ b/modules/thread-pool-executor-collector/src/blaze/thread_pool_executor_collector.clj @@ -0,0 +1,79 @@ +(ns blaze.thread-pool-executor-collector + (:require + [blaze.module :refer [defcollector]] + [integrant.core :as ig] + [taoensso.timbre :as log]) + (:import + [io.prometheus.client + Collector Collector$Describable GaugeMetricFamily CounterMetricFamily] + [java.util.concurrent BlockingQueue ThreadPoolExecutor])) + + +(defn thread-pool-executor-collector [executors] + (proxy [Collector Collector$Describable] [] + (collect [] + [(let [mf (GaugeMetricFamily. + "thread_pool_executor_active_count" + "Returns the approximate number of threads that are actively executing tasks." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.getActiveCount ^ThreadPoolExecutor pool))) + mf) + (let [mf (CounterMetricFamily. + "thread_pool_executor_completed_tasks_total" + "Returns the approximate total number of tasks that have completed execution." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.getCompletedTaskCount ^ThreadPoolExecutor pool))) + mf) + (let [mf (GaugeMetricFamily. + "thread_pool_executor_core_pool_size" + "Returns the core number of threads." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.getCorePoolSize ^ThreadPoolExecutor pool))) + mf) + (let [mf (GaugeMetricFamily. + "thread_pool_executor_largest_pool_size" + "Returns the largest number of threads that have ever simultaneously been in the pool." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.getLargestPoolSize ^ThreadPoolExecutor pool))) + mf) + (let [mf (GaugeMetricFamily. + "thread_pool_executor_maximum_pool_size" + "Returns the maximum allowed number of threads." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.getMaximumPoolSize ^ThreadPoolExecutor pool))) + mf) + (let [mf (GaugeMetricFamily. + "thread_pool_executor_pool_size" + "Returns the current number of threads in the pool." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.getPoolSize ^ThreadPoolExecutor pool))) + mf) + (let [mf (GaugeMetricFamily. + "thread_pool_executor_queue_size" + "Returns the current number of tasks in the queue." + ["name"])] + (doseq [[name pool] executors] + (.addMetric mf [name] (.size ^BlockingQueue (.getQueue ^ThreadPoolExecutor pool)))) + mf)]) + + (describe [] + (.collect ^Collector this)))) + + +(defmethod ig/init-key :blaze/thread-pool-executor-collector + [_ {:keys [executors]}] + (log/info "Init thread pool executor collector.") + (->> executors + (map + (fn [[key executor]] + [(namespace key) executor])) + (thread-pool-executor-collector))) + + +(derive :blaze/thread-pool-executor-collector :blaze.metrics/collector) diff --git a/pom.xml b/pom.xml new file mode 100644 index 000000000..1ff34db22 --- /dev/null +++ b/pom.xml @@ -0,0 +1,24 @@ + + + 4.0.0 + life-research + blaze + 0.7.0-alpha5 + blaze + + A FHIR Store with internal, fast CQL Evaluation Engine + https://github.com/life-research/blaze + + + Eclipse Public License + http://www.eclipse.org/legal/epl-v10.html + + + + + + Alexander Kiel + + + + diff --git a/project.clj b/project.clj deleted file mode 100644 index 42746f1cc..000000000 --- a/project.clj +++ /dev/null @@ -1,82 +0,0 @@ -(defproject blaze "0.7.0-alpha3" - :description "A FHIR Store with internal, fast CQL Evaluation Engine" - :url "https://github.com/life-research/blaze" - - :license {:name "Eclipse Public License" - :url "http://www.eclipse.org/legal/epl-v10.html"} - - :min-lein-version "2.0.0" - :pedantic? :abort - - :dependencies - [[aleph "0.4.7-alpha1" - :exclusions - [io.netty/netty-codec - io.netty/netty-resolver - io.netty/netty-handler - io.netty/netty-transport - io.netty/netty-transport-native-epoll]] - [buddy/buddy-auth "2.2.0" - :exclusions [org.clojure/clojurescript]] - [camel-snake-kebab "0.4.0"] - [cheshire "5.9.0"] - [com.cognitect/anomalies "0.1.12"] - [com.datomic/datomic-free "0.9.5697" - :exclusions [commons-codec io.netty/netty-all]] - [com.h2database/h2 "1.4.199"] - [com.taoensso/timbre "4.10.0"] - [info.cqframework/cql-to-elm "1.4.6" - :exclusions - [com.google.code.javaparser/javaparser - org.eclipse.persistence/eclipselink - info.cqframework/qdm - junit - xpp3 - xpp3/xpp3_xpath]] - [integrant "0.7.0"] - [io.netty/netty-codec-http "4.1.39.Final"] - [io.netty/netty-handler-proxy "4.1.39.Final"] - [io.netty/netty-resolver-dns "4.1.39.Final"] - [io.netty/netty-transport-native-epoll "4.1.39.Final" - :classifier "linux-x86_64"] - [io.prometheus/simpleclient_hotspot "0.6.0"] - [javax.measure/unit-api "1.0"] - [metosin/reitit-ring "0.3.9" - :exclusions [commons-codec]] - [org.apache.httpcomponents/httpcore "4.4.12"] - [org.clojars.akiel/datomic-spec "0.5.2"] - [org.clojars.akiel/datomic-tools "0.4"] - [org.clojars.akiel/env-tools "0.3.0"] - [org.clojars.akiel/spec-coerce "0.4.0"] - [org.clojure/clojure "1.10.1"] - [org.clojure/core.cache "0.8.1"] - [org.clojure/tools.reader "1.3.2"] - [org.eclipse.persistence/org.eclipse.persistence.moxy "2.7.4" - :scope "runtime"] - [phrase "0.3-alpha3"] - [prom-metrics "0.5-alpha2"] - [ring/ring-core "1.7.1" - :exclusions [clj-time commons-codec commons-fileupload - commons-io crypto-equality crypto-random]] - [systems.uom/systems-ucum "0.9"] - [systems.uom/systems-quantity "1.0"] - - ;; Needed to work with Java 11. Doesn't hurt Java 8. - [javax.xml.bind/jaxb-api "2.4.0-b180830.0359"]] - - :profiles - {:dev - {:source-paths ["dev"] - :dependencies - [[criterium "0.4.5"] - [org.clojars.akiel/iota "0.1"] - [org.clojure/data.xml "0.0.8"] - [org.clojure/test.check "0.10.0"] - [org.clojure/tools.namespace "0.3.1"]]} - - :uberjar - {:aot [blaze.core]}} - - :main ^:skip-aot blaze.core - - :hiera {:ignore-ns #{user}}) diff --git a/resources/blaze.edn b/resources/blaze.edn new file mode 100644 index 000000000..237e00f43 --- /dev/null +++ b/resources/blaze.edn @@ -0,0 +1,107 @@ +{:base-config + {:blaze.terminology-service/extern + {:uri #blaze/cfg ["TERM_SERVICE_URI" string? "http://tx.fhir.org/r4"] + :proxy-host #blaze/cfg ["PROXY_HOST" string?] + :proxy-port #blaze/cfg ["PROXY_PORT" pos-int?] + :proxy-user #blaze/cfg ["PROXY_USER" string?] + :proxy-password #blaze/cfg ["PROXY_PASSWORD" string?] + :connection-timeout #blaze/cfg ["CONNECTION_TIMEOUT" pos-int?] + :request-timeout #blaze/cfg ["REQUEST_TIMEOUT" pos-int?]} + + :blaze.terminology-service.extern/errors-total {} + :blaze.terminology-service.extern/request-duration-seconds {} + + :blaze.interaction.history/system + {:database/conn #blaze/ref :blaze.datomic/conn} + + :blaze.interaction.history/type + {:database/conn #blaze/ref :blaze.datomic/conn} + + :blaze.interaction.history/instance + {:database/conn #blaze/ref :blaze.datomic/conn} + + :blaze.interaction/create + {:database/transaction-executor #blaze/ref :blaze.datomic.transaction/executor + :database/conn #blaze/ref :blaze.datomic/conn + :term-service #blaze/ref :blaze/terminology-service} + + :blaze.interaction/delete + {:database/transaction-executor #blaze/ref :blaze.datomic.transaction/executor + :database/conn #blaze/ref :blaze.datomic/conn} + + :blaze.interaction/read + {:database/conn #blaze/ref :blaze.datomic/conn} + + :blaze.interaction/search-type + {:database/conn #blaze/ref :blaze.datomic/conn} + + :blaze.interaction.transaction/executor {} + + :blaze.interaction.transaction/handler + {:database/transaction-executor #blaze/ref :blaze.datomic.transaction/executor + :database/conn #blaze/ref :blaze.datomic/conn + :term-service #blaze/ref :blaze/terminology-service + :executor #blaze/ref :blaze.interaction.transaction/executor} + + :blaze.interaction/update + {:database/transaction-executor #blaze/ref :blaze.datomic.transaction/executor + :database/conn #blaze/ref :blaze.datomic/conn + :term-service #blaze/ref :blaze/terminology-service} + + :blaze.fhir.operation.evaluate-measure/executor {} + + :blaze.fhir.operation.evaluate-measure/handler + {:clock #blaze/ref :blaze/clock + :database/transaction-executor #blaze/ref :blaze.datomic.transaction/executor + :database/conn #blaze/ref :blaze.datomic/conn + :term-service #blaze/ref :blaze/terminology-service + :executor #blaze/ref :blaze.fhir.operation.evaluate-measure/executor} + + :blaze.fhir.operation.evaluate-measure/compile-duration-seconds {} + :blaze.fhir.operation.evaluate-measure/evaluate-duration-seconds {} + + :blaze/rest-api + {:transaction-handler #blaze/ref :blaze.interaction.transaction/handler + :history-system-handler #blaze/ref :blaze.interaction.history/system + :resource-patterns + [#:blaze.rest-api.resource-pattern + {:type "Patient" + :interactions + {:read + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction/read} + :vread + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction/read} + :update + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction/update} + :delete + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction/delete} + :history-instance + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction.history/instance} + :history-type + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction.history/type} + :create + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction/create} + :search-type + #:blaze.rest-api.interaction + {:handler #blaze/ref :blaze.interaction/search-type}}}] + :operations + [#:blaze.rest-api.operation + {:code "evaluate-measure" + :def-uri "http://hl7.org/fhir/OperationDefinition/Measure-evaluate-measure" + :resource-types ["Measure"] + :type-handler #blaze/ref :blaze.fhir.operation.evaluate-measure/handler + :instance-handler #blaze/ref :blaze.fhir.operation.evaluate-measure/handler}]}} + + :features + [{:name "OpenID Authentication" + :toggle "OPENID_PROVIDER_URL" + :config + {[:blaze.auth/backend :blaze.openid-auth/backend] + {:openid-provider/url #blaze/cfg ["OPENID_PROVIDER_URL" string?]}}}]} diff --git a/src/blaze/core.clj b/src/blaze/core.clj index 7f3d1c952..f7eb69ba9 100644 --- a/src/blaze/core.clj +++ b/src/blaze/core.clj @@ -1,13 +1,9 @@ (ns blaze.core (:require - [clojure.spec.alpha :as s] [clojure.string :as str] - [env-tools.alpha :as env-tools] [blaze.system :as system] [phrase.alpha :refer [defphraser phrase-first]] - [spec-coerce.alpha :refer [coerce]] - [taoensso.timbre :as log]) - (:gen-class)) + [taoensso.timbre :as log])) (defn- max-memory [] @@ -54,16 +50,11 @@ (defn -main [& _] - (let [config (env-tools/build-config :system/config) - coerced-config (coerce :system/config config)] - (if (s/valid? :system/config coerced-config) - (do - (add-shutdown-hook shutdown-system!) - (init-system! coerced-config) - (log/info "JVM version:" (System/getProperty "java.version")) - (log/info "Maximum available memory:" (max-memory) "MiB") - (log/info "Number of available processors:" (available-processors))) - (log/error (phrase-first nil :system/config config))))) + (add-shutdown-hook shutdown-system!) + (init-system! (System/getenv)) + (log/info "JVM version:" (System/getProperty "java.version")) + (log/info "Maximum available memory:" (max-memory) "MiB") + (log/info "Number of available processors:" (available-processors))) (defphraser #(contains? % key) diff --git a/src/blaze/fhir/operation/evaluate_measure/handler.clj b/src/blaze/fhir/operation/evaluate_measure/handler.clj deleted file mode 100644 index da1cacc94..000000000 --- a/src/blaze/fhir/operation/evaluate_measure/handler.clj +++ /dev/null @@ -1,32 +0,0 @@ -(ns blaze.fhir.operation.evaluate-measure.handler - "Main entry point into the Evaluate-Measure-handler." - (:require - [blaze.executors :as ex] - [blaze.fhir.operation.evaluate-measure.handler.impl :as impl] - [blaze.fhir.operation.evaluate-measure.middleware.params :refer [wrap-coerce-params]] - [blaze.middleware.fhir.metrics :refer [wrap-observe-request-duration]] - [blaze.terminology-service :refer [term-service?]] - [clojure.spec.alpha :as s] - [datomic-spec.core :as ds] - [ring.middleware.params :refer [wrap-params]]) - (:import - [java.time Clock])) - - -(s/def :handler.fhir.operation/evaluate-measure fn?) - - -(s/fdef handler - :args (s/cat :clock #(instance? Clock %) - :conn ::ds/conn - :term-service term-service? - :executor ex/executor?) - :ret :handler.fhir.operation/evaluate-measure) - -(defn handler - "" - [clock conn term-service executor] - (-> (impl/handler clock conn term-service executor) - (wrap-coerce-params) - (wrap-params) - (wrap-observe-request-duration "operation-evaluate-measure"))) diff --git a/src/blaze/handler/app.clj b/src/blaze/handler/app.clj index 2f52ec3f5..407e4e517 100644 --- a/src/blaze/handler/app.clj +++ b/src/blaze/handler/app.clj @@ -1,54 +1,36 @@ (ns blaze.handler.app (:require - [blaze.middleware.json :refer [wrap-json]] - [blaze.middleware.fhir.type :refer [wrap-type]] [clojure.spec.alpha :as s] - [reitit.core :as reitit] - [reitit.ring :as reitit-ring] - [ring.util.response :as ring])) + [integrant.core :as ig] + [reitit.ring] + [ring.util.response :as ring] + [taoensso.timbre :as log])) -(defn- wrap-remove-context-path [handler] - (fn [{{{:keys [more] :or {more ""}} :path-params} ::reitit/match :as request}] - (handler (-> request (assoc :uri more) (dissoc ::reitit/match :path-params))))) - - -(defn router [handlers middleware] - (reitit-ring/router +(defn router [health-handler] + (reitit.ring/router [["/health" - {:head (:handler/health handlers) - :get (:handler/health handlers)}] - ["/cql/evaluate" - {:options (:handler/cql-evaluation handlers) - :post (:handler/cql-evaluation handlers)}] - ["/fhir" - {:middleware [wrap-json (:middleware/authentication middleware) wrap-remove-context-path] - :handler (:handler.fhir/core handlers)}] - ["/fhir/{*more}" - {:middleware [wrap-json (:middleware/authentication middleware) wrap-remove-context-path] - :handler (:handler.fhir/core handlers)}]] + {:head health-handler + :get health-handler}]] {:syntax :bracket - ::reitit-ring/default-options-handler + :reitit.ring/default-options-handler (fn [_] (-> (ring/response nil) (ring/status 405)))})) -(s/def ::handlers - (s/keys :req [:handler/cql-evaluation - :handler/health - :handler.fhir/core])) - - -(s/def ::middleware - (s/keys :req [:middleware/authentication])) - - (s/fdef handler - :args (s/cat :handlers ::handlers - :middleware ::middleware)) + :args (s/cat :rest-api fn? :health-handler fn?)) (defn handler "Whole app Ring handler." - [handlers middleware] - (reitit-ring/ring-handler (router handlers middleware))) + [rest-api health-handler] + (reitit.ring/ring-handler + (router health-handler) + rest-api)) + + +(defmethod ig/init-key :blaze.handler/app + [_ {:keys [rest-api health-handler]}] + (log/info "Init app handler") + (handler rest-api health-handler)) diff --git a/src/blaze/handler/cql_evaluation.clj b/src/blaze/handler/cql_evaluation.clj deleted file mode 100644 index e4c88afaa..000000000 --- a/src/blaze/handler/cql_evaluation.clj +++ /dev/null @@ -1,123 +0,0 @@ -(ns blaze.handler.cql-evaluation - "A CQL evaluation handler modeled after the evaluate endpoint of - - https://github.com/DBCG/cql_execution_service" - (:require - [cheshire.core :as json] - [clojure.spec.alpha :as s] - [clojure.string :as str] - [cognitect.anomalies :as anom] - [datomic.api :as d] - [datomic-spec.core :as ds] - [blaze.cql-translator :as cql] - [blaze.datomic.pull :as pull] - [blaze.elm.compiler :as compiler] - [blaze.elm.evaluator :as evaluator] - [blaze.elm.util :as elm-util] - [blaze.middleware.cors :refer [wrap-cors]] - [blaze.middleware.json :refer [wrap-json]] - [manifold.deferred :as md] - [ring.util.response :as ring] - [taoensso.timbre :as log]) - (:import - [java.time OffsetDateTime])) - - -(defn- location [locator] - (if-let [l (first (str/split locator #"-"))] - (str "[" l "]") - "[?:?]")) - - -(defn- primitive? [type-name] - (or (Character/isLowerCase ^char (first type-name)) (= "Quantity" type-name))) - - -(defn- bundle [{:keys [result type locator] :as full-result}] - (case (:type type) - "ListTypeSpecifier" - (let [[_ type-name] (elm-util/parse-qualified-name (:name (:elementType type)))] - (if (primitive? type-name) - {:result (pr-str (into [] (comp (take 2) (map str)) result)) - :location (location locator) - :resultType type-name} - {:result - (json/generate-string - (into - [] - (comp - (take 2) - (map #(pull/pull-summary type-name %)) - (map #(assoc % :resourceType type-name))) - result) - {:key-fn name - :pretty true}) - :location (location locator) - :resultType "Bundle"})) - "NamedTypeSpecifier" - {:result result - :location (location locator) - :resultType (second (elm-util/parse-qualified-name (:name type)))} - (throw (ex-info (str "Unexpected type `" (:type type) "`.") full-result)))) - - -(defn- to-error [deferred] - (md/chain' - deferred - (fn [result] - (if (::anom/category result) - (md/error-deferred result) - (md/success-deferred result))))) - - -(defn- handler-intern [conn cache] - (fn [{:keys [body]}] - (if-let [code (get body "code")] - (let [db (d/db conn)] - (-> (md/let-flow' - [elm (to-error (md/future (cql/translate code :locators? true))) - compiled-library (to-error (md/future (compiler/compile-library db elm {}))) - results (evaluator/evaluate db (OffsetDateTime/now) compiled-library)] - (ring/response - (mapcat - (fn [[name result]] - (if (instance? Exception result) - [{:name name - :error (ex-message result) - :location "[?:?]"}] - (if-let [bundle (bundle result)] - [(assoc bundle :name name)] - []))) - results))) - (md/catch' - (fn [e] - (log/error e) - (ring/response - [{:translation-error - (cond - (::anom/category e) - (or (::anom/message e) - (name (::anom/category e))) - - (instance? Exception e) - (ex-message e) - - :else - "Unknown error")}]))))) - (ring/response [{:translation-error "Missing CQL code"}])))) - - -(s/def :handler/cql-evaluation fn?) - - -(s/fdef handler - :args (s/cat :conn ::ds/conn :cache some?) - :ret :handler/cql-evaluation) - -(defn handler - "Takes a Datomic `conn` and aa `cache` atom and returns a CQL evaluation - Ring handler." - [conn cache] - (-> (handler-intern conn cache) - (wrap-json) - (wrap-cors))) diff --git a/src/blaze/handler/fhir/core.clj b/src/blaze/handler/fhir/core.clj deleted file mode 100644 index 0cc050548..000000000 --- a/src/blaze/handler/fhir/core.clj +++ /dev/null @@ -1,112 +0,0 @@ -(ns blaze.handler.fhir.core - (:require - [blaze.middleware.fhir.type :refer [wrap-type]] - [clojure.spec.alpha :as s] - [datomic-spec.core :as ds] - [reitit.ring :as reitit-ring] - [ring.util.response :as ring])) - - -(defn router [base-url conn handlers middleware] - (reitit-ring/router - ["" {:blaze/base-url base-url} - ["" - {:middleware [(:middleware/guard middleware)] - :post (:handler.fhir/transaction handlers)}] - ["metadata" - {:get (:handler.fhir/capabilities handlers)}] - ["_history" - {:middleware [(:middleware/guard middleware)] - :get (:handler.fhir/history-system handlers)}] - ["{type}" {:middleware [(:middleware/guard middleware) [wrap-type conn]]} - ["" - {:name :fhir/type - :get (:handler.fhir/search handlers) - :post (:handler.fhir/create handlers)}] - ["/_history" {:get (:handler.fhir/history-type handlers)}] - ["/_search" {:post (:handler.fhir/search handlers)}] - ["/{id}" - ["" - {:name :fhir/instance - :get (:handler.fhir/read handlers) - :put (:handler.fhir/update handlers) - :delete (:handler.fhir/delete handlers)}] - ["/_history" - ["" - {:get (:handler.fhir/history-instance handlers)}] - ["/{vid}" - {:name :fhir/versioned-instance - :get (:handler.fhir/read handlers)}]]]] - ["Measure/{id}/$evaluate-measure" - {:middleware [(:middleware/guard middleware)] - :get - (:handler.fhir.operation/evaluate-measure handlers) - :post - (:handler.fhir.operation/evaluate-measure handlers)}]] - {:syntax :bracket - :conflicts nil - ::reitit-ring/default-options-handler - (fn [_] - (-> (ring/response nil) - (ring/status 405)))})) - - -(def ^:private default-handler - (reitit-ring/create-default-handler - {:not-found - (fn [_] - (ring/not-found - {:resourceType "OperationOutcome" - :issue - [{:severity "information" - :code "not-found"}]})) - :method-not-allowed - (fn [_] - (-> (ring/response - {:resourceType "OperationOutcome" - :issue - [{:severity "information" - :code "not-found"}]}) - (ring/status 405))) - :not-acceptable - (fn [_] - (-> (ring/response - {:resourceType "OperationOutcome" - :issue - [{:severity "error" - :code "structure"}]}) - (ring/status 406)))})) - - -(s/def ::handlers - (s/keys :req [:handler.fhir/capabilities - :handler.fhir/create - :handler.fhir/delete - :handler.fhir/history-instance - :handler.fhir/history-type - :handler.fhir/history-system - :handler.fhir/read - :handler.fhir/search - :handler.fhir/transaction - :handler.fhir/update - :handler.fhir.operation/evaluate-measure])) - - -(s/def ::middleware - (s/keys :req [:middleware/guard])) - - -(s/def :handler.fhir/core fn?) - - -(s/fdef handler - :args (s/cat :base-url string? :conn ::ds/conn :handlers ::handlers :middleware ::middleware) - :ret :handler.fhir/core) - - -(defn handler - "Whole app Ring handler." - [base-url conn handlers middleware] - (reitit-ring/ring-handler - (router base-url conn handlers middleware) - default-handler)) diff --git a/src/blaze/handler/health.clj b/src/blaze/handler/health.clj index b14c1dd62..4896b8acf 100644 --- a/src/blaze/handler/health.clj +++ b/src/blaze/handler/health.clj @@ -1,17 +1,22 @@ (ns blaze.handler.health (:require [clojure.spec.alpha :as s] - [ring.util.response :as ring])) - - -(s/def :handler/health fn?) + [integrant.core :as ig] + [ring.util.response :as ring] + [taoensso.timbre :as log])) (s/fdef handler :args (s/cat) - :ret :handler/health) + :ret fn?) (defn handler [] (fn [_] (-> (ring/response "OK") (ring/content-type "text/plain")))) + + +(defmethod ig/init-key :blaze.handler/health + [_ _] + (log/info "Init health handler") + (handler)) diff --git a/src/blaze/handler/metrics.clj b/src/blaze/handler/metrics.clj index 14049bbca..f03bb9db5 100644 --- a/src/blaze/handler/metrics.clj +++ b/src/blaze/handler/metrics.clj @@ -1,6 +1,12 @@ (ns blaze.handler.metrics (:require - [prometheus.alpha :as prom])) + [clojure.spec.alpha :as s] + [integrant.core :as ig] + [prometheus.alpha :as prom] + [taoensso.timbre :as log]) + (:import + [io.prometheus.client CollectorRegistry])) + (defn metrics-handler "Returns a handler function that dumps the metrics associated with `registry` @@ -8,3 +14,17 @@ [registry] (fn [_] (prom/dump-metrics registry))) + + +(s/def ::registry + #(instance? CollectorRegistry %)) + + +(defmethod ig/pre-init-spec :blaze.handler/metrics [_] + (s/keys :req-un [::registry])) + + +(defmethod ig/init-key :blaze.handler/metrics + [_ {:keys [registry]}] + (log/info "Init metrics handler") + (metrics-handler registry)) diff --git a/src/blaze/metrics.clj b/src/blaze/metrics.clj index 286afb5e0..1d4d79111 100644 --- a/src/blaze/metrics.clj +++ b/src/blaze/metrics.clj @@ -1,115 +1,41 @@ (ns blaze.metrics + (:require + [clojure.spec.alpha :as s] + [integrant.core :as ig] + [taoensso.timbre :as log]) (:import - [io.prometheus.client Collector GaugeMetricFamily CounterMetricFamily] + [io.prometheus.client + Collector GaugeMetricFamily CounterMetricFamily + Collector$Describable Collector$MetricFamilySamples CollectorRegistry] + [io.prometheus.client.hotspot + StandardExports MemoryPoolsExports + GarbageCollectorExports ThreadExports + ClassLoadingExports VersionInfoExports] [java.util.concurrent BlockingQueue ForkJoinPool ThreadPoolExecutor])) -(set! *warn-on-reflection* true) +(s/def ::collectors + (s/coll-of #(instance? Collector %))) -(defn fork-join-pool-collector [pools] - (proxy [Collector] [] - (collect [] - [(let [mf (GaugeMetricFamily. - "fork_join_pool_queued_task_count" - "Returns an estimate of the total number of tasks currently held in queues by worker threads (but not including tasks submitted to the pool that have not begun executing)." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getQueuedTaskCount ^ForkJoinPool pool))) - mf) - (let [mf (GaugeMetricFamily. - "fork_join_pool_parallelism" - "Returns the targeted parallelism level of this pool." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getParallelism ^ForkJoinPool pool))) - mf) - (let [mf (GaugeMetricFamily. - "fork_join_pool_active_thread_count" - "Returns an estimate of the number of threads that are currently stealing or executing tasks. This method may overestimate the number of active threads." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getActiveThreadCount ^ForkJoinPool pool))) - mf) - (let [mf (GaugeMetricFamily. - "fork_join_pool_queued_submission_count" - "Returns an estimate of the number of tasks submitted to this pool that have not yet begun executing." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getQueuedSubmissionCount ^ForkJoinPool pool))) - mf) - (let [mf (GaugeMetricFamily. - "fork_join_pool_running_thread_count" - "Returns an estimate of the number of worker threads that are not blocked waiting to join tasks or for other managed synchronization. This method may overestimate the number of running threads." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getRunningThreadCount ^ForkJoinPool pool))) - mf) - (let [mf (CounterMetricFamily. - "fork_join_pool_steal_count_total" - "Returns an estimate of the total number of tasks stolen from one thread's work queue by another. The reported value underestimates the actual total number of steals when the pool is not quiescent." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getStealCount ^ForkJoinPool pool))) - mf) - (let [mf (GaugeMetricFamily. - "fork_join_pool_pool_size" - "Returns the number of worker threads that have started but not yet terminated." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getPoolSize ^ForkJoinPool pool))) - mf)]))) +(defmethod ig/pre-init-spec :blaze.metrics/registry [_] + (s/keys :req-un [::collectors])) -(defn thread-pool-executor-collector [pools] - (proxy [Collector] [] - (collect [] - [(let [mf (GaugeMetricFamily. - "thread_pool_executor_active_count" - "Returns the approximate number of threads that are actively executing tasks." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getActiveCount ^ThreadPoolExecutor pool))) - mf) - (let [mf (CounterMetricFamily. - "thread_pool_executor_completed_tasks_total" - "Returns the approximate total number of tasks that have completed execution." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getCompletedTaskCount ^ThreadPoolExecutor pool))) - mf) - (let [mf (GaugeMetricFamily. - "thread_pool_executor_core_pool_size" - "Returns the core number of threads." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getCorePoolSize ^ThreadPoolExecutor pool))) - mf) - (let [mf (GaugeMetricFamily. - "thread_pool_executor_largest_pool_size" - "Returns the largest number of threads that have ever simultaneously been in the pool." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getLargestPoolSize ^ThreadPoolExecutor pool))) - mf) - (let [mf (GaugeMetricFamily. - "thread_pool_executor_maximum_pool_size" - "Returns the maximum allowed number of threads." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getMaximumPoolSize ^ThreadPoolExecutor pool))) - mf) - (let [mf (GaugeMetricFamily. - "thread_pool_executor_pool_size" - "Returns the current number of threads in the pool." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.getPoolSize ^ThreadPoolExecutor pool))) - mf) - (let [mf (GaugeMetricFamily. - "thread_pool_executor_queue_size" - "Returns the current number of tasks in the queue." - ["name"])] - (doseq [[name pool] pools] - (.addMetric mf [name] (.size ^BlockingQueue (.getQueue ^ThreadPoolExecutor pool)))) - mf)]))) +(defmethod ig/init-key :blaze.metrics/registry + [_ {:keys [collectors]}] + (log/info "Init metrics registry") + (let [registry + (doto (CollectorRegistry. true) + (.register (StandardExports.)) + (.register (MemoryPoolsExports.)) + (.register (GarbageCollectorExports.)) + (.register (ThreadExports.)) + (.register (ClassLoadingExports.)) + (.register (VersionInfoExports.)))] + (doseq [collector collectors] + (doseq [^Collector$MetricFamilySamples samples + (.describe ^Collector$Describable collector)] + (log/debug "Register collector" (.name samples))) + (.register registry collector)) + registry)) diff --git a/src/blaze/middleware/authentication.clj b/src/blaze/middleware/authentication.clj deleted file mode 100644 index 34a288f5d..000000000 --- a/src/blaze/middleware/authentication.clj +++ /dev/null @@ -1,58 +0,0 @@ -(ns blaze.middleware.authentication - "Verifies a signed JWT using OpenID Connect to provide - the public key used to sign the token." - (:require - [buddy.auth.backends :as backends] - [buddy.auth.middleware :as middleware] - [buddy.core.keys :as keys] - [cheshire.core :as json] - [clojure.spec.alpha :as s]) - (:import - (java.security PublicKey))) - - -(s/fdef public-key - :args (s/cat :jwks-json string?) - :ret (s/nilable #(instance? PublicKey %))) - - -(defn public-key [jwks-json] - "Take a the first jwk from jwks-json string and - convert it into a PublicKey." - (some-> jwks-json - (json/parse-string keyword) - :keys - first - keys/jwk->public-key)) - - -(s/fdef jwks-json - :args (s/cat :url string?) - :ret map?) - - -(defn jwks-json [url] - (let [well-known "/.well-known/openid-configuration" - jwks-json (some-> url - (str well-known) - slurp - json/parse-string - (get "jwks_uri") - slurp)] - (if (some? jwks-json) - jwks-json - (throw (ex-info "No jwk found" - {:cause (str "No jwk found at " url well-known)}))))) - - -(s/fdef wrap-authentication - :args (s/cat :public-key #(instance? PublicKey %))) - - -(defn wrap-authentication [public-key] - (fn [handler] - (middleware/wrap-authentication - handler - (backends/jws {:token-name "Bearer" - :secret public-key - :options {:alg :rs256}})))) diff --git a/src/blaze/middleware/cors.clj b/src/blaze/middleware/cors.clj deleted file mode 100644 index 1a6c272d1..000000000 --- a/src/blaze/middleware/cors.clj +++ /dev/null @@ -1,20 +0,0 @@ -(ns blaze.middleware.cors - (:require - [manifold.deferred :as md])) - - -(defn assoc-header [response] - (assoc-in response [:headers "Access-Control-Allow-Origin"] "*")) - - -(defn wrap-cors - "Adds an Access-Control-Allow-Origin header with the value * to responses." - [handler] - (fn [request] - (if (= :options (:request-method request)) - {:status 204 - :headers {"Access-Control-Allow-Origin" "*" - "Access-Control-Allow-Headers" "Accept, Content-Type" - "Access-Control-Max-Age" "3600"}} - (md/let-flow' [response (handler request)] - (assoc-header response))))) diff --git a/src/blaze/middleware/guard.clj b/src/blaze/middleware/guard.clj deleted file mode 100644 index 945e96955..000000000 --- a/src/blaze/middleware/guard.clj +++ /dev/null @@ -1,14 +0,0 @@ -(ns blaze.middleware.guard - (:require - [buddy.auth :refer [authenticated?]] - [ring.util.response :as ring])) - - -(defn wrap-guard - "If the request is unauthenticated return a 401 response." - [handler] - (fn [request] - (if (authenticated? request) - (handler request) - (-> (ring/response {:message "Unauthenticated"}) - (ring/status 401))))) diff --git a/src/blaze/structure_definition.clj b/src/blaze/structure_definition.clj deleted file mode 100644 index 54fa8e6a9..000000000 --- a/src/blaze/structure_definition.clj +++ /dev/null @@ -1,30 +0,0 @@ -(ns blaze.structure-definition - (:require - [cheshire.core :as json] - [clojure.java.io :as io])) - - -(defn- read-bundle - "Reads a bundle from classpath named `resource-name`." - [resource-name] - (with-open [rdr (io/reader (io/resource resource-name))] - (json/parse-stream rdr keyword))) - - -(defn- extract [kind bundle] - (into - [] - (comp - (map :resource) - (filter #(= kind (:kind %)))) - (:entry bundle))) - - -(defn read-structure-definitions [] - (let [package "blaze/fhir/r4/structure-definitions"] - (into - (extract "complex-type" (read-bundle (str package "/profiles-types.json"))) - (into - [] - (remove #(= "Parameters" (:name %))) - (extract "resource" (read-bundle (str package "/profiles-resources.json"))))))) diff --git a/src/blaze/system.clj b/src/blaze/system.clj index 99ea66e24..769b421b6 100644 --- a/src/blaze/system.clj +++ b/src/blaze/system.clj @@ -5,232 +5,158 @@ The specs at the beginning of the namespace describe the config which has to be given to `init!``. The server port has a default of `8080`." (:require - [clojure.core.cache :as cache] [clojure.spec.alpha :as s] [clojure.string :as str] - [blaze.bundle :as bundle] - [blaze.datomic.transaction :as tx] - [blaze.datomic.schema :as schema] + [clojure.walk :refer [postwalk]] [blaze.executors :as ex] - [blaze.handler.app :as app-handler] - [blaze.handler.cql-evaluation :as cql-evaluation-handler] - [blaze.handler.fhir.capabilities :as fhir-capabilities-handler] - [blaze.handler.fhir.core :as fhir-core-handler] - [blaze.handler.fhir.create :as fhir-create-handler] - [blaze.handler.fhir.delete :as fhir-delete-handler] - [blaze.handler.fhir.history-instance :as fhir-history-instance-handler] - [blaze.handler.fhir.history-type :as fhir-history-type-handler] - [blaze.handler.fhir.history-system :as fhir-history-system-handler] - [blaze.handler.fhir.read :as fhir-read-handler] - [blaze.handler.fhir.search :as fhir-search-handler] - [blaze.handler.fhir.transaction :as fhir-transaction-handler] - [blaze.handler.fhir.update :as fhir-update-handler] - [blaze.fhir.operation.evaluate-measure.handler - :as fhir-operation-evaluate-measure-handler] - [blaze.fhir.operation.evaluate-measure.measure :as evaluate-measure] - [blaze.handler.health :as health-handler] - [blaze.handler.metrics :as metrics-handler] - [blaze.metrics :as metrics] - [blaze.middleware.fhir.metrics :as fhir-metrics] - [blaze.middleware.json :as json] - [blaze.middleware.authentication :as authentication] - [blaze.middleware.guard :as guard] + [blaze.module :refer [defcollector]] [blaze.server :as server] - [blaze.structure-definition :refer [read-structure-definitions]] - [blaze.terminology-service.extern :as ts] - [datomic.api :as d] - [datomic-tools.schema :as dts] + [blaze.thread-pool-executor-collector + :refer [thread-pool-executor-collector]] + [clojure.tools.reader.edn :as edn] [integrant.core :as ig] - [taoensso.timbre :as log]) - (:import [io.prometheus.client CollectorRegistry] - [io.prometheus.client.hotspot StandardExports MemoryPoolsExports - GarbageCollectorExports ThreadExports - ClassLoadingExports VersionInfoExports] - [java.time Clock])) - - - -;; ---- Specs ------------------------------------------------------------- - -(s/def :log/level - #{"trace" "debug" "info" "warn" "error" "fatal" "report" - "TRACE" "DEBUG" "INFO" "WARN" "ERROR" "FATAL" "REPORT"}) -(s/def ::milli-second pos-int?) -(s/def :config/logging (s/keys :opt [:log/level])) -(s/def :database/uri string?) -(s/def :config/database-conn (s/keys :opt [:database/uri])) -(s/def :openid-provider/url string?) -(s/def :config/authentication (s/keys :opt [:openid-provider/url])) -(s/def :term-service/uri string?) -(s/def :term-service/proxy-host string?) -(s/def :term-service/proxy-port pos-int?) -(s/def :term-service/proxy-user string?) -(s/def :term-service/proxy-password string?) -(s/def :term-service/connection-timeout ::milli-second) -(s/def :term-service/request-timeout ::milli-second) -(s/def :config/term-service - (s/keys :opt-un [:term-service/uri - :term-service/proxy-host - :term-service/proxy-port - :term-service/proxy-user - :term-service/proxy-password - :term-service/connection-timeout - :term-service/request-timeout])) -(s/def :cache/threshold pos-int?) -(s/def :config/base-url string?) -(s/def :config/cache (s/keys :opt [:cache/threshold])) -(s/def :config/fhir-capabilities-handler (s/keys :opt-un [:config/base-url])) -(s/def :config/fhir-core-handler (s/keys :opt-un [:config/base-url])) -(s/def :config/server (s/keys :opt-un [::server/port])) -(s/def :config/metrics-server (s/keys :opt-un [::server/port])) - -(s/def :system/config - (s/keys - :opt-un - [:config/logging - :config/database-conn - :config/authentication - :config/term-service - :config/cache - :config/fhir-capabilities-handler - :config/fhir-core-handler - :config/server - :config/metrics-server])) + [spec-coerce.alpha :refer [coerce]] + [taoensso.timbre :as log] + [clojure.java.io :as io]) + (:import + [java.io PushbackReader] + [java.time Clock])) ;; ---- Functions ------------------------------------------------------------- -(def ^:private version "0.7.0-alpha3") +(defrecord Cfg [env-var spec default]) -(def ^:private base-url "http://localhost:8080") -(def ^:private default-config - {:structure-definitions {} +(defn- cfg [[env-var spec-form default]] + (let [spec + (if (symbol? spec-form) + (var-get (resolve spec-form)) + spec-form)] + (->Cfg env-var spec default))) - :database-conn - {:structure-definitions (ig/ref :structure-definitions) - :database/uri "datomic:mem://dev"} - :authentication {} +(defn- read-blaze-edn [] + (log/info "Try to read blaze.edn ...") + (try + (with-open [rdr (PushbackReader. (io/reader (io/resource "blaze.edn")))] + (edn/read + {:readers {'blaze/ref ig/ref 'blaze/cfg cfg}} + rdr)) + (catch Exception e + (log/warn "Problem while reading blaze.edn. Skipping it." e)))) - :guard - {:authentication (ig/ref :authentication)} - :term-service - {:uri "http://tx.fhir.org/r4"} +(defn resolve-config [config env] + (postwalk + (fn [x] + (if (instance? Cfg x) + (when-let [value (get env (:env-var x) (:default x))] + (coerce (:spec x) value)) + x)) + config)) - :cache {} - :transaction-interaction-executor {} +(defn- load-namespaces [config] + (log/info "Loading namespaces ...") + (let [loaded-ns (ig/load-namespaces config)] + (log/info "Loaded the following namespaces:" (str/join ", " loaded-ns)))) - :evaluate-measure-operation-executor {} - :health-handler {} +(def ^:private root-config + {:blaze/version "0.7.0-alpha5" - :cql-evaluation-handler - {:database/conn (ig/ref :database-conn) - :cache (ig/ref :cache)} + :blaze/clock {} - :fhir-capabilities-handler - {:base-url base-url - :version version - :structure-definitions (ig/ref :structure-definitions)} + :blaze/structure-definition {} - :fhir-create-handler - {:database/conn (ig/ref :database-conn) - :term-service (ig/ref :term-service)} + :blaze.datomic.transaction/executor {} - :fhir-delete-handler - {:database/conn (ig/ref :database-conn)} + :blaze.datomic/conn + {:structure-definitions (ig/ref :blaze/structure-definition) + :database/uri (->Cfg "DATABASE_URI" string? "datomic:mem://dev")} - :fhir-history-instance-handler - {:database/conn (ig/ref :database-conn)} + :blaze.datomic/resource-upsert-duration-seconds {} + :blaze.datomic/execution-duration-seconds {} + :blaze.datomic/resources-total {} + :blaze.datomic/datoms-total {} - :fhir-history-type-handler - {:database/conn (ig/ref :database-conn)} + :blaze.handler/health {} - :fhir-history-system-handler - {:database/conn (ig/ref :database-conn)} + :blaze/rest-api + {:base-url (->Cfg "BASE_URL" string? "http://localhost:8080") + :version (ig/ref :blaze/version) + :structure-definitions (ig/ref :blaze/structure-definition) + :auth-backends (ig/refset :blaze.auth/backend) + :context-path "/fhir"} - :fhir-read-handler - {:database/conn (ig/ref :database-conn)} + :blaze.rest-api/requests-total {} + :blaze.rest-api/request-duration-seconds {} + :blaze.rest-api/parse-duration-seconds {} + :blaze.rest-api/generate-duration-seconds {} + :blaze.rest-api/tx-data-duration-seconds {} - :fhir-search-handler - {:database/conn (ig/ref :database-conn)} + :blaze.handler/app + {:rest-api (ig/ref :blaze/rest-api) + :health-handler (ig/ref :blaze.handler/health)} - :fhir-transaction-handler - {:database/conn (ig/ref :database-conn) - :executor (ig/ref :transaction-interaction-executor) - :term-service (ig/ref :term-service)} + :blaze.server/executor {} - :fhir-update-handler - {:database/conn (ig/ref :database-conn) - :term-service (ig/ref :term-service)} + :blaze/server + {:port (->Cfg "SERVER_PORT" nat-int? 8080) + :executor (ig/ref :blaze.server/executor) + :handler (ig/ref :blaze.handler/app) + :version (ig/ref :blaze/version)} - :fhir-operation-evaluate-measure-handler - {:clock (Clock/systemDefaultZone) - :term-service (ig/ref :term-service) - :executor (ig/ref :evaluate-measure-operation-executor) - :database/conn (ig/ref :database-conn)} + :blaze/thread-pool-executor-collector + {:executors (ig/refmap :blaze.metrics/thread-pool-executor)} - :fhir-core-handler - {:base-url base-url - :database/conn (ig/ref :database-conn) - :handlers - {:handler.fhir/capabilities (ig/ref :fhir-capabilities-handler) - :handler.fhir/create (ig/ref :fhir-create-handler) - :handler.fhir/delete (ig/ref :fhir-delete-handler) - :handler.fhir/history-instance (ig/ref :fhir-history-instance-handler) - :handler.fhir/history-type (ig/ref :fhir-history-type-handler) - :handler.fhir/history-system (ig/ref :fhir-history-system-handler) - :handler.fhir/read (ig/ref :fhir-read-handler) - :handler.fhir/search (ig/ref :fhir-search-handler) - :handler.fhir/transaction (ig/ref :fhir-transaction-handler) - :handler.fhir/update (ig/ref :fhir-update-handler) - :handler.fhir.operation/evaluate-measure - (ig/ref :fhir-operation-evaluate-measure-handler)} - :middleware - {:middleware/guard (ig/ref :guard)}} + :blaze.metrics/registry + {:collectors (ig/refset :blaze.metrics/collector)} - :app-handler - {:handlers - {:handler/cql-evaluation (ig/ref :cql-evaluation-handler) - :handler/health (ig/ref :health-handler) - :handler.fhir/core (ig/ref :fhir-core-handler)} - :middleware - {:middleware/authentication (ig/ref :authentication)}} + :blaze.handler/metrics + {:registry (ig/ref :blaze.metrics/registry)} - :server-executor {} + :blaze.metrics/server + {:port (->Cfg "METRICS_SERVER_PORT" nat-int? 8081) + :handler (ig/ref :blaze.handler/metrics) + :version (ig/ref :blaze/version)}}) - :server - {:port 8080 - :executor (ig/ref :server-executor) - :handler (ig/ref :app-handler) - :version version} - :metrics/registry - {:server-executor (ig/ref :server-executor) - :transaction-interaction-executor (ig/ref :transaction-interaction-executor) - :evaluate-measure-operation-executor (ig/ref :evaluate-measure-operation-executor)} +(defn- feature-enabled? + {:arglists '([env feature])} + [env {:keys [toggle]}] + (let [value (get env toggle)] + (and (not (str/blank? value)) (not= "false" (some-> value str/trim))))) - :metrics-handler - {:registry (ig/ref :metrics/registry)} - :metrics-server - {:port 8081 - :handler (ig/ref :metrics-handler) - :version version}}) +(defn- merge-features + {:arglists '([blaze-edn env])} + [{:keys [base-config features]} env] + (reduce + (fn [res {:keys [name config] :as feature}] + (let [enabled? (feature-enabled? env feature)] + (log/info "Feature" name (if enabled? "enabled" "disabled")) + (if enabled? + (merge res config) + res))) + base-config + features)) (s/fdef init! - :args (s/cat :config :system/config)) + :args (s/cat :env any?)) (defn init! - [{:log/keys [level] :or {level "info"} :as config}] + [{level "LOG_LEVEL" :or {level "info"} :as env}] (log/info "Set log level to:" (str/lower-case level)) (log/merge-config! {:level (keyword (str/lower-case level))}) - (ig/init (merge-with merge default-config config))) + (let [config (merge-features (read-blaze-edn) env) + config (-> (merge-with merge root-config config) + (resolve-config env))] + (load-namespaces config) + (-> config ig/prep ig/init))) (defn shutdown! [system] @@ -240,249 +166,55 @@ ;; ---- Integrant Hooks ------------------------------------------------------- -(defmethod ig/init-key :structure-definitions - [_ _] - (let [structure-definitions (read-structure-definitions)] - (log/info "Read structure definitions resulting in:" - (count structure-definitions) "structure definitions") - structure-definitions)) - - -(defn- upsert-schema [uri structure-definitions] - (let [conn (d/connect uri) - _ @(d/transact-async conn (dts/schema)) - {:keys [tx-data]} @(d/transact-async conn (schema/structure-definition-schemas structure-definitions))] - (log/info "Upsert schema in database:" uri "creating" (count tx-data) "new facts"))) - - -(defmethod ig/init-key :database-conn - [_ {:database/keys [uri] :keys [structure-definitions]}] - (if (d/create-database uri) - (do - (log/info "Created database at:" uri) - (upsert-schema uri structure-definitions)) - (log/info "Use existing database at:" uri)) - - (log/info "Connect with database:" uri) - (d/connect uri)) - - -(defmethod ig/init-key :authentication - [_ {:openid-provider/keys [url]}] - (if (str/blank? url) - identity - (do (log/info "Enabled authentication using OpenID provider:" url) - (-> url - authentication/jwks-json - authentication/public-key - authentication/wrap-authentication)))) - - -(defmethod ig/init-key :guard - [_ {:keys [authentication]}] - (if (= authentication identity) - identity - (do (log/info "Enable authentication guard") - guard/wrap-guard))) - - -(defmethod ig/init-key :term-service - [_ {:keys [uri proxy-host proxy-port proxy-user proxy-password - connection-timeout request-timeout]}] - (log/info - (cond-> - (str "Init terminology server connection: " uri) - proxy-host - (str " using proxy host " proxy-host) - proxy-port - (str ", port " proxy-port) - proxy-user - (str ", user " proxy-user) - proxy-password - (str ", password ***") - connection-timeout - (str ", connection timeout " connection-timeout " ms") - request-timeout - (str ", request timeout " request-timeout " ms"))) - (ts/term-service - uri - (cond-> {} - proxy-host (assoc :host proxy-host) - proxy-port (assoc :port proxy-port) - proxy-user (assoc :user proxy-user) - proxy-password (assoc :password proxy-password)) - connection-timeout request-timeout)) - - -(defmethod ig/init-key :cache - [_ {:cache/keys [threshold] :or {threshold 128}}] - (atom (cache/lru-cache-factory {} :threshold threshold))) - - -(defmethod ig/init-key :transaction-interaction-executor - [_ _] - (ex/cpu-bound-pool "transaction-interaction-%d")) +(defmethod ig/init-key :blaze/version + [_ version] + version) -(defmethod ig/init-key :health-handler +(defmethod ig/init-key :blaze/clock [_ _] - (health-handler/handler)) - - -(defmethod ig/init-key :cql-evaluation-handler - [_ {:database/keys [conn] :keys [cache]}] - (cql-evaluation-handler/handler conn cache)) - - -(defmethod ig/init-key :fhir-capabilities-handler - [_ {:keys [base-url version structure-definitions]}] - (log/debug "Init FHIR capabilities interaction handler") - (fhir-capabilities-handler/handler base-url version structure-definitions)) - - -(defmethod ig/init-key :fhir-create-handler - [_ {:database/keys [conn] :keys [term-service]}] - (log/debug "Init FHIR create interaction handler") - (fhir-create-handler/handler conn term-service)) - - -(defmethod ig/init-key :fhir-delete-handler - [_ {:database/keys [conn]}] - (log/debug "Init FHIR delete interaction handler") - (fhir-delete-handler/handler conn)) - - -(defmethod ig/init-key :fhir-history-instance-handler - [_ {:database/keys [conn]}] - (log/debug "Init FHIR history instance interaction handler") - (fhir-history-instance-handler/handler conn)) - - -(defmethod ig/init-key :fhir-history-type-handler - [_ {:database/keys [conn]}] - (log/debug "Init FHIR history type interaction handler") - (fhir-history-type-handler/handler conn)) - - -(defmethod ig/init-key :fhir-history-system-handler - [_ {:database/keys [conn]}] - (log/debug "Init FHIR history system interaction handler") - (fhir-history-system-handler/handler conn)) - - -(defmethod ig/init-key :fhir-read-handler - [_ {:database/keys [conn]}] - (log/debug "Init FHIR read interaction handler") - (fhir-read-handler/handler conn)) - - -(defmethod ig/init-key :fhir-search-handler - [_ {:database/keys [conn]}] - (log/debug "Init FHIR search interaction handler") - (fhir-search-handler/handler conn)) + (Clock/systemDefaultZone)) -(defmethod ig/init-key :fhir-transaction-handler - [_ {:database/keys [conn] :keys [term-service executor]}] - (log/debug "Init FHIR transaction interaction handler") - (fhir-transaction-handler/handler conn term-service executor)) +#_(defmethod ig/init-key :fhir-capabilities-handler + [_ {:keys [base-url version structure-definitions]}] + (log/debug "Init FHIR capabilities interaction handler") + (fhir-capabilities-handler/handler base-url version structure-definitions)) -(defmethod ig/init-key :fhir-update-handler - [_ {:database/keys [conn] :keys [term-service]}] - (log/debug "Init FHIR update interaction handler") - (fhir-update-handler/handler conn term-service)) - - -(defmethod ig/init-key :fhir-core-handler - [_ {:keys [base-url handlers middleware] :database/keys [conn]}] - (let [fhir-base-url (str base-url "/fhir")] - (log/info "Init FHIR RESTful API with base URL:" fhir-base-url) - (fhir-core-handler/handler fhir-base-url conn handlers middleware))) - - -(defmethod ig/init-key :evaluate-measure-operation-executor +(defmethod ig/init-key :blaze.server/executor [_ _] - (ex/cpu-bound-pool "evaluate-measure-operation-%d")) - + (log/info "Init server executor") + (ex/cpu-bound-pool "server-%d")) -(defmethod ig/init-key :fhir-operation-evaluate-measure-handler - [_ {:keys [clock term-service executor] :database/keys [conn]}] - (log/debug "Init FHIR $evaluate-measure operation handler") - (fhir-operation-evaluate-measure-handler/handler clock conn term-service executor)) +(derive :blaze.server/executor :blaze.metrics/thread-pool-executor) -(defmethod ig/init-key :app-handler - [_ {:keys [handlers middleware]}] - (log/debug "Init app handler") - (app-handler/handler handlers middleware)) +(defcollector blaze.server.executor/collector + [{:keys [executor]}] + (thread-pool-executor-collector {"server" executor})) -(defmethod ig/init-key :server-executor - [_ _] - (ex/cpu-bound-pool "server-%d")) - -(defmethod ig/init-key :server +(defmethod ig/init-key :blaze/server [_ {:keys [port executor handler version]}] (log/info "Start main server on port" port) (server/init! port executor handler version)) -(defmethod ig/init-key :metrics/registry - [_ {:keys [server-executor transaction-interaction-executor - evaluate-measure-operation-executor]}] - (log/debug "Init metrics registry") - (doto (CollectorRegistry. true) - (.register (StandardExports.)) - (.register (MemoryPoolsExports.)) - (.register (GarbageCollectorExports.)) - (.register (ThreadExports.)) - (.register (ClassLoadingExports.)) - (.register (VersionInfoExports.)) - (.register fhir-metrics/requests-total) - (.register fhir-metrics/request-duration-seconds) - (.register json/parse-duration-seconds) - (.register json/generate-duration-seconds) - (.register tx/resource-upsert-duration-seconds) - (.register tx/execution-duration-seconds) - (.register tx/resources-total) - (.register tx/datoms-total) - (.register bundle/tx-data-duration-seconds) - (.register ts/errors-total) - (.register ts/request-duration-seconds) - (.register evaluate-measure/compile-duration-seconds) - (.register evaluate-measure/evaluate-duration-seconds) - (.register (metrics/thread-pool-executor-collector - [["server" server-executor] - ["transaction-interaction" transaction-interaction-executor] - ["evaluate-measure-operation" evaluate-measure-operation-executor] - ["transactor" tx/tx-executor]])))) - - -(defmethod ig/init-key :metrics-handler - [_ {:keys [registry]}] - (log/debug "Init metrics handler") - (metrics-handler/metrics-handler registry)) - - -(defmethod ig/init-key :metrics-server +(defmethod ig/halt-key! :blaze/server + [_ server] + (log/info "Shutdown main server") + (server/shutdown! server)) + + +(defmethod ig/init-key :blaze.metrics/server [_ {:keys [port handler version]}] (log/info "Start metrics server on port" port) (server/init! port (ex/single-thread-executor) handler version)) -(defmethod ig/init-key :default - [_ val] - val) - - -(defmethod ig/halt-key! :server - [_ server] - (log/info "Shutdown main server") - (server/shutdown! server)) - -(defmethod ig/halt-key! :metrics-server +(defmethod ig/halt-key! :blaze.metrics/server [_ server] (log/info "Shutdown metrics server") (server/shutdown! server)) diff --git a/src/blaze/util/cache.clj b/src/blaze/util/cache.clj deleted file mode 100644 index 2632dd354..000000000 --- a/src/blaze/util/cache.clj +++ /dev/null @@ -1,20 +0,0 @@ -(ns blaze.util.cache - (:require - [clojure.core.cache :as cache :refer [CacheProtocol]] - [clojure.spec.alpha :as s])) - - -(defn cache? [x] - (satisfies? CacheProtocol x)) - -(s/fdef update-cache - :args (s/cat :src-cache cache? :dst-cache cache? :key some? :result any?) - :ret cache?) - -(defn update-cache - "Updates `dst-cache` with hit/miss information according to the state of - `src-cache`." - [src-cache dst-cache key result] - (if (cache/has? src-cache key) - (cache/hit dst-cache key) - (cache/miss dst-cache key result))) diff --git a/test/blaze/datomic/cql_test.clj b/test/blaze/datomic/cql_test.clj deleted file mode 100644 index 449ab62ec..000000000 --- a/test/blaze/datomic/cql_test.clj +++ /dev/null @@ -1,16 +0,0 @@ -(ns blaze.datomic.cql-test - (:require - [blaze.datomic.cql :refer :all] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all])) - -(defn stub-find-code [db system code res-spec] - (st/instrument - `find-code - {:spec - {`find-code - (s/fspec - :args (s/cat :db #{db} :system #{system} :code #{code}) - :ret res-spec)} - :stub #{`find-code}})) diff --git a/test/blaze/handler/app_test.clj b/test/blaze/handler/app_test.clj deleted file mode 100644 index b402b915e..000000000 --- a/test/blaze/handler/app_test.clj +++ /dev/null @@ -1,72 +0,0 @@ -(ns blaze.handler.app-test - (:require - [blaze.handler.app :refer [handler router]] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] - [juxt.iota :refer [given]] - [manifold.deferred :as md] - [reitit.ring :as reitit-ring] - [taoensso.timbre :as log])) - - -(defn fixture [f] - (st/instrument) - (st/instrument - [`handler] - {:spec - {`handler - (s/fspec - :args (s/cat :handlers map? :middleware map?))}}) - (log/with-merged-config {:level :fatal} (f)) - (st/unstrument)) - - -(use-fixtures :each fixture) - - -(def ^:private handlers - {:handler/cql-evaluation (fn [_] ::cql-evaluation-handler) - :handler/health (fn [_] ::health-handler) - :handler.fhir/core (fn [_] ::fhir-core-handler)}) - - -(def ^:private middleware - {:middleware/authentication identity}) - - -(def ^:private test-handler - (reitit-ring/ring-handler (router handlers middleware))) - - -(defn- match [path request-method] - (let [response (test-handler {:request-method request-method :uri path})] - (if (md/deferred? response) - @response - response))) - - -(deftest router-test - (are [path request-method handler] (= handler (match path request-method)) - "/cql/evaluate" :options ::cql-evaluation-handler - "/cql/evaluate" :post ::cql-evaluation-handler - "/fhir" :get ::fhir-core-handler - "/fhir/" :get ::fhir-core-handler - "/fhir/foo" :get ::fhir-core-handler - "/fhir" :post ::fhir-core-handler - "/fhir" :put ::fhir-core-handler - "/fhir" :delete ::fhir-core-handler)) - - -(def ^:private handlers-throwing - (assoc handlers :handler.fhir/core (fn [_] (throw (Exception. ""))))) - - -(deftest exception-test - (testing "Exceptions from handlers are converted to OperationOutcomes." - (given @((handler handlers-throwing middleware) - {:uri "/fhir" - :request-method :get}) - :status := 500 - [:headers "Content-Type"] := "application/fhir+json;charset=utf-8" - :body :# #".*OperationOutcome.*"))) diff --git a/test/blaze/handler/fhir/core_test.clj b/test/blaze/handler/fhir/core_test.clj deleted file mode 100644 index 344cedbfd..000000000 --- a/test/blaze/handler/fhir/core_test.clj +++ /dev/null @@ -1,95 +0,0 @@ -(ns blaze.handler.fhir.core-test - (:require - [blaze.handler.fhir.core :refer [handler router]] - [blaze.middleware.fhir.type :refer [wrap-type]] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] - [reitit.core :as reitit] - [reitit.ring :as reitit-ring] - [taoensso.timbre :as log])) - - -(defn fixture [f] - (st/instrument) - (st/instrument - [`handler] - {:spec - {`handler - (s/fspec - :args (s/cat :base-url #{::base-url} :conn #{::conn} :handlers map? :middleware map?))}}) - (st/instrument - [`wrap-type] - {:spec - {`wrap-type - (s/fspec - :args (s/cat :handler fn? :conn #{::conn}))} - :replace - {`wrap-type - (fn [handler _] - handler)}}) - (log/with-merged-config {:level :fatal} (f)) - (st/unstrument)) - - -(use-fixtures :each fixture) - - -(def ^:private handlers - {:handler.fhir/capabilities (fn [_] ::fhir-capabilities-handler) - :handler.fhir/create (fn [_] ::fhir-create-handler) - :handler.fhir/delete (fn [_] ::fhir-delete-handler) - :handler.fhir/history-instance (fn [_] ::fhir-history-instance-handler) - :handler.fhir/history-type (fn [_] ::fhir-history-type-handler) - :handler.fhir/history-system (fn [_] ::fhir-history-system-handler) - :handler.fhir/read (fn [_] ::fhir-read-handler) - :handler.fhir/search (fn [_] ::fhir-search-handler) - :handler.fhir/transaction (fn [_] ::fhir-transaction-handler) - :handler.fhir/update (fn [_] ::fhir-update-handler) - :handler.fhir.operation/evaluate-measure - (fn [_] ::fhir-operation-evaluate-measure-handler)}) - - -(def ^:private middleware - {:middleware/guard identity}) - - -(defn test-handler [] - (reitit-ring/ring-handler (router ::base-url ::conn handlers middleware))) - - -(defn- match [path request-method] - ((test-handler) {:request-method request-method :uri path})) - - -(deftest router-test - (are [path request-method handler] (= handler (match path request-method)) - "Patient" :get ::fhir-search-handler - "Patient" :post ::fhir-create-handler - "Patient/_history" :get ::fhir-history-type-handler - "Patient/_search" :post ::fhir-search-handler - "Patient/0" :get ::fhir-read-handler - "Patient/0" :put ::fhir-update-handler - "Patient/0" :delete ::fhir-delete-handler - "Patient/0/_history" :get ::fhir-history-instance-handler - "Patient/0/_history/42" :get ::fhir-read-handler - "Measure/0/$evaluate-measure" :get ::fhir-operation-evaluate-measure-handler - "Measure/0/$evaluate-measure" :post ::fhir-operation-evaluate-measure-handler)) - - -(deftest router-match-by-name-test - (let [router (router ::base-url ::conn handlers middleware)] - (are [name params path] - (= (reitit/match->path (reitit/match-by-name router name params)) path) - - :fhir/type - {:type "Patient"} - "Patient" - - :fhir/instance - {:type "Patient" :id "23"} - "Patient/23" - - :fhir/versioned-instance - {:type "Patient" :id "23" :vid "42"} - "Patient/23/_history/42"))) diff --git a/test/blaze/handler/fhir/test_util.clj b/test/blaze/handler/fhir/test_util.clj deleted file mode 100644 index 76a2d2aca..000000000 --- a/test/blaze/handler/fhir/test_util.clj +++ /dev/null @@ -1,92 +0,0 @@ -(ns blaze.handler.fhir.test-util - (:require - [blaze.handler.fhir.util :as util] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all])) - - -(defn stub-upsert-resource [conn term-service db creation-mode resource tx-result] - (st/instrument - [`util/upsert-resource] - {:spec - {`util/upsert-resource - (s/fspec - :args (s/cat :conn #{conn} :term-service #{term-service} :db #{db} - :creation-mode #{creation-mode} - :resource #{resource}) - :ret #{tx-result})} - :stub - #{`util/upsert-resource}})) - - -(defn stub-delete-resource [conn db type id tx-result] - (st/instrument - [`util/delete-resource] - {:spec - {`util/delete-resource - (s/fspec - :args (s/cat :conn #{conn} :db #{db} :type #{type} :id #{id}) - :ret #{tx-result})} - :stub - #{`util/delete-resource}})) - - -(defn stub-page-size [query-params page-size] - (st/instrument - [`util/page-size] - {:spec - {`util/page-size - (s/fspec - :args (s/cat :query-params #{query-params}) - :ret #{page-size})} - :stub - #{`util/page-size}})) - - -(defn stub-t [query-params t-spec] - (st/instrument - [`util/t] - {:spec - {`util/t - (s/fspec - :args (s/cat :query-params #{query-params}) - :ret t-spec)} - :stub - #{`util/t}})) - - -(defn stub-type-url [router type url] - (st/instrument - [`util/type-url] - {:spec - {`util/type-url - (s/fspec - :args (s/cat :router #{router} :type #{type}) - :ret #{url})} - :stub - #{`util/type-url}})) - - -(defn stub-instance-url [router type id url] - (st/instrument - [`util/instance-url] - {:spec - {`util/instance-url - (s/fspec - :args (s/cat :router #{router} :type #{type} :id #{id}) - :ret #{url})} - :stub - #{`util/instance-url}})) - - -(defn stub-versioned-instance-url [router type id vid url] - (st/instrument - [`util/versioned-instance-url] - {:spec - {`util/versioned-instance-url - (s/fspec - :args (s/cat :router #{router} :type #{type} :id #{id} :vid #{vid}) - :ret #{url})} - :stub - #{`util/versioned-instance-url}})) diff --git a/test/blaze/handler/fhir/util_test.clj b/test/blaze/handler/fhir/util_test.clj deleted file mode 100644 index 10bbc6096..000000000 --- a/test/blaze/handler/fhir/util_test.clj +++ /dev/null @@ -1,49 +0,0 @@ -(ns blaze.handler.fhir.util-test - (:require - [blaze.handler.fhir.util :refer :all] - [blaze.handler.test-util :as test-util] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all])) - - -(deftest type-url-test - (st/instrument - [`type-url] - {:spec - {`type-url - (s/fspec - :args (s/cat :router #{::router} :type #{::type}))}}) - (test-util/stub-match-by-name - ::router :fhir/type {:type ::type} - {:data {:blaze/base-url "base-url"} :path "path"}) - - (is (= "base-url/path" (type-url ::router ::type)))) - - -(deftest instance-url-test - (st/instrument - [`instance-url] - {:spec - {`instance-url - (s/fspec - :args (s/cat :router #{::router} :type #{::type} :id #{::id}))}}) - (test-util/stub-match-by-name - ::router :fhir/instance {:type ::type :id ::id} - {:data {:blaze/base-url "base-url"} :path "path"}) - - (is (= "base-url/path" (instance-url ::router ::type ::id)))) - - -(deftest versioned-instance-url-test - (st/instrument - [`versioned-instance-url] - {:spec - {`versioned-instance-url - (s/fspec - :args (s/cat :router #{::router} :type #{::type} :id #{::id} :vid #{::vid}))}}) - (test-util/stub-match-by-name - ::router :fhir/versioned-instance {:type ::type :id ::id :vid ::vid} - {:data {:blaze/base-url "base-url"} :path "path"}) - - (is (= "base-url/path" (versioned-instance-url ::router ::type ::id ::vid)))) diff --git a/test/blaze/handler/test_util.clj b/test/blaze/handler/test_util.clj deleted file mode 100644 index 48c313f30..000000000 --- a/test/blaze/handler/test_util.clj +++ /dev/null @@ -1,31 +0,0 @@ -(ns blaze.handler.test-util - (:require - [clojure.test :refer :all] - [clojure.spec.alpha :as s] - [clojure.spec.test.alpha :as st] - [reitit.core :as reitit])) - - -(defn stub-match-by-name [router name params match] - (st/instrument - [`reitit/match-by-name] - {:spec - {`reitit/match-by-name - (s/fspec - :args (s/cat :router #{router} :name #{name} - :params #{params}) - :ret #{match})} - :stub - #{`reitit/match-by-name}})) - - -(defn stub-match-by-path [router path match] - (st/instrument - [`reitit/match-by-path] - {:spec - {`reitit/match-by-path - (s/fspec - :args (s/cat :router #{router} :path #{path}) - :ret #{match})} - :stub - #{`reitit/match-by-path}})) diff --git a/test/blaze/integration_test.clj b/test/blaze/integration_test.clj deleted file mode 100644 index d875bd82b..000000000 --- a/test/blaze/integration_test.clj +++ /dev/null @@ -1,83 +0,0 @@ -(ns blaze.integration-test - (:require - [cheshire.core :as json] - [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] - [datomic.api :as d] - [datomic-spec.test :as dst] - [juxt.iota :refer [given]] - [blaze.bundle :as bundle] - [blaze.cql-translator :as cql] - [blaze.datomic.test-util :as test-util] - [blaze.elm.compiler :as compiler] - [blaze.elm.date-time :as date-time] - [blaze.elm.deps-infer :refer [infer-library-deps]] - [blaze.elm.equiv-relationships :refer [find-equiv-rels-library]] - [blaze.elm.normalizer :refer [normalize-library]] - [blaze.elm.spec] - [blaze.elm.type-infer :refer [infer-library-types]] - [blaze.elm.evaluator :as evaluator] - [blaze.terminology-service.extern :as ts] - [taoensso.timbre :as log]) - (:import - [java.time OffsetDateTime Year])) - - -(defonce db (d/db (st/with-instrument-disabled (test-util/connect)))) - - -(defn fixture [f] - (st/instrument) - (dst/instrument) - (log/with-merged-config {:level :error} (f)) - (st/unstrument)) - - -(use-fixtures :each fixture) - - -(def term-service - (ts/term-service "http://tx.fhir.org/r4" {} nil nil)) - - -(defn- db-with [{:strs [entries]}] - (let [entries @(bundle/annotate-codes term-service db entries) - {db :db-after} (d/with db (bundle/code-tx-data db entries))] - (:db-after (d/with db (bundle/tx-data db entries))))) - - -(defn- evaluate [db query] - @(evaluator/evaluate db (OffsetDateTime/now) - (compiler/compile-library db (cql/translate query) {}))) - - -(defn read-data [query-name] - (-> (slurp (str "integration-test/" query-name "/data.json")) - (json/parse-string))) - - -(defn read-query [query-name] - (slurp (str "integration-test/" query-name "/query.cql"))) - - -(deftest query-test - (are [query-name num] - (= num (get-in (evaluate (db-with (read-data query-name)) - (read-query query-name)) - ["NumberOfPatients" :result])) - - ;"query-3" 1 - ;"query-5" 3 - ;"query-6" 1 - ;"query-7" 2 - "readme-example" 3)) - - -(deftest arithmetic-test - (given (evaluate db (read-query "arithmetic")) - ["OnePlusOne" :result] := 2 - ["OnePointOnePlusOnePointOne" :result] := 2.2M - ["Year2019PlusOneYear" :result] := (Year/of 2020) - ["OneYearPlusOneYear" :result] := (date-time/period 2 0 0) - ["OneYearPlusOneMonth" :result] := (date-time/period 1 1 0) - ["OneSecondPlusOneSecond" :result] := (date-time/period 0 0 2000))) diff --git a/test/blaze/system_test.clj b/test/blaze/system_test.clj index 13bf6f6ae..69e855bf1 100644 --- a/test/blaze/system_test.clj +++ b/test/blaze/system_test.clj @@ -1,8 +1,9 @@ (ns blaze.system-test (:require [blaze.system :as system] + [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :refer :all] + [clojure.test :as test :refer [are deftest is]] [datomic-spec.test :as dst] [taoensso.timbre :as log])) @@ -14,8 +15,22 @@ (st/unstrument)) -(use-fixtures :each fixture) +(test/use-fixtures :each fixture) +(deftest resolve-config-test + (are [config env res] (= res (system/resolve-config config env)) + {:a (system/->Cfg "SERVER_PORT" (s/spec nat-int?) 8080)} + {"SERVER_PORT" "80"} + {:a 80} + + {:a (system/->Cfg "SERVER_PORT" (s/spec nat-int?) 8080)} + nil + {:a 8080} + + {:a (system/->Cfg "SERVER_PORT" (s/spec nat-int?) 8080)} + {"SERVER_PORT" "a"} + {:a ::s/invalid})) + (deftest init-shutdown-test (is (nil? (system/shutdown! (system/init! {}))))) diff --git a/tests.edn b/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}]