First commit. Taken from open source branch of internal sample-tracking application.
This commit is contained in:
32
.gitignore
vendored
Normal file
32
.gitignore
vendored
Normal file
@@ -0,0 +1,32 @@
|
||||
pom.xml
|
||||
pom.xml.asc
|
||||
*.jar
|
||||
*.class
|
||||
/lib/
|
||||
/classes/
|
||||
/target/
|
||||
/checkouts/
|
||||
/.lein-*
|
||||
.lein-deps-sum
|
||||
.lein-repl-history
|
||||
.lein-plugins/
|
||||
.lein-failures
|
||||
.nrepl-port
|
||||
.cpcache/
|
||||
/.idea
|
||||
/*.iml
|
||||
/*.log
|
||||
/*-init.clj
|
||||
/resources/public/cljs-out
|
||||
out
|
||||
.vscode
|
||||
.rebel_readline_history
|
||||
.clj-kondo/.cache
|
||||
figwheel_server.log
|
||||
node_modules
|
||||
dist
|
||||
secrets
|
||||
.DS_Store
|
||||
.calva
|
||||
.lsp
|
||||
/deploy/datomic/releases/
|
||||
12
CHANGELOG.md
Executable file
12
CHANGELOG.md
Executable file
@@ -0,0 +1,12 @@
|
||||
# Change Log
|
||||
|
||||
Follows conventions in
|
||||
[keepachangelog.com](http://keepachangelog.com/en/1.0.0/).
|
||||
|
||||
## Unreleased
|
||||
|
||||
## 0.1 - 2018-02-08
|
||||
|
||||
### Added
|
||||
|
||||
* Initial release
|
||||
14
Dockerfile
Executable file
14
Dockerfile
Executable file
@@ -0,0 +1,14 @@
|
||||
FROM openjdk:11
|
||||
LABEL maintainer="rschiemann@parkerici.org"
|
||||
|
||||
EXPOSE 8989
|
||||
|
||||
WORKDIR /sample-tracking
|
||||
|
||||
COPY resources resources
|
||||
|
||||
COPY target/sample-tracking-standalone.jar .
|
||||
|
||||
# $PORT didn't work
|
||||
# get config from kub env vars
|
||||
ENTRYPOINT ["java", "-jar", "sample-tracking-standalone.jar", "server", "-p", "8989"]
|
||||
1
Procfile
Executable file
1
Procfile
Executable file
@@ -0,0 +1 @@
|
||||
web: java $JVM_OPTS -cp target/starter.jar clojure.main -m starter.server
|
||||
389
README.md
Normal file
389
README.md
Normal file
@@ -0,0 +1,389 @@
|
||||
# sample-tracking
|
||||
|
||||
## Admin Console Documentation
|
||||
|
||||
Instructions for the usage of the admin console can be found on the [eReq Admin Console page](docs/console.md).
|
||||
|
||||
## Tech Stack
|
||||
|
||||
Server side [ring](https://github.com/ring-clojure/ring) app:
|
||||
|
||||
* Static asset serving
|
||||
* JSON REST API with echo endpoint for prototyping
|
||||
* Hot code reloading
|
||||
|
||||
Client side [re-frame](https://github.com/Day8/re-frame) app:
|
||||
|
||||
* Routing using [bidi](https://github.com/juxt/bidi) and [pushy](https://github.com/clj-commons/pushy)
|
||||
* Event interceptor that validates app DB against spec in development
|
||||
* Components structured into separate namespaces each with their own db spec, event handlers, subscriptions, and views.
|
||||
Namespaced using the
|
||||
re-frame [synthetic namespace](https://github.com/Day8/re-frame/blob/master/docs/Namespaced-Keywords.md) pattern
|
||||
* Pages separated out with potential to use parallel structure to components as their complexity grows
|
||||
|
||||
To demonstrate things a homepage with a sign up form that POSTs to an API which just echo's back the response is
|
||||
provided.
|
||||
|
||||
## Development Mode
|
||||
|
||||
Start figwheel-main:
|
||||
|
||||
```bash
|
||||
$ lein fig:build
|
||||
```
|
||||
|
||||
This should start a ring server and automatically building your application. Once it's ready, it should open a new
|
||||
browser window with the application for you.
|
||||
|
||||
## Node packages and interop
|
||||
|
||||
Setup using this guide: [Figwheel-main and NPM Modules](https://figwheel.org/docs/npm.html)
|
||||
|
||||
To add new modules, add them to npm
|
||||
|
||||
```bash
|
||||
$ npm install --save <package>
|
||||
```
|
||||
|
||||
And then import the package add it to the window in src/js/index.js. Before starting the webserver, run the following
|
||||
commands to update the bundle of external modules:
|
||||
|
||||
```bash
|
||||
$ npm install
|
||||
$ npx webpack --mode=development
|
||||
```
|
||||
|
||||
## Creating and serving the database
|
||||
|
||||
Download Datomic Pro and run the following commands from within the unzipped folder.
|
||||
|
||||
Start the transactor with your license in the properties in one terminal.
|
||||
|
||||
```bash
|
||||
./bin/transactor ../dev-transactor.properties
|
||||
```
|
||||
|
||||
In s separate terminal, start the repl and delete any existing databases and recreate them. You can skip the
|
||||
delete-database step if this is your first time creating them.
|
||||
|
||||
```bash
|
||||
./bin/repl
|
||||
Clojure 1.10.1
|
||||
```
|
||||
|
||||
```clojure
|
||||
user=> (require 'datomic.api)
|
||||
nil
|
||||
user=> (datomic.api/delete-database "datomic:dev://localhost:4334/ereq-dev")
|
||||
true
|
||||
user=> (datomic.api/create-database "datomic:dev://localhost:4334/ereq-dev")
|
||||
true
|
||||
user=> (datomic.api/delete-database "datomic:dev://localhost:4334/ereq-test")
|
||||
true
|
||||
user=> (datomic.api/create-database "datomic:dev://localhost:4334/ereq-test")
|
||||
true
|
||||
```
|
||||
|
||||
Start serving the databases in separate terminals.
|
||||
|
||||
```bash
|
||||
./bin/run -m datomic.peer-server -h localhost -p 8998 -a myaccesskey,mysecret -d ereq-dev,datomic:dev://localhost:4334/ereq-dev
|
||||
```
|
||||
|
||||
```bash
|
||||
./bin/run -m datomic.peer-server -h localhost -p 9119 -a myaccesskey,mysecret -d ereq-test,datomic:dev://localhost:4334/ereq-test
|
||||
```
|
||||
|
||||
## Populating the database
|
||||
|
||||
### Initializing the database
|
||||
|
||||
You can run the following command to transact the schema and add initial form data:
|
||||
|
||||
```bash
|
||||
lein run test-setup
|
||||
```
|
||||
|
||||
### Editing and transacting the schema
|
||||
|
||||
This project uses Datomic as its database. Datomic configuration defaults are stored in `resources/config/datomic.edn`,
|
||||
and can be overridden by environment variables defined in the same file. The database schema is stored
|
||||
in `src/clj/org/parkerici/sample_tracking/db/schema.clj`.
|
||||
|
||||
If you make changes to the schema, run `lein run transact-schema` to generate a new Datomic schema file
|
||||
at `resources/schema.edn` and to transact the changes to the configured database.
|
||||
|
||||
### Populating roles
|
||||
|
||||
To add new roles from the configuration files to the database run the following command. You only need to do this if you
|
||||
are adding new roles.
|
||||
|
||||
```bash
|
||||
lein run create-roles
|
||||
```
|
||||
|
||||
### Adding admin users
|
||||
|
||||
To add an admin user from the CLI run the following command.
|
||||
|
||||
```bash
|
||||
lein run add-admin user@gsuite.com
|
||||
```
|
||||
|
||||
## Running Tests
|
||||
|
||||
The test database ereq-test must be running for tests to run successfully.
|
||||
|
||||
Before running tests for the first time you must populate the test database.
|
||||
|
||||
```bash
|
||||
lein with-profile test run test-setup
|
||||
```
|
||||
|
||||
Sometimes with-profile doesn't work. If this is the case you can manually set the environment variables.
|
||||
|
||||
```bash
|
||||
export DATOMIC_ENDPOINT=localhost:9119
|
||||
export DATOMIC_DB_NAME=ereq-test
|
||||
export SEND_MANIFEST_EMAILS=false
|
||||
```
|
||||
|
||||
Once you've done this you can run the tests with the following command.
|
||||
|
||||
```bash
|
||||
lein test
|
||||
```
|
||||
|
||||
## Creating new Forms
|
||||
|
||||
The process for creating new forms can be found [here](docs/forms.md).
|
||||
|
||||
## Deploying on GCS
|
||||
|
||||
### Create a k8s cluster
|
||||
|
||||
Make sure it's VPC native
|
||||
|
||||
### Create a Postgres database
|
||||
|
||||
https://console.cloud.google.com/sql/instances
|
||||
|
||||
Record name and password: sample-tracking / <pwd>
|
||||
|
||||
This can take over a half hour to complete....but you can get IP address first
|
||||
|
||||
Give it a Private IP address Use Connections Tab, Turn on the required API. etc
|
||||
|
||||
### Create Datomic DB
|
||||
|
||||
See https://docs.datomic.com/on-prem/storage.html
|
||||
|
||||
Connect to the database:
|
||||
|
||||
```bash
|
||||
$ gcloud sql connect <cloudsql-db-name> --user=postgres
|
||||
```
|
||||
|
||||
Copy and paste the Postgres datomic `postgres-db.sql` scripts into the prompt. You have to delete the TABLESPACE
|
||||
argument from the db creation script.
|
||||
|
||||
After you create the database, connect to it by running \c datomic in the psql command line.
|
||||
|
||||
Next, run the `postgres-table.sql` and the `postgres-user.sql` in the `datomic` db.
|
||||
|
||||
### Create App DB
|
||||
|
||||
[ don՚t do this if you are restoring from backup! ]
|
||||
|
||||
Setup and create the transactor pod:
|
||||
|
||||
```bash
|
||||
$ kubectl --namespace=default create secret generic datomic-transactor-properties --from-file=transactor.properties=./secrets/transactor.properties
|
||||
$ kubectl apply -f ./deploy/k8s/datomic/transactor.yaml
|
||||
```
|
||||
|
||||
Attach to the pod and create the DB in Datomic. Make sure to substitute the IP of the postgres instance – it should be
|
||||
same as in transactor.properties.
|
||||
|
||||
```bash
|
||||
$ kubectl get pods
|
||||
$ kubectl exec -it $(kubectl get pods --selector=app=datomic-transactor -o jsonpath={.items..metadata.name}) -- /bin/bash
|
||||
$ bin/repl
|
||||
> (require '[datomic.api :as d])
|
||||
|
||||
> (def db-uri "datomic:sql://sample-tracking?jdbc:postgresql://<DB-IP>:5432/datomic?user=datomic&password=datomic")
|
||||
> (d/create-database db-uri)
|
||||
```
|
||||
|
||||
## CI Deploy
|
||||
|
||||
The `.circleci` folder contains the `config.yaml` file that describes the deployment to the previously configured
|
||||
cluster.
|
||||
|
||||
It requires a public IP for each environment `ereq-dev` and `ereq-prod`. Non `master` branches will be deployed to `dev`
|
||||
for every commit, and `master` deploys to `prod`.
|
||||
|
||||
Each environment requires the environment variables in CircleCI to be configured appropriately. These are in the
|
||||
CircleCI Contexts and Project Environment Variables.
|
||||
|
||||
The CI deploy uses [Google managed certificates](https://cloud.google.com/kubernetes-engine/docs/how-to/managed-certs)
|
||||
and a [Google Ingress](https://cloud.google.com/kubernetes-engine/docs/how-to/load-balance-ingress) (as opposed to the
|
||||
Nginx Ingress)
|
||||
|
||||
The HTTP-to-HTTPS redirect feature of the Ingress is still in beta and only available in GKE 1.18+. 1.18+ is still on
|
||||
the Rapid release channel which can have some instability. To avoid that, we are using
|
||||
a [manual partial LB](https://cloud.google.com/load-balancing/docs/https/setting-up-http-https-redirect#partial-http-lb)
|
||||
. The summarized steps to setup this partial LB are:
|
||||
|
||||
* Ensure HTTP is not served on the Ingress using the annotiation `kubernetes.io/ingress.allow-http: "false"` on the
|
||||
Ingress
|
||||
* Manually create a load balancer on the same IP as the Ingress with the HTTP-to-HTTPS redirect as described in the
|
||||
linked doc above.
|
||||
|
||||
## Non-CI Deploy
|
||||
|
||||
### Manually building Docker image
|
||||
|
||||
To build and package into Docker for dev:
|
||||
|
||||
```bash
|
||||
$ npx webpack && lein package && docker build -t gcr.io/dev-project/sample-tracking:0.1.0 .
|
||||
```
|
||||
|
||||
And for prod:
|
||||
|
||||
```bash
|
||||
$ npx webpack && lein package && docker build -t gcr.io/production-project/sample-tracking:0.1.0 .
|
||||
```
|
||||
|
||||
To push to GCR:
|
||||
|
||||
```bash
|
||||
$ docker push <image-tag>
|
||||
```
|
||||
|
||||
### Deploy the Peer Server and Datomic Services
|
||||
|
||||
```bash
|
||||
$ kubectl apply -f ./deploy/k8s/datomic/transactor-service.yaml
|
||||
$ kubectl apply -f ./deploy/k8s/datomic/peer.yaml
|
||||
$ kubectl apply -f ./deploy/k8s/datomic/peer-service.yaml
|
||||
```
|
||||
|
||||
### Run the Deploy Job
|
||||
|
||||
As of now this job transacts the schema to the database.
|
||||
|
||||
```bash
|
||||
$ kubectl apply -f deploy/k8s/sample-tracking/deploy-job.yaml
|
||||
```
|
||||
|
||||
To get the results of the job:
|
||||
|
||||
```bash
|
||||
$kubectl get jobs
|
||||
|
||||
NAME COMPLETIONS DURATION AGE
|
||||
deploy-tasks 1/1 21s 55s
|
||||
```
|
||||
|
||||
To get the pod name or check on the logs:
|
||||
|
||||
```bash
|
||||
$ kubectl get pods
|
||||
NAME READY STATUS RESTARTS AGE
|
||||
datomic-peer-cb5cfc5b6-5shhm 1/1 Running 0 51m
|
||||
datomic-transactor-c69857949-6cj6m 1/1 Running 0 71m
|
||||
deploy-tasks-gjqg4 1/1 Running 0 16s
|
||||
```
|
||||
|
||||
```bash
|
||||
$ kubectl logs deploy-tasks-gjqg4
|
||||
[main] INFO org.eclipse.jetty.util.log - Logging initialized @5528ms to org.eclipse.jetty.util.log.Slf4jLog
|
||||
20-03-04 00:53:00 deploy-tasks-gjqg4 INFO [org.parkerici.sample-tracking.cli:55] - Running with environment :default
|
||||
20-03-04 00:53:00 deploy-tasks-gjqg4 INFO [org.parkerici.sample-tracking.db.schema:182] - Writing schema out to file.
|
||||
20-03-04 00:53:00 deploy-tasks-gjqg4 INFO [org.parkerici.sample-tracking.db.schema:184] - Transacting schema.
|
||||
```
|
||||
|
||||
Once it's successful, delete the job.
|
||||
|
||||
```bash
|
||||
$ kubectl delete job deploy-tasks
|
||||
```
|
||||
|
||||
### Deploy the App Server and Service
|
||||
|
||||
#### Deploying without a Domain Name
|
||||
|
||||
Deploy the app and the basic service to the cluster.
|
||||
|
||||
```bash
|
||||
$ kubectl apply -f ./deploy/k8s/sample-tracking/app.yaml
|
||||
$ kubectl apply -f ./deploy/k8s/sample-tracking/app-basic-service.yaml
|
||||
```
|
||||
|
||||
Get the IP address for the service.
|
||||
|
||||
```bash
|
||||
$ kubectl get service/sample-tracking
|
||||
|
||||
NAME TYPE CLUSTER-IP EXTERNAL-IP PORT(S) AGE
|
||||
sample-tracking LoadBalancer 10.110.5.220 34.82.204.132 80:31412/TCP 3m42s
|
||||
```
|
||||
|
||||
#### Deploying with a Domain Name
|
||||
|
||||
Setup Helm locally.
|
||||
|
||||
```bash
|
||||
$ brew install kubernetes-helm
|
||||
```
|
||||
|
||||
Or make sure it's up to date if already installed.
|
||||
|
||||
```bash
|
||||
$ brew upgrade kubernetes-helm
|
||||
```
|
||||
|
||||
Reserve an **
|
||||
unused/unbound** [reserved regional external IP from GCP](https://cloud.google.com/compute/docs/ip-addresses/reserve-static-external-ip-address)
|
||||
IP address for the nginx load balancer.
|
||||
|
||||
```bash
|
||||
gcloud compute addresses create sample-tracking --region <CLUSTER-REGION>
|
||||
```
|
||||
|
||||
Install the nginx-ingress chart with the custom static IP. If you are installing multiple ingresses in the same culster
|
||||
you must name them differently.
|
||||
|
||||
```bash
|
||||
$ helm repo add stable https://kubernetes-charts.storage.googleapis.com
|
||||
$ helm repo update
|
||||
$ helm install nginx-ingress stable/nginx-ingress --set controller.service.loadBalancerIP=<RESERVED-IP>
|
||||
```
|
||||
|
||||
We can use the following command to check when our static IP has been assigned to the load balancer.
|
||||
|
||||
```bash
|
||||
$ kubectl get services -o wide nginx-ingress-controller
|
||||
|
||||
NAME TYPE CLUSTER-IP EXTERNAL-IP PORT(S) AGE SELECTOR
|
||||
nginx-ingress-nginx-ingress LoadBalancer 10.110.4.204 <RESERVED-IP> 80:31312/TCP,443:30326/TCP 85s app=controller
|
||||
```
|
||||
|
||||
Once this is done, create the application, service, and ingress to be exposed by the load balancer.
|
||||
|
||||
```bash
|
||||
kubectl apply -f ./deploy/k8s/sample-tracking/app.yaml
|
||||
kubectl apply -f ./deploy/k8s/sample-tracking/app-service.yaml
|
||||
kubectl apply -f ./deploy/k8s/sample-tracking/app-ingress.yaml
|
||||
```
|
||||
|
||||
## TODO
|
||||
|
||||
* Add test coverage
|
||||
* Move all CircleCI environment variables into the Project Environment Variables.
|
||||
|
||||
# License
|
||||
|
||||
Mantis Viewer is distributed under Apache 2 license. See the [LICENSE](LICENSE.md) file for details.
|
||||
29
deploy/datomic/Dockerfile
Normal file
29
deploy/datomic/Dockerfile
Normal file
@@ -0,0 +1,29 @@
|
||||
FROM naartjie/alpine-lein
|
||||
|
||||
# Based on pointslope/datomic-pro-starter
|
||||
# https://hub.docker.com/r/pointslope/datomic-pro-starter/dockerfile
|
||||
|
||||
MAINTAINER Mike Travers "mtravers@parkerici.org"
|
||||
|
||||
# Set the version to the one you're downloading.
|
||||
ENV DATOMIC_VERSION=1.0.6202
|
||||
ENV DATOMIC_HOME /opt/datomic-pro-$DATOMIC_VERSION
|
||||
ENV DATOMIC_DATA $DATOMIC_HOME/data
|
||||
|
||||
RUN apk add --no-cache unzip curl
|
||||
|
||||
# Datomic Pro Starter as easy as 1-2-3
|
||||
# 1. Download a release from my.datomic.com and put it in the releases folder
|
||||
ADD releases/datomic-pro-1.0.6202.zip /tmp/datomic.zip
|
||||
|
||||
RUN unzip /tmp/datomic.zip -d /opt \
|
||||
&& rm -f /tmp/datomic.zip
|
||||
|
||||
WORKDIR $DATOMIC_HOME
|
||||
RUN echo DATOMIC HOME: $DATOMIC_HOME
|
||||
|
||||
# 3. Provide a CMD argument with the relative path to the
|
||||
# transactor.properties file it will supplement the ENTRYPOINT
|
||||
VOLUME $DATOMIC_DATA
|
||||
|
||||
EXPOSE 4334 4335 4336
|
||||
4
deploy/datomic/create_test_db.clj
Normal file
4
deploy/datomic/create_test_db.clj
Normal file
@@ -0,0 +1,4 @@
|
||||
;;; Run by CI to create a local database
|
||||
|
||||
(require 'datomic.api)
|
||||
(datomic.api/create-database "datomic:dev://localhost:4334/ereq-test")
|
||||
22
deploy/datomic/dev-transactor.properties.template
Normal file
22
deploy/datomic/dev-transactor.properties.template
Normal file
@@ -0,0 +1,22 @@
|
||||
# transactor properties for local dev instances (and CI)
|
||||
|
||||
###################################################################
|
||||
|
||||
protocol=dev
|
||||
host=localhost
|
||||
port=4334
|
||||
|
||||
###################################################################
|
||||
# See https://docs.datomic.com/on-prem/storage.html
|
||||
|
||||
license-key=${DATOMIC_LICENSE_KEY}
|
||||
|
||||
|
||||
###################################################################
|
||||
# See https://docs.datomic.com/on-prem/capacity.html
|
||||
|
||||
|
||||
## Recommended settings for -Xmx1g usage, e.g. dev laptops.
|
||||
memory-index-threshold=32m
|
||||
memory-index-max=256m
|
||||
object-cache-max=128m
|
||||
14
deploy/k8s/datomic/peer-service.yaml
Normal file
14
deploy/k8s/datomic/peer-service.yaml
Normal file
@@ -0,0 +1,14 @@
|
||||
apiVersion: v1
|
||||
kind: Service
|
||||
metadata:
|
||||
labels:
|
||||
app: datomic-peer
|
||||
name: datomic-peer
|
||||
spec:
|
||||
ports:
|
||||
- name: datomic-peer
|
||||
port: 8998
|
||||
protocol: TCP
|
||||
targetPort: 8998
|
||||
selector:
|
||||
app: datomic-peer
|
||||
26
deploy/k8s/datomic/peer-template.yaml
Normal file
26
deploy/k8s/datomic/peer-template.yaml
Normal file
@@ -0,0 +1,26 @@
|
||||
apiVersion: apps/v1
|
||||
kind: Deployment
|
||||
metadata:
|
||||
name: datomic-peer
|
||||
labels:
|
||||
app: datomic-peer
|
||||
spec:
|
||||
replicas: 1
|
||||
selector:
|
||||
matchLabels:
|
||||
app: datomic-peer
|
||||
template:
|
||||
metadata:
|
||||
labels:
|
||||
app: datomic-peer
|
||||
spec:
|
||||
containers:
|
||||
- name: datomic-peer
|
||||
image: gcr.io/pici-ereq/datomic:1.0.6202
|
||||
imagePullPolicy: Always
|
||||
command: [ "./bin/run", "-m", "datomic.peer-server", "-h", "0.0.0.0", "-p", "8998", "-a", "myaccesskey,mysecret", "-d", "sample-tracking,datomic:sql://sample-tracking?jdbc:postgresql://$POSTGRES_IP:5432/datomic?user=datomic&password=datomic" ]
|
||||
ports:
|
||||
- containerPort: 8998
|
||||
env:
|
||||
- name: POSTGRES_IP
|
||||
value: ${POSTGRES_IP}
|
||||
7
deploy/k8s/datomic/transactor-props.yaml
Normal file
7
deploy/k8s/datomic/transactor-props.yaml
Normal file
@@ -0,0 +1,7 @@
|
||||
apiVersion: v1
|
||||
kind: Secret
|
||||
metadata:
|
||||
name: datomic-transactor-properties
|
||||
type: Opaque
|
||||
data:
|
||||
transactor.properties: ${B64_TRANSACTOR_PROPS}
|
||||
14
deploy/k8s/datomic/transactor-service.yaml
Normal file
14
deploy/k8s/datomic/transactor-service.yaml
Normal file
@@ -0,0 +1,14 @@
|
||||
apiVersion: v1
|
||||
kind: Service
|
||||
metadata:
|
||||
name: datomic-transactor
|
||||
labels:
|
||||
app: datomic-transactor
|
||||
spec:
|
||||
ports:
|
||||
- name: datomic-transactor
|
||||
protocol: TCP
|
||||
port: 4334
|
||||
targetPort: 4334
|
||||
selector:
|
||||
app: datomic-transactor
|
||||
31
deploy/k8s/datomic/transactor.yaml
Normal file
31
deploy/k8s/datomic/transactor.yaml
Normal file
@@ -0,0 +1,31 @@
|
||||
apiVersion: apps/v1
|
||||
kind: Deployment
|
||||
metadata:
|
||||
name: datomic-transactor
|
||||
labels:
|
||||
app: datomic-transactor
|
||||
spec:
|
||||
replicas: 1
|
||||
selector:
|
||||
matchLabels:
|
||||
app: datomic-transactor
|
||||
template:
|
||||
metadata:
|
||||
labels:
|
||||
app: datomic-transactor
|
||||
spec:
|
||||
volumes:
|
||||
- name: transactor-properties
|
||||
secret:
|
||||
secretName: datomic-transactor-properties
|
||||
containers:
|
||||
- name: datomic-transactor
|
||||
image: gcr.io/pici-ereq/datomic:1.0.6202
|
||||
imagePullPolicy: Always
|
||||
command: [ "./bin/transactor", "config/transactor.properties" ]
|
||||
ports:
|
||||
- containerPort: 4334
|
||||
volumeMounts:
|
||||
- name: transactor-properties
|
||||
mountPath: /opt/datomic-pro-1.0.6202/config/transactor.properties
|
||||
subPath: transactor.properties
|
||||
7
deploy/k8s/sample-tracking/app-cert-dev.yaml
Normal file
7
deploy/k8s/sample-tracking/app-cert-dev.yaml
Normal file
@@ -0,0 +1,7 @@
|
||||
apiVersion: networking.gke.io/v1beta2
|
||||
kind: ManagedCertificate
|
||||
metadata:
|
||||
name: ereq-cert-dev
|
||||
spec:
|
||||
domains:
|
||||
- dev-ereq.parkerici.org
|
||||
7
deploy/k8s/sample-tracking/app-cert-prod.yaml
Normal file
7
deploy/k8s/sample-tracking/app-cert-prod.yaml
Normal file
@@ -0,0 +1,7 @@
|
||||
apiVersion: networking.gke.io/v1beta2
|
||||
kind: ManagedCertificate
|
||||
metadata:
|
||||
name: ereq-cert-prod
|
||||
spec:
|
||||
domains:
|
||||
- ereq.parkerici.org
|
||||
14
deploy/k8s/sample-tracking/app-ingress-template.yaml
Normal file
14
deploy/k8s/sample-tracking/app-ingress-template.yaml
Normal file
@@ -0,0 +1,14 @@
|
||||
apiVersion: networking.k8s.io/v1beta1
|
||||
kind: Ingress
|
||||
metadata:
|
||||
name: ereq-ingress
|
||||
annotations:
|
||||
kubernetes.io/ingress.allow-http: "false"
|
||||
kubernetes.io/ingress.global-static-ip-name: ereq-${ENVIRONMENT}
|
||||
networking.gke.io/managed-certificates: ereq-cert-${ENVIRONMENT}
|
||||
labels:
|
||||
app: sample-tracking
|
||||
spec:
|
||||
backend:
|
||||
serviceName: sample-tracking-service
|
||||
servicePort: 80
|
||||
26
deploy/k8s/sample-tracking/app-service.yaml
Normal file
26
deploy/k8s/sample-tracking/app-service.yaml
Normal file
@@ -0,0 +1,26 @@
|
||||
apiVersion: cloud.google.com/v1
|
||||
kind: BackendConfig
|
||||
metadata:
|
||||
name: ereq-backend-config
|
||||
spec:
|
||||
timeoutSec: 60
|
||||
---
|
||||
apiVersion: v1
|
||||
kind: Service
|
||||
metadata:
|
||||
name: sample-tracking-service
|
||||
labels:
|
||||
app: sample-tracking
|
||||
annotations:
|
||||
beta.cloud.google.com/backend-config: '{"default": "ereq-backend-config"}'
|
||||
spec:
|
||||
type: NodePort
|
||||
selector:
|
||||
app: sample-tracking
|
||||
tier: web
|
||||
ports:
|
||||
- name: http
|
||||
port: 80
|
||||
protocol: TCP
|
||||
targetPort: 8989
|
||||
sessionAffinity: ClientIP
|
||||
97
deploy/k8s/sample-tracking/app-template.yaml
Normal file
97
deploy/k8s/sample-tracking/app-template.yaml
Normal file
@@ -0,0 +1,97 @@
|
||||
apiVersion: apps/v1
|
||||
kind: Deployment
|
||||
metadata:
|
||||
name: sample-tracking-app
|
||||
labels:
|
||||
app: sample-tracking
|
||||
spec:
|
||||
replicas: 1
|
||||
selector:
|
||||
matchLabels:
|
||||
app: sample-tracking
|
||||
template:
|
||||
metadata:
|
||||
labels:
|
||||
app: sample-tracking
|
||||
tier: web
|
||||
spec:
|
||||
volumes:
|
||||
- name: google-application-credentials
|
||||
secret:
|
||||
secretName: google-application-credentials
|
||||
- name: firebase-application-credentials
|
||||
secret:
|
||||
secretName: firebase-application-credentials
|
||||
containers:
|
||||
- name: sample-tracking-app
|
||||
image: gcr.io/pici-ereq/sample-tracking:${DEPLOY_VERSION}
|
||||
imagePullPolicy: Always
|
||||
command: [ "java" ]
|
||||
args: [ "-Xss4096k", "-Xmx23G", "-jar", "sample-tracking-standalone.jar", "server", "-p", "8989" ]
|
||||
resources:
|
||||
requests:
|
||||
memory: "24Gi"
|
||||
ports:
|
||||
- containerPort: 8989
|
||||
livenessProbe:
|
||||
httpGet:
|
||||
path: /api/health
|
||||
port: 8989
|
||||
initialDelaySeconds: 30
|
||||
timeoutSeconds: 1
|
||||
readinessProbe:
|
||||
httpGet:
|
||||
path: /api/health
|
||||
port: 8989
|
||||
initialDelaySeconds: 30
|
||||
timeoutSeconds: 1
|
||||
volumeMounts:
|
||||
- name: google-application-credentials
|
||||
mountPath: /credentials/service-account.json
|
||||
subPath: service-account.json
|
||||
- name: firebase-application-credentials
|
||||
mountPath: /credentials/firebase-credentials.json
|
||||
subPath: firebase-credentials.json
|
||||
env:
|
||||
- name: DEPLOY_ENVIRONMENT
|
||||
value: default
|
||||
- name: DATOMIC_ACCESS_KEY
|
||||
value: myaccesskey
|
||||
- name: DATOMIC_SECRET
|
||||
value: mysecret
|
||||
- name: DATOMIC_DB_NAME
|
||||
value: sample-tracking
|
||||
- name: DATOMIC_ENDPOINT
|
||||
value: datomic-peer:8998
|
||||
- name: MANIFEST_EMAIL_RECIPIENT
|
||||
value: ${MANIFEST_EMAIL_RECIPIENT}
|
||||
- name: MANIFEST_EMAIL_SENDER
|
||||
value: ereq-admin@parkerici.org
|
||||
- name: SEND_MANIFEST_EMAILS
|
||||
value: "true"
|
||||
- name: GOOGLE_APPLICATION_CREDENTIALS
|
||||
value: "/credentials/service-account.json"
|
||||
- name: FIREBASE_JS_APPLICATION_CREDENTIALS
|
||||
value: "/credentials/firebase-credentials.json"
|
||||
- name: SEND_VENDOR_EMAILS
|
||||
value: "${SEND_VENDOR_EMAILS}"
|
||||
- name: OAUTH_CLIENT_ID
|
||||
valueFrom:
|
||||
secretKeyRef:
|
||||
name: google-oauth
|
||||
key: id
|
||||
- name: OAUTH_CLIENT_SECRET
|
||||
valueFrom:
|
||||
secretKeyRef:
|
||||
name: google-oauth
|
||||
key: secret
|
||||
- name: SENDGRID_API_KEY
|
||||
valueFrom:
|
||||
secretKeyRef:
|
||||
name: sendgrid-api
|
||||
key: key
|
||||
- name: API_KEY
|
||||
valueFrom:
|
||||
secretKeyRef:
|
||||
name: ereq-auth
|
||||
key: key
|
||||
32
deploy/k8s/sample-tracking/deploy-job-template.yaml
Normal file
32
deploy/k8s/sample-tracking/deploy-job-template.yaml
Normal file
@@ -0,0 +1,32 @@
|
||||
# Job to run deploy tasks before actual deploy.
|
||||
apiVersion: batch/v1
|
||||
kind: Job
|
||||
metadata:
|
||||
name: deploy-tasks
|
||||
spec:
|
||||
template:
|
||||
metadata:
|
||||
name: deploy-tasks
|
||||
labels:
|
||||
name: deploy-tasks
|
||||
spec:
|
||||
restartPolicy: Never
|
||||
containers:
|
||||
- name: deploy-tasks-runner
|
||||
image: gcr.io/pici-ereq/sample-tracking:${DEPLOY_VERSION}
|
||||
imagePullPolicy: Always
|
||||
command: [ "/bin/sh", "-c", "java -jar sample-tracking-standalone.jar predeploy" ]
|
||||
ports:
|
||||
- containerPort: 8989
|
||||
env:
|
||||
- name: DEPLOY_ENVIRONMENT
|
||||
value: default
|
||||
- name: DATOMIC_ACCESS_KEY
|
||||
value: myaccesskey
|
||||
- name: DATOMIC_SECRET
|
||||
value: mysecret
|
||||
- name: DATOMIC_DB_NAME
|
||||
value: sample-tracking
|
||||
- name: DATOMIC_ENDPOINT
|
||||
value: datomic-peer:8998
|
||||
backoffLimit: 1
|
||||
8
deploy/k8s/sample-tracking/google-oauth.yaml
Normal file
8
deploy/k8s/sample-tracking/google-oauth.yaml
Normal file
@@ -0,0 +1,8 @@
|
||||
apiVersion: v1
|
||||
kind: Secret
|
||||
metadata:
|
||||
name: google-oauth
|
||||
type: Opaque
|
||||
data:
|
||||
id: ${B64_OAUTH_CLIENT_ID}
|
||||
secret: ${B64_OAUTH_CLIENT_SECRET}
|
||||
7
deploy/k8s/sample-tracking/sendgrid-api.yaml
Normal file
7
deploy/k8s/sample-tracking/sendgrid-api.yaml
Normal file
@@ -0,0 +1,7 @@
|
||||
apiVersion: v1
|
||||
kind: Secret
|
||||
metadata:
|
||||
name: sendgrid-api
|
||||
type: Opaque
|
||||
data:
|
||||
key: ${B64_SENDGRID_API}
|
||||
13
dev.cljs.edn
Normal file
13
dev.cljs.edn
Normal file
@@ -0,0 +1,13 @@
|
||||
^{:watch-dirs ["src/cljs"]
|
||||
:css-dirs ["resources/public/css"]
|
||||
:npm {:bundles {"dist/index.bundle.js" "src/js/index.js"}}
|
||||
:ring-handler org.parkerici.sample-tracking.handler/app
|
||||
;; Open a static page that doesn't load from DB or else we'll error. Can remove once we add components.
|
||||
:open-url "http://[[server-hostname]]:[[server-port]]/auth/log-in"
|
||||
:cljs-devtools true}
|
||||
{:main org.parkerici.sample-tracking.core
|
||||
:closure-defines {"re_frame.trace.trace_enabled_QMARK_" true}
|
||||
:preloads [day8.re-frame-10x.preload]
|
||||
:npm-deps false
|
||||
:infer-externs true
|
||||
:output-to "resources/public/cljs-out/main.js"}
|
||||
52
dev/user.clj
Normal file
52
dev/user.clj
Normal file
@@ -0,0 +1,52 @@
|
||||
(ns user
|
||||
(:require [figwheel.main.api :as fig]
|
||||
[org.parkerici.sample-tracking.api.export :as export]
|
||||
[org.parkerici.sample-tracking.api.iam :as auth]
|
||||
[org.parkerici.sample-tracking.configuration :as c]
|
||||
[org.parkerici.sample-tracking.db.datomic :as db-d]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.schema :as schema]
|
||||
[org.parkerici.sample-tracking.db.site :as site-db]
|
||||
[org.parkerici.sample-tracking.server :as server])
|
||||
(:import (java.util UUID)))
|
||||
|
||||
(defn string->stream
|
||||
([s] (string->stream s "UTF-8"))
|
||||
([s encoding]
|
||||
(-> s
|
||||
(.getBytes encoding)
|
||||
(java.io.ByteArrayInputStream.))))
|
||||
|
||||
(comment
|
||||
:transact-schema
|
||||
(schema/transact-schema))
|
||||
|
||||
(comment
|
||||
:add-admin
|
||||
(db-d/wrap-datomic-fn #(doall (map auth/find-or-create-role (c/application-role-values))))
|
||||
(db-d/wrap-datomic-fn #(auth/add-role-to-user "rschiemann@parkerici.org" (c/application-admin-role))))
|
||||
|
||||
(comment
|
||||
:test-db-methods
|
||||
(clojure.pprint/pprint (db-d/wrap-datomic-fn #(site-db/list-study-tuples)))
|
||||
(clojure.pprint/pprint (db-d/wrap-datomic-fn #(site-db/list-all-sites)))
|
||||
(clojure.pprint/pprint (db-d/wrap-datomic-fn #(kit-type-db/find-active-kit-type-by-name-and-cohort "Blood Sample Collection Kit" (UUID/fromString "5fab14f6-f01c-4f96-bfd1-1b5629fccf17"))))
|
||||
)
|
||||
|
||||
(comment
|
||||
:test-export
|
||||
(clojure.pprint/pprint (db-d/wrap-datomic-fn #(export/get-samples-for-export {}))))
|
||||
|
||||
|
||||
(comment
|
||||
:figwheel
|
||||
; Starts figwheel and attempts to launch a repl. Use the below command if piggyback fails.
|
||||
(fig/start "dev")
|
||||
; Starts figwheel without launching a repl
|
||||
(fig/start {:mode :serve} "dev")
|
||||
(fig/stop "dev"))
|
||||
|
||||
(comment
|
||||
:server-start-stop
|
||||
(server/start 5526)
|
||||
(server/stop))
|
||||
62
docs/console.md
Normal file
62
docs/console.md
Normal file
@@ -0,0 +1,62 @@
|
||||
# eReq Admin Console
|
||||
|
||||
Most of the administrative tasks for eReq are performed from the admin console. The admin console can be accessed by
|
||||
clicking the link that says `Login` in the top right hand corner of the main page. If you are logged in this link will
|
||||
change from `Login` to `Console`.
|
||||
|
||||
## Kit Shipment Form
|
||||
|
||||
This link will take you to the main kit shipment form page that users at sites will have access to.
|
||||
|
||||
## List Kits
|
||||
|
||||
The list kits page allows you to list and filter all kits that have been submitted through the kit shipment form. It
|
||||
also allows you to export all kits or the filtered kits with all associated metadata to a CSV.
|
||||
|
||||
From this page you can filter on complete, incomplete, or archived kits. Complete kits are kit forms that were
|
||||
successfully submitted by a user. Incomplete kits are kit forms that were shared but have not yet been submitted.
|
||||
Archived kits are kits that were archived by an administrator (usually due to accidental or duplicate submission).
|
||||
|
||||
Each entry in the list of kits has a link for `View Kit`, `Edit Kit`, and `History`. `View Kit` will show you a
|
||||
read-only version of the form that was submitted for that kit. `Edit Kit` will show you a page where you can edit or
|
||||
archive the kit. `History` will show you the history of any modifications that were made to that kit.
|
||||
|
||||
## Audit History
|
||||
|
||||
The audit history page gives you a list of all changes that have been made to any entities in the eReq system. If you
|
||||
want to focus on one entity (e.g. a submitted kit or a study) you can click on the link under the `Entity UUID` column
|
||||
for that piece of content.
|
||||
|
||||
## List Types
|
||||
|
||||
The list types page allows you to list all of the types (e.g. studies, sites, cohorts, kits) that are in eReq and are
|
||||
used to populate the kit shipment form.
|
||||
|
||||
From this page you also have the ability to make minor edits to types. You can use this in the case that a mistake was
|
||||
made when uploading types (e.g. a misspelled study) or if something was changed (e.g. a site's name changes). **Note:**
|
||||
any edits made from this page will immediately apply to any kits submitted with the original values.
|
||||
|
||||
More complicated edits should be made by marking the entities that need to be edited as inactive and then uploading new
|
||||
type CSVs on the upload type data page for the edited entities. You can mark an entity as inactive by finding it on the
|
||||
list types page and then unchecking the `Active` checkbox in the edit types section.
|
||||
|
||||
## Upload Type Data
|
||||
|
||||
New kit types, sites, studies, and form types (custom form questions) can be uploaded from the upload type data page.
|
||||
|
||||
You can read more about the process around creating and uploading new type files on
|
||||
the [New Form Creation page](forms.md).
|
||||
|
||||
## User List
|
||||
|
||||
The user list page allows you to give new users access to the admin console. All users must have an `@parkerici.org`
|
||||
email address.
|
||||
|
||||
There are three roles that a user can be assigned: viewer, editor, and administrator. Viewers can view and export
|
||||
content, but cannot edit anything. Editors can view, export, and edit any content in the system, but cannot upload new
|
||||
forms through the upload type data page. Administrators can perform all tasks on the admin console.
|
||||
|
||||
## Configuration List
|
||||
|
||||
The configuration list page lists important configuration settings for the eReq system. This is so that you can check
|
||||
and confirm that the system is configured as expected in case you encounter any issues or errors.
|
||||
32
docs/forms.md
Normal file
32
docs/forms.md
Normal file
@@ -0,0 +1,32 @@
|
||||
# New Form Creation
|
||||
|
||||
Currently new form creation is a bit of an involved and painful process. It occurs infrequently enough (1 - 2x a year) that we haven't put effort into improving the process, although this may change in the future.
|
||||
|
||||
## Example Form Files
|
||||
The current production form files can be found under the path `test/resources/forms`. You can use these as examples for creating new form files.
|
||||
|
||||
## Form Creation and Testing Process
|
||||
eReq/Sample Tracking was an application requested by and built for Research Ops. They are responsible for creating and testing all new forms. As of the writing of this document Mike Gricoski is the point person on Research Ops for creating and testing forms.
|
||||
|
||||
The first step in the process of creating new forms is to have Research Ops create the new form files and send them to you. Once you have the files you should start running a local eReq instance and then upload the files from the `Upload Type Data` page in the console.
|
||||
|
||||
Assuming that the new form files upload successfully, it is usually best to hop on a short call with the point person to confirm that everything looks as expected. If it looks as expected, you can navigate to `https://dev-ereq.parkerici.org/` and upload the new files there. If it doesn't look as expected you may have to delete and recreate your local database a few times until the files are right.
|
||||
|
||||
Once the files have been uploaded to dev it's time to have a UAT meeting with all of Research Ops. This meeting serves two purposes. First, it makes sure that everyone on Research Ops agrees with the contents of the new forms. Second, it makes sure that the new forms function as expected. If the forms pass UAT, they can be uploaded to `https://ereq.parkerici.org/` If they don't, you may have to delete and recreate the dev database (this is described in the main README and is part of why this can be a pain).
|
||||
|
||||
## Production Form Files
|
||||
Production form files can be found under the path `test/resources/forms`. When new forms are added to production a new folder should be created for them under this path and they should be added to that folder.
|
||||
|
||||
In addition you should edit the command `test-setup` in the file at `src/clj/org/parkerici/sample_tracking/cli.clj` to account for the new form files. You will also need to update the appropriate tests under the path `test/clj/org/parkerici/sample_tracking` to account for the new form options.
|
||||
|
||||
## Editing Production Forms
|
||||
Basic editing of production forms is available through the `List Types` page in the console.
|
||||
|
||||
If you need more advanced editing than is available on the `List Types` page you will need mark the form as inactive (this can also be done through the `List Types` page) and then upload new form files with the appropriate edits.
|
||||
|
||||
## Process Improvements
|
||||
There are a few points at which this process could be improved.
|
||||
|
||||
First, there should be an easier way than recreating the database to delete form types in the local and dev environments. If this functionality is built it is important that form types cannot be deleted in production.
|
||||
|
||||
Second, it would be a nicer process if there was a way to promote forms from dev to production and to make any necessary edits through a UI in dev before promoting to production.
|
||||
30
figwheel-main.edn
Normal file
30
figwheel-main.edn
Normal file
@@ -0,0 +1,30 @@
|
||||
;; Figwheel-main configuration options see: https://figwheel.org/config-options
|
||||
;; these will be overriden by the metadata config options in dev.cljs.edn build file
|
||||
{;; Set the server port https://figwheel.org/config-options#ring-server-options
|
||||
;; :ring-server-options {:port 9500}
|
||||
|
||||
;; Change the target directory from the "target" to "resources"
|
||||
;; https://figwheel.org/config-options#target-dir
|
||||
:target-dir "resources"
|
||||
|
||||
;; Server Ring Handler (optional) https://figwheel.org/docs/ring-handler.html
|
||||
;; If you want to embed a ring handler into the figwheel server, this
|
||||
;; is for simple ring servers
|
||||
;; :ring-handler hello_world.server/handler
|
||||
|
||||
;; To be able to open files in your editor from the heads up display
|
||||
;; you will need to put a script on your path. This script will have
|
||||
;; to take a file path and a line number ie.
|
||||
;; in ~/bin/myfile-opener:
|
||||
;;
|
||||
;; #! /bin/sh
|
||||
;; emacsclient -n +$2:$3 $1
|
||||
;;
|
||||
;; :open-file-command "myfile-opener"
|
||||
|
||||
;; if you are using emacsclient you can just use
|
||||
;; :open-file-command "emacsclient"
|
||||
|
||||
;; Logging output gets printed to the REPL, if you want to redirect it to a file:
|
||||
;; :log-file "figwheel-main.log"
|
||||
}
|
||||
5264
package-lock.json
generated
Normal file
5264
package-lock.json
generated
Normal file
File diff suppressed because it is too large
Load Diff
43
package.json
Normal file
43
package.json
Normal file
@@ -0,0 +1,43 @@
|
||||
{
|
||||
"name": "sample-tracking",
|
||||
"version": "0.2.0",
|
||||
"description": "JS Dependencies for sample-tracking application",
|
||||
"main": "index.js",
|
||||
"directories": {
|
||||
"test": "test"
|
||||
},
|
||||
"scripts": {
|
||||
"test": "echo \"Error: no test specified\" && exit 1",
|
||||
"build": "webpack"
|
||||
},
|
||||
"repository": {
|
||||
"type": "git",
|
||||
"url": "git+https://github.com/ParkerICI/sample-tracking.git"
|
||||
},
|
||||
"keywords": [],
|
||||
"author": "",
|
||||
"license": "ISC",
|
||||
"bugs": {
|
||||
"url": "https://github.com/ParkerICI/sample-tracking/issues"
|
||||
},
|
||||
"homepage": "https://github.com/ParkerICI/sample-tracking#readme",
|
||||
"dependencies": {
|
||||
"@blueprintjs/datetime": "^3.19.3",
|
||||
"css-loader": "^3.6.0",
|
||||
"dayjs": "^1.9.4",
|
||||
"firebase": "^8.10.0",
|
||||
"firebaseui": "^5.0.0",
|
||||
"react": "^16.12.0",
|
||||
"react-dom": "^16.12.0",
|
||||
"react-editext": "^3.17.1",
|
||||
"react-firebaseui": "^5.0.2",
|
||||
"react-input-checkbox": "^0.1.6",
|
||||
"react-select": "^3.1.0",
|
||||
"reactstrap": "^8.6.0",
|
||||
"style-loader": "^1.2.1"
|
||||
},
|
||||
"devDependencies": {
|
||||
"webpack": "^4.44.2",
|
||||
"webpack-cli": "^3.3.12"
|
||||
}
|
||||
}
|
||||
11
prod.cljs.edn
Normal file
11
prod.cljs.edn
Normal file
@@ -0,0 +1,11 @@
|
||||
^{:watch-dirs ["src/cljs"]
|
||||
:css-dirs ["resources/public/css"]
|
||||
:npm {:bundles {"dist/index.bundle.js" "src/js/index.js"}}
|
||||
:ring-handler org.parkerici.sample-tracking.handler/app
|
||||
;; Open a static page that doesn't load from DB or else we'll error. Can remove once we add components.
|
||||
:open-url "http://[[server-hostname]]:[[server-port]]/auth/log-in"
|
||||
:cljs-devtools false}
|
||||
{:main org.parkerici.sample-tracking.core
|
||||
:closure-defines {"re_frame.trace.trace_enabled_QMARK_" true}
|
||||
:npm-deps false
|
||||
:output-to "resources/public/cljs-out/main.js"}
|
||||
121
project.clj
Executable file
121
project.clj
Executable file
@@ -0,0 +1,121 @@
|
||||
(defproject sample-tracking "0.2.1"
|
||||
:dependencies [[aero "1.1.6"]
|
||||
[bidi "2.1.6"]
|
||||
[bk/ring-gzip "0.3.0"]
|
||||
[buddy/buddy-auth "3.0.1"]
|
||||
[clj-commons/pushy "0.3.10"]
|
||||
[clj-htmltopdf "0.2"]
|
||||
[cheshire "5.10.1"]
|
||||
[clojure.java-time "0.3.3"]
|
||||
[cljs-ajax "0.8.4"]
|
||||
[madvas/cemerick-url "0.1.2"]
|
||||
[cljsjs/firebase "7.5.0-0"]
|
||||
[com.datomic/client-pro "0.9.63"
|
||||
:exclusions [org.eclipse.jetty/jetty-client
|
||||
org.eclipse.jetty/jetty-http
|
||||
org.eclipse.jetty/jetty-util]]
|
||||
[com.google.firebase/firebase-admin "8.1.0"]
|
||||
[com.google.guava/guava "31.0.1-jre"]
|
||||
[com.sendgrid/sendgrid-java "2.2.2"]
|
||||
[com.taoensso/timbre "5.1.2"]
|
||||
[commons-codec/commons-codec "1.15"]
|
||||
[compojure "1.6.2"]
|
||||
[day8.re-frame/http-fx "0.2.4"]
|
||||
[hiccup "1.0.5"]
|
||||
[http-kit "2.5.3"]
|
||||
[listora/again "1.0.0"]
|
||||
[ns-tracker "0.4.0"]
|
||||
[org.apache.httpcomponents/httpclient "4.5.13"]
|
||||
[org.clojure/clojure "1.10.3"]
|
||||
[org.clojure/clojurescript "1.11.4"]
|
||||
[org.clojure/data.csv "1.0.0"]
|
||||
[org.clojure/tools.cli "1.0.206"]
|
||||
[org.eclipse.jetty/jetty-server "9.4.12.v20180830"]
|
||||
[org.eclipse.jetty/jetty-client "9.4.12.v20180830"]
|
||||
[org.eclipse.jetty/jetty-http "9.4.12.v20180830"]
|
||||
[org.eclipse.jetty/jetty-util "9.4.12.v20180830"]
|
||||
[org.eclipse.jetty.websocket/websocket-servlet "9.4.12.v20180830"]
|
||||
[org.eclipse.jetty.websocket/websocket-server "9.4.12.v20180830"]
|
||||
[org.parkerici/alzabo "0.2.7"]
|
||||
[org.parkerici/multitool "0.0.18"]
|
||||
[org.slf4j/slf4j-simple "1.7.32"] ;required to turn off warning
|
||||
[reagent "0.10.0"]
|
||||
[re-frame "1.2.0"]
|
||||
[ring "1.8.0"]
|
||||
[ring/ring-defaults "0.3.3"]
|
||||
[ring/ring-jetty-adapter "1.7.1"]
|
||||
[ring-logger "1.0.1"]
|
||||
[ring-middleware-format "0.7.4"]
|
||||
[trptcolin/versioneer "0.2.0"]]
|
||||
|
||||
:repositories [["github" {:url "https://maven.pkg.github.com/ParkerICI/mvn-packages"
|
||||
:sign-releases false
|
||||
:username :env/github_user
|
||||
:password :env/github_password}]]
|
||||
|
||||
:ring {:handler org.parkerici.sample-tracking.handler/app}
|
||||
|
||||
:plugins [[lein-cljsbuild "1.1.7"]
|
||||
[lein-ring "0.12.6"]]
|
||||
|
||||
:min-lein-version "2.5.3"
|
||||
|
||||
:source-paths ["src/cljs" "src/cljc" "src/clj"]
|
||||
:test-paths ["test/clj"]
|
||||
|
||||
:target-dir "target"
|
||||
|
||||
:resource-paths ["resources" "test/resources"]
|
||||
|
||||
:clean-targets ^{:protect false} ["target" "resources/public/cljs-out"]
|
||||
|
||||
:aliases {"cli" ["with-profile" "cli" "run"]
|
||||
"fig" ["trampoline" "run" "-m" "figwheel.main"]
|
||||
"fig:build" ["trampoline" "run" "-m" "figwheel.main" "-b" "dev" "-r"]
|
||||
"fig:build-min" ["trampoline" "run" "-m" "figwheel.main" "-O" "advanced" "-bo" "prod" "-s"]
|
||||
"fig:min" ["run" "-m" "figwheel.main" "-O" "advanced" "-bo" "prod"]
|
||||
"fig:test" ["run" "-m" "figwheel.main" "-co" "test.cljs.edn" "-m" "hello-figwheel-main.test-runner"]
|
||||
"package" ["do" "clean" ["fig:min"] ["uberjar"]]}
|
||||
|
||||
:profiles
|
||||
{:cli
|
||||
{:main org.parkerici.sample-tracking.cli
|
||||
:source-paths ["src/clj"]}
|
||||
|
||||
:test
|
||||
{:dependencies [[ring/ring-mock "0.4.0"]]
|
||||
:env {:datomic-endpoint "localhost:9119"
|
||||
:datomic-db-name "ereq-test"
|
||||
:send-manifest-emails "false"}}
|
||||
|
||||
:dev
|
||||
{:source-paths ["src/clj" "src/cljc" "src/cljs" "dev"]
|
||||
:nrepl-middleware ["cider.nrepl/cider-middleware"
|
||||
"refactor-nrepl.middleware/wrap-refactor"
|
||||
"cider.piggieback/wrap-cljs-repl"]
|
||||
:dependencies [[binaryage/devtools "1.0.4"]
|
||||
[cider/piggieback "0.5.3"]
|
||||
[com.bhauman/figwheel-main "0.2.15"
|
||||
:exclusions [org.eclipse.jetty.websocket/websocket-servlet
|
||||
org.eclipse.jetty.websocket/websocket-server]]
|
||||
[com.bhauman/rebel-readline-cljs "0.1.4"]
|
||||
[day8.re-frame/tracing "0.6.2"]
|
||||
[day8.re-frame/re-frame-10x "1.2.1"]]}
|
||||
|
||||
|
||||
:uberjar
|
||||
{:dependencies [[com.bhauman/figwheel-main "0.2.15"
|
||||
:exclusions [org.eclipse.jetty.websocket/websocket-servlet
|
||||
org.eclipse.jetty.websocket/websocket-server]]
|
||||
[com.bhauman/rebel-readline-cljs "0.1.4"]]
|
||||
:omit-source true
|
||||
:cljs-devtools false
|
||||
:jar-name "sample-tracking.jar"
|
||||
:uberjar-name "sample-tracking-standalone.jar"
|
||||
:clean-targets ^:replace ["target"]
|
||||
:resource-paths ^:replace ["resources"]
|
||||
:main ^:skip-aot org.parkerici.sample-tracking.cli
|
||||
:aot :all}}
|
||||
|
||||
:main org.parkerici.sample-tracking.cli
|
||||
:aot [org.parkerici.sample-tracking.cli])
|
||||
2
resources/config.edn
Normal file
2
resources/config.edn
Normal file
@@ -0,0 +1,2 @@
|
||||
{:datomic #include "config/datomic.edn"
|
||||
:application #include "config/application.edn"}
|
||||
65
resources/config/application.edn
Normal file
65
resources/config/application.edn
Normal file
@@ -0,0 +1,65 @@
|
||||
{:roles {:admin "administrator"
|
||||
:editor "editor"
|
||||
:viewer "viewer"
|
||||
:site-admin "site-admin"
|
||||
:site-coordinator "site-coordinator"}
|
||||
:email {:sendgrid-api-key #env SENDGRID_API_KEY
|
||||
:sender #env MANIFEST_EMAIL_SENDER
|
||||
:manifest-recipient #env MANIFEST_EMAIL_RECIPIENT
|
||||
:send-manifest-emails #or [#env SEND_MANIFEST_EMAILS "false"]
|
||||
:send-vendor-emails #or [#env SEND_VENDOR_EMAILS "false"]}
|
||||
:temp-path "/tmp"
|
||||
:api-key #env API_KEY
|
||||
:firebase-js-credentials-path #env FIREBASE_JS_APPLICATION_CREDENTIALS
|
||||
:csv-files {:form-type {:headers [:form-type-fields
|
||||
:form-type-name
|
||||
:kit-item-no]}
|
||||
:kit-type {:headers [:study-name
|
||||
:cohort-name
|
||||
:kit-item-no
|
||||
:kit-name
|
||||
:sample-id-suffix
|
||||
:sample-name
|
||||
:kit-timepoints
|
||||
:ships-with-kit
|
||||
:sample-reminders
|
||||
:vendor-email
|
||||
:collection-date-optional
|
||||
:air-waybill-optional]}
|
||||
:site {:headers [:site
|
||||
:study-names]}
|
||||
:study {:headers [:study
|
||||
:participant-id-prefix
|
||||
:participant-id-regex
|
||||
:participant-id-validation-message
|
||||
:kit-id-prefix
|
||||
:kit-id-regex
|
||||
:kit-id-validation-message]}}
|
||||
:sample-export {:columns-to-drop [:kit-uuid :timezone :complete :deleted :sample-type-uuid
|
||||
:kit-type-uuid]
|
||||
:column-order [:study-name
|
||||
:site-name
|
||||
"Bioinventory Group Name"
|
||||
:sample-id
|
||||
:participant-id
|
||||
:timepoints
|
||||
"PK Timepoint"
|
||||
:collection-date
|
||||
:collection-time
|
||||
"processing-time"
|
||||
:sample-type-name
|
||||
:air-waybill
|
||||
:kit-type-name
|
||||
:kit-id]
|
||||
:columns-to-rename {:study-name "BioInventory Project Name"
|
||||
:site-name "Site"
|
||||
:sample-id "Originating ID"
|
||||
:participant-id "Participant ID"
|
||||
:timepoints "Visit"
|
||||
:collection-date "Collection Date"
|
||||
:collection-time "Collection Time"
|
||||
"processing-time" "Processing Time"
|
||||
:sample-type-name "Sample"
|
||||
:air-waybill "Air Waybill"
|
||||
:kit-type-name "Kit"
|
||||
:kit-id "Kit ID"}}}
|
||||
7
resources/config/datomic.edn
Normal file
7
resources/config/datomic.edn
Normal file
@@ -0,0 +1,7 @@
|
||||
{:endpoint #or [#env DATOMIC_ENDPOINT "localhost:8998"]
|
||||
:access-key #or [#env DATOMIC_ACCESS_KEY "myaccesskey"]
|
||||
:secret #or [#env DATOMIC_SECRET "mysecret"]
|
||||
:db-name #or [#env DATOMIC_DB_NAME "ereq-dev"]
|
||||
:validate-hostnames #profile {:default false
|
||||
:staging false
|
||||
:production false}}
|
||||
6
resources/log4j.properties
Executable file
6
resources/log4j.properties
Executable file
@@ -0,0 +1,6 @@
|
||||
log4j.rootLogger=WARN, console
|
||||
log4j.appender.console=org.apache.log4j.ConsoleAppender
|
||||
log4j.appender.console.layout=org.apache.log4j.PatternLayout
|
||||
log4j.appender.console.layout.ConversionPattern=%-5p %c: %m%n
|
||||
|
||||
log4j.logger.org.eclipse.jetty=WARN
|
||||
23
resources/logback.xml
Executable file
23
resources/logback.xml
Executable file
@@ -0,0 +1,23 @@
|
||||
<!-- Logback configuration. See http://logback.qos.ch/manual/index.html -->
|
||||
<configuration>
|
||||
<!-- Console output -->
|
||||
<appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
|
||||
<!-- encoder defaults to ch.qos.logback.classic.encoder.PatternLayoutEncoder -->
|
||||
<encoder>
|
||||
<pattern>%-5level %logger{36} - %msg%n</pattern>
|
||||
</encoder>
|
||||
<!-- Only log level INFO and above -->
|
||||
<filter class="ch.qos.logback.classic.filter.ThresholdFilter">
|
||||
<level>INFO</level>
|
||||
</filter>
|
||||
</appender>
|
||||
|
||||
<!-- Enable FILE and STDOUT appenders for all log messages.
|
||||
By default, only log at level INFO and above. -->
|
||||
<root level="WARN">
|
||||
<appender-ref ref="STDOUT" />
|
||||
</root>
|
||||
|
||||
<!-- For loggers in the ".*" namespace, log at all levels. -->
|
||||
<logger name="starter" level="INFO" />
|
||||
</configuration>
|
||||
345
resources/public/css/app.css
Executable file
345
resources/public/css/app.css
Executable file
@@ -0,0 +1,345 @@
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk';
|
||||
src: url('fonts/PxGrotesk-Bold.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-Bold.woff') format('woff');
|
||||
font-weight: bold;
|
||||
font-style: normal;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk';
|
||||
src: url('fonts/PxGrotesk-BoldIta.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-BoldIta.woff') format('woff');
|
||||
font-weight: bold;
|
||||
font-style: italic;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk';
|
||||
src: url('fonts/PxGrotesk-Light.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-Light.woff') format('woff');
|
||||
font-weight: 300;
|
||||
font-style: normal;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk';
|
||||
src: url('fonts/PxGrotesk-Regular.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-Regular.woff') format('woff');
|
||||
font-weight: normal;
|
||||
font-style: normal;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk';
|
||||
src: url('fonts/PxGrotesk-LightIta.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-LightIta.woff') format('woff');
|
||||
font-weight: 300;
|
||||
font-style: italic;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk';
|
||||
src: url('fonts/PxGrotesk-RegularIta.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-RegularIta.woff') format('woff');
|
||||
font-weight: normal;
|
||||
font-style: italic;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
@font-face {
|
||||
font-family: 'Px Grotesk Screen';
|
||||
src: url('fonts/PxGrotesk-Screen.woff2') format('woff2'),
|
||||
url('fonts/PxGrotesk-Screen.woff') format('woff');
|
||||
font-weight: normal;
|
||||
font-style: normal;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
*{font-family:'Px Grotesk';}
|
||||
|
||||
body {
|
||||
background-color: black;
|
||||
font-size: 1rem!important;
|
||||
}
|
||||
|
||||
.main {
|
||||
text-align: center;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.header {
|
||||
margin: 0px auto;
|
||||
padding: 5px;
|
||||
background: #343a40!important;
|
||||
color: white;
|
||||
font-size: 20px;
|
||||
}
|
||||
|
||||
.header.manifest {
|
||||
background: white!important;
|
||||
color: black;
|
||||
}
|
||||
|
||||
|
||||
.header .content {
|
||||
text-align: left;
|
||||
top: 16px;
|
||||
left: 16px;
|
||||
}
|
||||
|
||||
.header .content .title {
|
||||
display: inline-block;
|
||||
}
|
||||
|
||||
.header .content .log-in-out-link {
|
||||
float: right;
|
||||
}
|
||||
|
||||
.header .content .console-link {
|
||||
float: right;
|
||||
clear: right;
|
||||
}
|
||||
|
||||
.header .bars {
|
||||
text-align: left;
|
||||
left: 16px;
|
||||
}
|
||||
|
||||
.page-body {
|
||||
padding: 10px;
|
||||
text-align: center;
|
||||
max-width: 1000px;
|
||||
margin: auto;
|
||||
color: white;
|
||||
}
|
||||
|
||||
.page-body.manifest {
|
||||
padding: 10px;
|
||||
text-align: center;
|
||||
max-width: 1000px;
|
||||
margin: auto;
|
||||
color: black;
|
||||
}
|
||||
|
||||
.page-body table {
|
||||
text-align: left;
|
||||
margin-bottom: .5em;
|
||||
}
|
||||
|
||||
.list-body {
|
||||
padding: 10px;
|
||||
text-align: center;
|
||||
max-width: 1500px;
|
||||
margin: auto;
|
||||
color: white;
|
||||
}
|
||||
|
||||
.list-body table {
|
||||
text-align: left;
|
||||
margin-bottom: .5em;
|
||||
border-collapse: separate;
|
||||
border-spacing: 10px 5px;
|
||||
}
|
||||
|
||||
div.spacer {
|
||||
display: inline-block;
|
||||
width: 5px;
|
||||
}
|
||||
|
||||
/* Apply style colors to a links */
|
||||
a {
|
||||
color: #685bc7!important;
|
||||
}
|
||||
|
||||
a:hover {
|
||||
color: #4a4c9b!important;
|
||||
}
|
||||
|
||||
a:active {
|
||||
color: #313377!important;
|
||||
}
|
||||
|
||||
a.disabled {
|
||||
color: #a197e6!important;
|
||||
pointer-events: none;
|
||||
cursor: default;
|
||||
}
|
||||
|
||||
/* Apply theme colors to reactstrap elements */
|
||||
.btn-secondary {
|
||||
background-color: #685bc7;
|
||||
border-color: #685bc7;
|
||||
}
|
||||
|
||||
.btn-secondary:hover {
|
||||
background-color: #4a4c9b;
|
||||
border-color: #4a4c9b;
|
||||
}
|
||||
|
||||
.btn-secondary:active {
|
||||
background-color: #313377;
|
||||
border-color: #313377;
|
||||
}
|
||||
|
||||
.btn-secondary:focus {
|
||||
background-color: #313377;
|
||||
border-color: #313377;
|
||||
}
|
||||
|
||||
.btn-secondary:not(:disabled):not(.disabled):active {
|
||||
background-color: #313377;
|
||||
border-color: #313377;
|
||||
}
|
||||
|
||||
.btn-secondary.disabled,
|
||||
.btn-secondary:disabled {
|
||||
background-color: #a197e6;
|
||||
border-color: #a197e6;
|
||||
}
|
||||
|
||||
/* Make React Select Menu List items have black font */
|
||||
|
||||
.react-select__menu-list {
|
||||
color: black!important;
|
||||
}
|
||||
|
||||
/* Disable red box outline in Firefox */
|
||||
input:required {
|
||||
box-shadow:none!important;
|
||||
}
|
||||
input:invalid {
|
||||
box-shadow:none!important;
|
||||
}
|
||||
|
||||
select[name=amPm] {
|
||||
box-shadow:none!important;
|
||||
}
|
||||
|
||||
/* Blueprint Styling */
|
||||
|
||||
.bp3-input {
|
||||
font-size: 1rem!important;
|
||||
}
|
||||
|
||||
/* Editext Styling */
|
||||
|
||||
button[editext] {
|
||||
border-radius: .25rem;
|
||||
padding: 2px;
|
||||
background-color: #685bc7;
|
||||
border-color: #685bc7;
|
||||
color: white;
|
||||
}
|
||||
|
||||
button[editext]:hover {
|
||||
background-color: #4a4c9b;
|
||||
border-color: #4a4c9b;
|
||||
}
|
||||
|
||||
button[editext="input"] {
|
||||
width: auto!important;
|
||||
}
|
||||
|
||||
/* Tooltip styling */
|
||||
.tooltip-inner {
|
||||
background: #343a40!important;
|
||||
}
|
||||
|
||||
.bs-tooltip-auto[x-placement^=top] .arrow::before, .bs-tooltip-top .arrow::before {
|
||||
border-top-color: #343a40!important;
|
||||
}
|
||||
|
||||
/* Datetime picker */
|
||||
.react-datetime-picker__wrapper {
|
||||
background: white;
|
||||
border: 0;
|
||||
border-radius: .25rem;
|
||||
font-size: 1.25em;
|
||||
color: black;
|
||||
}
|
||||
|
||||
.react-datetime-picker__inputGroup__input {
|
||||
color: black!important;
|
||||
}
|
||||
|
||||
.react-datetime-picker__inputGroup__input:invalid {
|
||||
background: none!important;
|
||||
}
|
||||
|
||||
/* Checkbox stuff */
|
||||
|
||||
.Checkbox_themed {
|
||||
padding-left: 1.2em;
|
||||
}
|
||||
|
||||
.Checkbox__input_themed {
|
||||
position: absolute;
|
||||
width: 1px;
|
||||
height: 1px;
|
||||
|
||||
overflow: hidden;
|
||||
clip: rect(0 0 0 0);
|
||||
|
||||
-webkit-appearance: none;
|
||||
-moz-appearance: none;
|
||||
appearance: none;
|
||||
}
|
||||
|
||||
.Checkbox__image_themed {
|
||||
position: absolute;
|
||||
margin-left: -1.2em;
|
||||
width: 1em;
|
||||
height: 1em;
|
||||
}
|
||||
|
||||
.bootstrap-checkbox {
|
||||
padding-left: 1.5rem;
|
||||
margin-bottom: 1em;
|
||||
}
|
||||
|
||||
.bootstrap-checkbox__image {
|
||||
margin-left: -1.5rem;
|
||||
|
||||
border: #adb5bd solid 1px;
|
||||
border-radius: .25rem;
|
||||
|
||||
background-color: #fff;
|
||||
|
||||
transition: background-color .15s ease-in-out,border-color .15s ease-in-out,box-shadow .15s ease-in-out;
|
||||
}
|
||||
.bootstrap-checkbox__input:checked + .bootstrap-checkbox__image {
|
||||
border-color: #564bac;
|
||||
background: #685bc7 url(data:image/svg+xml;base64,PHN2ZyB4bWxucz0naHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmcnIHZpZXdCb3g9JzAgMCA4IDgnPjxwYXRoIGZpbGw9JyNmZmYnIGQ9J002LjU2NC43NWwtMy41OSAzLjYxMi0xLjUzOC0xLjU1TDAgNC4yNiAyLjk3NCA3LjI1IDggMi4xOTN6Jy8+PC9zdmc+) no-repeat 50%/50% 50%;
|
||||
}
|
||||
.bootstrap-checkbox__input_indeterminate + .bootstrap-checkbox__image {
|
||||
border-color: #5247a8;
|
||||
background: #685bc7 url("data:image/svg+xml,%3csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 4 4'%3e%3cpath stroke='%23fff' d='M0 2h4'/%3e%3c/svg%3e") no-repeat 50%/50% 50%;
|
||||
}
|
||||
.bootstrap-checkbox__input:disabled + .bootstrap-checkbox__image {
|
||||
border-color: #888c91;
|
||||
background-color: #b3b7bb;
|
||||
}
|
||||
.bootstrap-checkbox__input:checked:disabled + .bootstrap-checkbox__image,
|
||||
.bootstrap-checkbox__input_indeterminate:disabled + .bootstrap-checkbox__image {
|
||||
border-color: #8077c0;
|
||||
background-color: #a197e6;
|
||||
}
|
||||
.bootstrap-checkbox__input:focus + .bootstrap-checkbox__image {
|
||||
box-shadow: 0 0 0 0.2rem #776cbe;
|
||||
}
|
||||
|
||||
.bootstrap-checkbox__label {
|
||||
vertical-align: middle;
|
||||
}
|
||||
|
||||
/* Date picker stuff */
|
||||
|
||||
.bp3-datepicker .DayPicker-Day.DayPicker-Day--selected {
|
||||
background-color: #685bc7!important;
|
||||
}
|
||||
7
resources/public/css/bootstrap.min.css
vendored
Executable file
7
resources/public/css/bootstrap.min.css
vendored
Executable file
File diff suppressed because one or more lines are too long
1
resources/public/css/bootstrap.min.css.map
Executable file
1
resources/public/css/bootstrap.min.css.map
Executable file
File diff suppressed because one or more lines are too long
BIN
resources/public/css/fonts/PxGrotesk-Bold.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Bold.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Bold.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Bold.woff2
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-BoldIta.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-BoldIta.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-BoldIta.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-BoldIta.woff2
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Light.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Light.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Light.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Light.woff2
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-LightIta.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-LightIta.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-LightIta.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-LightIta.woff2
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Regular.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Regular.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Regular.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Regular.woff2
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-RegularIta.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-RegularIta.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-RegularIta.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-RegularIta.woff2
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Screen.woff
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Screen.woff
Normal file
Binary file not shown.
BIN
resources/public/css/fonts/PxGrotesk-Screen.woff2
Normal file
BIN
resources/public/css/fonts/PxGrotesk-Screen.woff2
Normal file
Binary file not shown.
BIN
resources/public/favicon-16x16.png
Normal file
BIN
resources/public/favicon-16x16.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 644 B |
BIN
resources/public/favicon-32x32.png
Normal file
BIN
resources/public/favicon-32x32.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 975 B |
BIN
resources/public/images/bars.png
Normal file
BIN
resources/public/images/bars.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
BIN
resources/public/images/logo_dark.png
Normal file
BIN
resources/public/images/logo_dark.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 4.3 KiB |
BIN
resources/public/images/logo_light.png
Normal file
BIN
resources/public/images/logo_light.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 4.0 KiB |
30
resources/public/index.html
Executable file
30
resources/public/index.html
Executable file
@@ -0,0 +1,30 @@
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport"
|
||||
content="width=device-width, initial-scale=1, shrink-to-fit=no">
|
||||
<meta name="description" content="">
|
||||
<meta name="author" content="">
|
||||
|
||||
<title>PICI Sample Tracking</title>
|
||||
|
||||
<!-- Bootstrap core CSS -->
|
||||
<link href="/css/bootstrap.min.css" rel="stylesheet">
|
||||
<link href="/css/app.css" rel="stylesheet">
|
||||
<link rel="icon" type="image/png" sizes="32x32" href="/favicon-32x32.png">
|
||||
<link rel="icon" type="image/png" sizes="16x16" href="/favicon-16x16.png">
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<main role="main" class="main">
|
||||
<div id="app"></div>
|
||||
</main>
|
||||
|
||||
<script src="/cljs-out/main.js" type="text/javascript"></script>
|
||||
<script>
|
||||
org.parkerici.sample_tracking.core.init();
|
||||
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
1
resources/schema.edn
Normal file
1
resources/schema.edn
Normal file
File diff suppressed because one or more lines are too long
411
src/clj/org/parkerici/sample_tracking/api.clj
Normal file
411
src/clj/org/parkerici/sample_tracking/api.clj
Normal file
@@ -0,0 +1,411 @@
|
||||
(ns org.parkerici.sample-tracking.api
|
||||
"The main interface for all of the API functionality that's available to users.
|
||||
Tries to loosely format responses according to Google's JSON style guide
|
||||
https://google.github.io/styleguide/jsoncstyleguide.xml
|
||||
Acceptable top level keys are :api-version, :data, and :error
|
||||
:error should be an object that should have the key :message with an error message string
|
||||
:data should be an object that may have the key :uuid or :items"
|
||||
(:require [cheshire.core :as json]
|
||||
[trptcolin.versioneer.core :as version]
|
||||
[org.parkerici.sample-tracking.utils.ring :as ring-utils]
|
||||
[org.parkerici.sample-tracking.db.study :as study-db]
|
||||
[org.parkerici.sample-tracking.db.site :as site-db]
|
||||
[org.parkerici.sample-tracking.db.cohort :as cohort-db]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.timepoint :as timepoint-db]
|
||||
[org.parkerici.sample-tracking.db.sample-type :as sample-type-db]
|
||||
[org.parkerici.sample-tracking.db.form-type :as form-type-db]
|
||||
[org.parkerici.sample-tracking.db.kit :as kit-db]
|
||||
[org.parkerici.sample-tracking.db.history :as history-db]
|
||||
[org.parkerici.sample-tracking.db.role :as role-db]
|
||||
[org.parkerici.sample-tracking.db.user :as user-db]
|
||||
[org.parkerici.sample-tracking.api.iam :as iam]
|
||||
[org.parkerici.sample-tracking.api.kit-type :as kit-type]
|
||||
[org.parkerici.sample-tracking.api.form-type :as form-type]
|
||||
[org.parkerici.sample-tracking.api.site :as site-api]
|
||||
[org.parkerici.sample-tracking.api.study :as study-api]
|
||||
[org.parkerici.sample-tracking.api.kit-shipment :as kit-shipment]
|
||||
[org.parkerici.sample-tracking.api.propose-kit-edits :as kit-edits]
|
||||
[org.parkerici.sample-tracking.api.export :as export]
|
||||
[org.parkerici.sample-tracking.api.firebase :as firebase]
|
||||
[org.parkerici.sample-tracking.configuration :as c]
|
||||
[org.parkerici.multitool.core :as multitool]
|
||||
[java-time :as time]
|
||||
[clojure.string :as str])
|
||||
(:import (java.util UUID)))
|
||||
|
||||
(defn api-response
|
||||
[data & {:keys [status] :or {status 200}}]
|
||||
(ring-utils/json-response data :status status))
|
||||
|
||||
(defn catch-error-response
|
||||
[to-try]
|
||||
(try
|
||||
(to-try)
|
||||
(api-response {})
|
||||
(catch Exception e (api-response {:error {:message (.getMessage e)} :status 400}))))
|
||||
|
||||
(defn parse-request
|
||||
[request]
|
||||
(json/parse-string (slurp (:body request)) true))
|
||||
|
||||
(defn api-version
|
||||
[]
|
||||
(api-response {:api-version (version/get-version "sample-tracking" "sample-tracking")}))
|
||||
|
||||
(defn parse-boolean-or-nil
|
||||
[value]
|
||||
(if (nil? value) nil (Boolean/valueOf value)))
|
||||
|
||||
(defn parse-uuid-or-nil
|
||||
[value]
|
||||
(if (nil? value) nil (UUID/fromString value)))
|
||||
|
||||
(defn first-uploaded-file-path
|
||||
[{:keys [multipart-params]}]
|
||||
(let [upload (first (vals multipart-params))]
|
||||
(:tempfile upload)))
|
||||
|
||||
(defn firebase-js-credentials
|
||||
[]
|
||||
(let [credentials-path (c/firebase-js-credentials-path)
|
||||
credentials (json/parse-string (slurp credentials-path) true)]
|
||||
(ring-utils/json-response credentials :status 200)))
|
||||
|
||||
(defn upload-kit-types
|
||||
[request]
|
||||
(let [path (first-uploaded-file-path request)]
|
||||
(catch-error-response #(kit-type/parse-kit-type-csv-and-save-to-db path))))
|
||||
|
||||
(defn upload-form-types
|
||||
[request]
|
||||
(let [path (first-uploaded-file-path request)]
|
||||
(catch-error-response #(form-type/parse-form-type-csv-and-save-to-db path))))
|
||||
|
||||
(defn upload-sites
|
||||
[request]
|
||||
(let [path (first-uploaded-file-path request)]
|
||||
(catch-error-response #(site-api/parse-site-csv-and-save-to-db path))))
|
||||
|
||||
(defn upload-studies
|
||||
[request]
|
||||
(let [path (first-uploaded-file-path request)]
|
||||
(catch-error-response #(study-api/parse-study-csv-and-save-to-db path))))
|
||||
|
||||
(defn list-studies
|
||||
[active]
|
||||
(api-response {:data {:items (sort-by :name (study-db/list-studies (parse-boolean-or-nil active)))}}))
|
||||
|
||||
(defn list-sites
|
||||
[study-uuid active]
|
||||
(api-response {:data {:items (sort-by :name (site-db/list-sites (parse-uuid-or-nil study-uuid) (parse-boolean-or-nil active)))}}))
|
||||
|
||||
(defn get-form-type-fields
|
||||
[kit-type-uuid]
|
||||
(api-response {:data {:items (form-type-db/get-form-type-fields (parse-uuid-or-nil kit-type-uuid))}}))
|
||||
|
||||
(defn list-cohorts
|
||||
[study-uuid active]
|
||||
(api-response {:data {:items (sort-by :name (cohort-db/list-cohorts (parse-uuid-or-nil study-uuid) (parse-boolean-or-nil active)))}}))
|
||||
|
||||
(defn list-timepoints
|
||||
[kit-type-uuid]
|
||||
(api-response {:data {:items (timepoint-db/list-sorted-kit-type-timepoints (parse-uuid-or-nil kit-type-uuid))}}))
|
||||
|
||||
(defn list-kit-types
|
||||
[cohort-uuid active]
|
||||
; If one timepoint is passed in we get it as a single number. If multiple are passed in we get a seq.
|
||||
; We need to make the results of either call uniform and parse the numbers into longs.
|
||||
(api-response {:data {:items (sort-by :name (kit-type-db/list-kit-types (parse-uuid-or-nil cohort-uuid) (parse-boolean-or-nil active)))}}))
|
||||
|
||||
(defn list-sample-types
|
||||
[kit-type-uuid]
|
||||
(api-response {:data {:items (sort-by :id-suffix (sample-type-db/list-sample-types (parse-uuid-or-nil kit-type-uuid)))}}))
|
||||
|
||||
(defn datomic-transaction-response
|
||||
[tx-results]
|
||||
(let [error-message (:cognitect.anomalies/message tx-results)]
|
||||
(if (nil? error-message)
|
||||
(api-response {})
|
||||
(api-response {:error {:message error-message}} :status 400))))
|
||||
|
||||
(defn update-with-history
|
||||
[request entity-type fetch-fn update-fn]
|
||||
(let [input (parse-request request)
|
||||
entity-uuid (parse-uuid-or-nil (:uuid input))
|
||||
current-entity (fetch-fn entity-uuid)
|
||||
results (update-fn input)
|
||||
updated-entity (fetch-fn entity-uuid)]
|
||||
(history-db/create-history (get-in request [:session :identity]) entity-type entity-uuid (str current-entity) (str updated-entity))
|
||||
(datomic-transaction-response results)))
|
||||
|
||||
(defn update-study
|
||||
[request]
|
||||
(update-with-history request :study study-db/find-study-by-uuid
|
||||
(fn [i] (study-db/update-study (parse-uuid-or-nil (:uuid i)) (:name i)))))
|
||||
|
||||
(defn update-site
|
||||
[request]
|
||||
(update-with-history request :site site-db/find-site-by-uuid
|
||||
(fn [i] (site-db/update-site (parse-uuid-or-nil (:uuid i)) (:name i)))))
|
||||
|
||||
(defn update-cohort
|
||||
[request]
|
||||
(update-with-history request :cohort cohort-db/find-cohort-by-uuid
|
||||
(fn [i] (cohort-db/update-cohort (parse-uuid-or-nil (:uuid i)) (:name i)))))
|
||||
|
||||
(defn update-timepoint
|
||||
[request]
|
||||
(update-with-history request :timepoint timepoint-db/find-timepoint-by-uuid
|
||||
(fn [i] (timepoint-db/update-timepoint (parse-uuid-or-nil (:uuid i)) (:name i)))))
|
||||
|
||||
(defn update-kit-type
|
||||
[request]
|
||||
(update-with-history request :kit-type kit-type-db/find-kit-type-by-uuid
|
||||
(fn [i]
|
||||
(kit-type-db/update-kit-type
|
||||
(parse-uuid-or-nil (:uuid i))
|
||||
(:name i)
|
||||
(Long/parseLong (str (:item-number i)))
|
||||
(:collection-date-required i)
|
||||
(:air-waybill-required i)))))
|
||||
|
||||
(defn update-sample-type
|
||||
[request]
|
||||
(update-with-history request :sample-type sample-type-db/find-sample-type-by-uuid (fn [i] (sample-type-db/update-sample-type (parse-uuid-or-nil (:uuid i)) (:name i) (:id-suffix i) (:ships-with-kit i) (:reminder i)))))
|
||||
|
||||
(defn set-active
|
||||
[request]
|
||||
(let [{:keys [study site cohort kit-type active]} (parse-request request)
|
||||
parsed-status (Boolean/valueOf active)
|
||||
study-uuid (parse-uuid-or-nil study)
|
||||
site-uuid (parse-uuid-or-nil site)
|
||||
cohort-uuid (parse-uuid-or-nil cohort)
|
||||
kit-type-uuid (parse-uuid-or-nil kit-type)]
|
||||
(cond
|
||||
(and (some? study-uuid) (some? site-uuid)) (datomic-transaction-response (site-db/update-site-active-status study-uuid site-uuid parsed-status))
|
||||
(and (some? study-uuid) (some? cohort-uuid)) (datomic-transaction-response (cohort-db/update-cohort-active-status study-uuid cohort-uuid parsed-status))
|
||||
(and (some? cohort-uuid) (some? kit-type-uuid)) (datomic-transaction-response (kit-type-db/update-kit-type-active-status cohort-uuid kit-type-uuid parsed-status))
|
||||
(some? study-uuid) (datomic-transaction-response (study-db/update-study-active-status study-uuid parsed-status))
|
||||
:else (api-response {:error {:message "Parameters not accepted"}}))))
|
||||
|
||||
(defn submit-kit-shipment
|
||||
[request]
|
||||
(let [input (parse-request request)
|
||||
uuid (parse-uuid-or-nil (:uuid input))
|
||||
complete-kit (kit-db/get-kit {:uuid uuid :complete true})]
|
||||
(if (or (nil? uuid) (not complete-kit))
|
||||
(api-response {:data {:uuid (kit-shipment/submit-kit-shipment uuid input)}})
|
||||
(api-response {:error {:message "Kit has already been submitted."}} :status 400))))
|
||||
|
||||
(defn create-incomplete-kit-shipment
|
||||
[request]
|
||||
(let [input (merge (parse-request request) {:complete false})
|
||||
uuid (kit-shipment/create-kit-shipment input)]
|
||||
(api-response {:data {:uuid uuid}})))
|
||||
|
||||
(defn list-kit-shipments
|
||||
[request]
|
||||
(let [user (get-in request [:session :identity])
|
||||
roles (get-in request [:session :roles])
|
||||
{:keys [uuid complete archived]} (:params request)
|
||||
parsed-kit-uuid (parse-uuid-or-nil uuid)
|
||||
parsed-complete (parse-boolean-or-nil complete)
|
||||
parsed-archived (parse-boolean-or-nil archived)
|
||||
shipment-options (cond-> {}
|
||||
(contains? roles (c/site-coordinator-role)) (assoc :completing-email user)
|
||||
(contains? roles (c/site-admin-role)) (assoc :completing-email-domain (second (str/split user #"@")))
|
||||
(some? parsed-kit-uuid) (assoc :uuid parsed-kit-uuid)
|
||||
(some? parsed-complete) (assoc :complete parsed-complete)
|
||||
(some? parsed-archived) (assoc :archived parsed-archived))
|
||||
kits (kit-shipment/list-kit-shipment shipment-options)]
|
||||
(api-response {:data {:items (reverse (sort-by :uuid kits))}})))
|
||||
|
||||
(defn kit-shipment-submitted
|
||||
[kit-id]
|
||||
(let [submitted-kit (kit-db/get-kit {:kit-id kit-id :complete true :archived false})]
|
||||
(api-response {:data {:items [{:kit-id kit-id :exists (some? submitted-kit)}]}})))
|
||||
|
||||
(defn get-incomplete-kit-shipment
|
||||
[raw-kit-uuid]
|
||||
(let [kit-uuid (parse-uuid-or-nil raw-kit-uuid)
|
||||
complete-kit (kit-db/get-kit {:uuid kit-uuid :complete true})
|
||||
shipment-options (cond-> {}
|
||||
(some? kit-uuid) (assoc :uuid kit-uuid))]
|
||||
(if (not complete-kit)
|
||||
(api-response {:data {:items (kit-shipment/list-kit-shipment shipment-options)}})
|
||||
(api-response {:error {:message "Kit not found."}} :status 400))))
|
||||
|
||||
(defn update-kit-shipment
|
||||
[request]
|
||||
(let [input (parse-request request)
|
||||
kit-uuid (parse-uuid-or-nil (:uuid input))
|
||||
user (get-in request [:session :identity])]
|
||||
(if (kit-edits/kit-has-pending-edits kit-uuid)
|
||||
(api-response {:error {:message "Kit has pending edits."}} :status 400)
|
||||
(api-response {:data {:uuid (kit-shipment/update-kit-shipment-with-history kit-uuid user input)}}))))
|
||||
|
||||
(defn propose-kit-shipment-edit
|
||||
[request]
|
||||
(let [user-email (get-in request [:session :identity])
|
||||
input (parse-request request)
|
||||
uuid (kit-edits/propose-kit-edits input user-email)]
|
||||
(api-response {:data {:uuid uuid}})))
|
||||
|
||||
(defn get-proposed-kit-shipment-edit-for-view
|
||||
[request]
|
||||
(let [uuid (get-in request [:params :uuid])
|
||||
parsed-uuid (parse-uuid-or-nil uuid)]
|
||||
(api-response {:data {:items [(kit-edits/get-proposed-kit-edit-for-display parsed-uuid)]}})))
|
||||
|
||||
(defn list-proposed-kit-shipment-edits
|
||||
[status]
|
||||
(api-response {:data {:items (reverse (sort-by :uuid (kit-edits/list-proposed-edits {:status status})))}}))
|
||||
|
||||
(defn get-kit-shipment-or-proposed-edit
|
||||
[request]
|
||||
(let [user (get-in request [:session :identity])
|
||||
roles (get-in request [:session :roles])
|
||||
uuid (parse-uuid-or-nil (get-in request [:params :uuid]))
|
||||
shipment-options (cond-> {:uuid uuid}
|
||||
(contains? roles (c/site-coordinator-role)) (assoc :completing-email user)
|
||||
(contains? roles (c/site-admin-role)) (assoc :completing-email-domain (second (str/split user #"@"))))]
|
||||
(api-response {:data {:items [(kit-edits/get-kit-or-proposed-edit shipment-options)]}})))
|
||||
|
||||
(defn update-proposed-kit-shipment-edit-status
|
||||
[request status-update-fn]
|
||||
(let [user-email (get-in request [:session :identity])
|
||||
uuid (get-in request [:params :uuid])
|
||||
parsed-uuid (parse-uuid-or-nil uuid)
|
||||
proposed-edit (kit-edits/get-proposed-kit-edit parsed-uuid)
|
||||
proposed-edit-status (:status proposed-edit)]
|
||||
(cond
|
||||
(nil? status-update-fn) (api-response {:error {:message "Status not found"} :status 400})
|
||||
(not= proposed-edit-status "pending") (api-response {:error {:message "Edit not pending."}} :status 400)
|
||||
:else (api-response (status-update-fn parsed-uuid user-email)))))
|
||||
|
||||
(defn set-kit-shipment-edit-status
|
||||
[request]
|
||||
(let [status (get-in request [:params :status])
|
||||
update-fn (case status
|
||||
"approved" kit-edits/approve-proposed-kit-edit
|
||||
"denied" kit-edits/deny-proposed-kit-edit
|
||||
nil)]
|
||||
(update-proposed-kit-shipment-edit-status request update-fn)))
|
||||
|
||||
(defn update-incomplete-kit-shipment
|
||||
[request]
|
||||
(let [input (parse-request request)
|
||||
kit-uuid (parse-uuid-or-nil (:uuid input))
|
||||
complete-kit (kit-db/get-kit {:uuid kit-uuid :complete true})]
|
||||
(if (not complete-kit)
|
||||
(api-response {:data {:uuid (kit-shipment/update-kit-shipment kit-uuid input)}})
|
||||
(api-response {:error {:message "Kit not found."}} :status 400))))
|
||||
|
||||
(defn set-kit-shipment-archived
|
||||
[request raw-uuid raw-archived]
|
||||
(let [user (get-in request [:session :identity])
|
||||
kit-uuid (parse-uuid-or-nil raw-uuid)
|
||||
archived (parse-boolean-or-nil raw-archived)]
|
||||
(api-response {:data {:uuid (kit-shipment/set-kit-shipment-archived kit-uuid user archived)}})))
|
||||
|
||||
(defn export-samples->csv
|
||||
[raw-uuid raw-complete raw-archived raw-uncollected]
|
||||
(let [export-options (multitool/clean-map
|
||||
{:uuid (parse-uuid-or-nil raw-uuid)
|
||||
:complete (parse-boolean-or-nil raw-complete)
|
||||
:archived (parse-boolean-or-nil raw-archived)
|
||||
:include-uncollected (parse-boolean-or-nil raw-uncollected)})
|
||||
streaming-samples (export/export-samples-to-streaming-csv export-options)
|
||||
filename (str "ereq_" (time/format (time/formatter "YYYY_MM_dd_HH_mm") (time/local-date-time)) ".csv")]
|
||||
(ring-utils/csv-response streaming-samples filename)))
|
||||
|
||||
(defn user-info
|
||||
[request]
|
||||
(let [{:keys [identity is-a-user email-verified roles auth-error]} (:session request)
|
||||
items (cond
|
||||
(some? identity) [{:email identity
|
||||
:roles roles
|
||||
:is-a-user is-a-user
|
||||
:email-verified email-verified}]
|
||||
(true? auth-error) [{:auth-error true}]
|
||||
:else [{}])]
|
||||
(api-response {:data {:items items}})))
|
||||
|
||||
(defn list-history
|
||||
[entity-uuid]
|
||||
(api-response {:data {:items (sort-by :time (history-db/list-history (parse-uuid-or-nil entity-uuid)))}}))
|
||||
|
||||
(defn list-roles
|
||||
[]
|
||||
(api-response {:data {:items (sort-by :name (role-db/list-roles))}}))
|
||||
|
||||
(defn list-users
|
||||
[]
|
||||
(api-response {:data {:items (sort-by :email (user-db/list-users {}))}}))
|
||||
|
||||
(defn create-user
|
||||
[request]
|
||||
(let [email (:email (parse-request request))
|
||||
user (iam/get-user email)]
|
||||
(cond
|
||||
(true? (:deactivated user)) (api-response {:data {:uuid (iam/reactivate-user email)}})
|
||||
(some? user) (api-response {:error {:message "User already exists."}} :status 400)
|
||||
:else (api-response {:data {:uuid (user-db/create-user email)}}))))
|
||||
|
||||
(defn deactivate-user
|
||||
[request]
|
||||
(let [requesting-email (get-in request [:session :identity])
|
||||
deactivating-email (:email (parse-request request))]
|
||||
(if (= requesting-email deactivating-email)
|
||||
(api-response {:error {:message "Cannot deactivate yourself."}} :status 400)
|
||||
(catch-error-response #(iam/deactivate-user deactivating-email)))))
|
||||
|
||||
(defn add-role-to-user
|
||||
[request]
|
||||
(let [input (parse-request request)]
|
||||
(catch-error-response #(iam/add-role-to-user (:email input) (:role-name input)))))
|
||||
|
||||
(defn remove-role-from-user
|
||||
[request]
|
||||
(let [input (parse-request request)
|
||||
user-email (get-in request [:session :identity])
|
||||
modifying-email (:email input)
|
||||
role-name (:role-name input)]
|
||||
(if (and (= user-email modifying-email) (= role-name (c/application-admin-role)))
|
||||
(api-response {:error {:message "Cannot remove admin from yourself."}} :status 400)
|
||||
(catch-error-response #(iam/remove-role-from-user (:email input) (:role-name input))))))
|
||||
|
||||
(defn list-configuration
|
||||
[]
|
||||
(api-response {:data {:items [{:datomic-endpoint (c/datomic-endpoint)
|
||||
:datomic-db-name (c/datomic-db-name)
|
||||
:sendgrid-api-key (c/sendgrid-api-key)
|
||||
:email-sender (c/email-sender)
|
||||
:email-manifest-recipient (c/email-manifest-recipient)
|
||||
:send-manifest-emails (c/send-manifest-emails)
|
||||
:send-vendor-emails (c/send-vendor-emails)}]}}))
|
||||
|
||||
(defn log-in
|
||||
[request]
|
||||
(if-let [firebase-jwt (:firebase-jwt (parse-request request))]
|
||||
(let [authed-session (firebase/add-firebase-auth-to-session (:session request) firebase-jwt)]
|
||||
(-> (api-response {:success true})
|
||||
(assoc :session authed-session)))
|
||||
(api-response {:error {:message "Request missing Firebase JWT"}} :status 400)))
|
||||
|
||||
;Method to log in in case of no internet for firebase.
|
||||
;(defn test-log-in
|
||||
; []
|
||||
; (let [session (-> {}
|
||||
; (assoc :identity "rschiemann@parkerici.org")
|
||||
; (assoc :roles #{"site-admin"})
|
||||
; (assoc :is-a-user true)
|
||||
; (assoc :email-verified true))]
|
||||
; (-> (api-response {:success true})
|
||||
; (assoc :session session))))
|
||||
|
||||
(defn log-out
|
||||
[request]
|
||||
(-> (api-response {:success true})
|
||||
(assoc :session (firebase/remove-firebase-auth-from-session (:session request)))))
|
||||
123
src/clj/org/parkerici/sample_tracking/api/email.clj
Normal file
123
src/clj/org/parkerici/sample_tracking/api/email.clj
Normal file
@@ -0,0 +1,123 @@
|
||||
(ns org.parkerici.sample-tracking.api.email
|
||||
(:require [org.parkerici.sample-tracking.configuration :as c]
|
||||
[org.parkerici.sample-tracking.db.study :as study-db]
|
||||
[org.parkerici.sample-tracking.db.site :as site-db]
|
||||
[org.parkerici.sample-tracking.db.cohort :as cohort-db]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.timepoint :as timepoint-db]
|
||||
[org.parkerici.sample-tracking.db.sample-type :as sample-type-db]
|
||||
[org.parkerici.sample-tracking.db.form-type :as form-type-db]
|
||||
[org.parkerici.sample-tracking.db.kit :as kit-db]
|
||||
[org.parkerici.sample-tracking.api.export :as export]
|
||||
[org.parkerici.sample-tracking.utils.path :as path]
|
||||
[org.parkerici.sample-tracking.pages.manifest :as manifest-page]
|
||||
[again.core :as again]
|
||||
[clojure.java.io :as io]
|
||||
[hiccup.core :as hiccup]
|
||||
[clj-htmltopdf.core :as htmltopdf]
|
||||
[org.parkerici.sample-tracking.utils.date-time :as dt])
|
||||
(:import [com.sendgrid SendGrid SendGrid$Email]
|
||||
(java.util UUID)))
|
||||
|
||||
(def csv-attachment-name "samples.csv")
|
||||
(def pdf-attachment-name "manifest.pdf")
|
||||
|
||||
(defn send-message
|
||||
[to subject content csv-file]
|
||||
(let [pdf-path (path/join (c/temp-path) pdf-attachment-name)
|
||||
_ (htmltopdf/->pdf content pdf-path)
|
||||
pdf-file (io/file pdf-path)
|
||||
sg (new SendGrid (c/sendgrid-api-key))
|
||||
email (doto (new SendGrid$Email)
|
||||
(.addTo to)
|
||||
(.setFrom (c/email-sender))
|
||||
(.setSubject subject)
|
||||
(.setHtml content))
|
||||
email-with-csv (if csv-file
|
||||
(.addAttachment email csv-attachment-name csv-file)
|
||||
email)
|
||||
email-with-pdf (if pdf-file
|
||||
(.addAttachment email-with-csv pdf-attachment-name pdf-file)
|
||||
email-with-csv)]
|
||||
(try
|
||||
(again/with-retries
|
||||
[1000 10000]
|
||||
(.send sg email-with-pdf))
|
||||
(catch Exception ex
|
||||
(.printStackTrace ex)
|
||||
(println (.getMessage ex))))
|
||||
(io/delete-file pdf-path)))
|
||||
|
||||
(defn manifest-email-body
|
||||
[kit-map config]
|
||||
(let [{:keys [kit-id site study cohort participant-id air-waybill collection-timestamp timezone
|
||||
completing-first-name completing-last-name completing-email comments timepoints kit-type samples
|
||||
form-type-field-values]} kit-map
|
||||
kit-type-uuid (UUID/fromString kit-type)
|
||||
site-name (:name (site-db/find-site-by-uuid (UUID/fromString site)))
|
||||
study-name (:name (study-db/find-study-by-uuid (UUID/fromString study)))
|
||||
cohort-name (:name (cohort-db/find-cohort-by-uuid (UUID/fromString cohort)))
|
||||
timepoint-names (map #(:name (timepoint-db/find-timepoint-by-uuid (UUID/fromString %))) timepoints)
|
||||
kit-type-name (kit-type-db/get-kit-type-name kit-type-uuid)
|
||||
selected-sample-types (sort-by :id-suffix (sample-type-db/list-sample-types kit-type-uuid))
|
||||
selected-form-type-fields (form-type-db/get-form-type-fields kit-type-uuid)
|
||||
date-display-fn (fn [date] (when date (dt/generate-date-string date timezone)))
|
||||
time-display-fn (fn [time] (when time (dt/generate-time-string time timezone)))
|
||||
completing-user-manifest (:completing-user-manifest config)
|
||||
content (manifest-page/content {:site-name site-name
|
||||
:study-name study-name
|
||||
:cohort-name cohort-name
|
||||
:timepoint-names timepoint-names
|
||||
:kit-name kit-type-name
|
||||
:kit-id kit-id
|
||||
:participant-id participant-id
|
||||
:collection-date collection-timestamp
|
||||
:collection-time collection-timestamp
|
||||
:selected-form-type-fields selected-form-type-fields
|
||||
:form-type-field-values form-type-field-values
|
||||
:selected-sample-types selected-sample-types
|
||||
:sample-values samples
|
||||
:air-waybill air-waybill
|
||||
:completing-first-name completing-first-name
|
||||
:completing-last-name completing-last-name
|
||||
:completing-email completing-email
|
||||
:comments comments
|
||||
:date-display-fn date-display-fn
|
||||
:time-display-fn time-display-fn
|
||||
:add-empty-field-lines completing-user-manifest
|
||||
:add-signature-fields completing-user-manifest})]
|
||||
(hiccup/html [:div.page-body
|
||||
[:h1 "Kit Shipment Manifest"]
|
||||
[:div.kit-manifest
|
||||
content]])))
|
||||
|
||||
(defn send-manifest-email
|
||||
[kit-map kit-uuid]
|
||||
(let [completing-user-body (manifest-email-body kit-map {:completing-user-manifest true})
|
||||
non-completing-user-body (manifest-email-body kit-map {:completing-user-manifest false})
|
||||
subject "Sample Tracking Kit Manifest"
|
||||
completing-email (:completing-email kit-map)
|
||||
vendor-email (kit-db/get-kit-vendor-email kit-uuid)
|
||||
csv-path (path/join (c/temp-path) csv-attachment-name)
|
||||
_ (export/export-samples-to-csv {:uuid kit-uuid :shipped true} csv-path)
|
||||
csv-file (io/file csv-path)]
|
||||
(when (c/send-manifest-emails)
|
||||
(send-message (c/email-manifest-recipient) subject non-completing-user-body csv-file)
|
||||
(send-message completing-email subject completing-user-body csv-file)
|
||||
(when (and (c/send-vendor-emails) (some? vendor-email))
|
||||
(send-message vendor-email subject non-completing-user-body csv-file)))
|
||||
(io/delete-file csv-path)))
|
||||
|
||||
(defn proposed-edit-body
|
||||
[user-email]
|
||||
(hiccup/html
|
||||
[:div.page-body
|
||||
[:p (str user-email " has proposed a kit edit. Please login to the application to approve or deny it.")]]))
|
||||
|
||||
(defn send-proposed-edit-email
|
||||
[update-map user-email]
|
||||
(let [recipient (c/email-manifest-recipient)
|
||||
subject (str "Edit Proposed for Kit " (:kit-id update-map))
|
||||
body (proposed-edit-body user-email)]
|
||||
(when (c/send-manifest-emails)
|
||||
(send-message recipient subject body nil))))
|
||||
201
src/clj/org/parkerici/sample_tracking/api/export.clj
Normal file
201
src/clj/org/parkerici/sample_tracking/api/export.clj
Normal file
@@ -0,0 +1,201 @@
|
||||
(ns org.parkerici.sample-tracking.api.export
|
||||
(:require [clojure.string :as string]
|
||||
[org.parkerici.sample-tracking.configuration :as c]
|
||||
[org.parkerici.sample-tracking.db.form-value :as form-value-db]
|
||||
[org.parkerici.sample-tracking.db.sample :as sample-db]
|
||||
[org.parkerici.sample-tracking.db.sample-attribute :as sample-attribute-db]
|
||||
[org.parkerici.sample-tracking.db.sample-type :as sample-type-db]
|
||||
[org.parkerici.sample-tracking.db.timepoint :as timepoint-db]
|
||||
[org.parkerici.sample-tracking.utils.csv :as csv]
|
||||
[org.parkerici.sample-tracking.utils.date-time :as dt]))
|
||||
|
||||
(defn build-timepoint-map
|
||||
[config-map]
|
||||
(reduce (fn [m value]
|
||||
(let [kit-uuid (:kit-uuid value)
|
||||
cur-values (or (get m kit-uuid) [])
|
||||
updated-values (conj cur-values (:timepoint-name value))]
|
||||
(assoc m kit-uuid updated-values))) {} (timepoint-db/list-kit-timepoints config-map)))
|
||||
|
||||
(defn add-timepoints-to-samples
|
||||
"Add attributes and their values to a map of samples
|
||||
Samples should be a list of maps that all have the key :sample-id
|
||||
Timepoints should be a list of maps that have they keys :sample-id and :timepoint-name
|
||||
Returns the samples list with the timepoint-names that map to each sample added as a comma separated list
|
||||
under the key :timepoints."
|
||||
[timepoint-map samples]
|
||||
(map (fn [sample]
|
||||
(let [kit-uuid (:kit-uuid sample)
|
||||
timepoint-names (string/join ", " (sort (get timepoint-map kit-uuid)))]
|
||||
(assoc sample :timepoints timepoint-names))) samples))
|
||||
|
||||
(defn build-sample-join-map
|
||||
[values-to-join join-key]
|
||||
(reduce (fn [value-map value]
|
||||
(let [join-key-value (get value join-key)
|
||||
existing-values (or (get value-map join-key-value) [])
|
||||
updated-values (conj existing-values value)]
|
||||
(assoc value-map join-key-value updated-values))) {} values-to-join))
|
||||
|
||||
(defn join-to-sample-map
|
||||
"Add the values elements in values to join to the sample maps in samples.
|
||||
Samples should be a list of maps that all have the key :sample-id
|
||||
values-to-join should be a list of maps that have they keys join-key, id-key.
|
||||
Calls the join-fn on sample and a list of the values in values-to-join with the same join-key.
|
||||
Expects the join-fn to returned the sample map joined with corresponding values from values-to-join.
|
||||
Returns the list of samples after joining with the values-to-join and applying join-fn."
|
||||
[join-map join-key join-fn samples]
|
||||
(map (fn [sample]
|
||||
(let [join-key-value (get sample join-key)
|
||||
joining-values (get join-map join-key-value)]
|
||||
(join-fn sample joining-values))) samples))
|
||||
|
||||
(defn parse-and-split-collection-timestamp
|
||||
[samples]
|
||||
(map (fn [sample]
|
||||
(let [timezone (:timezone sample)
|
||||
collection-timestamp (:collection-timestamp sample)]
|
||||
(-> sample
|
||||
(assoc :collection-date (when collection-timestamp (dt/generate-date-string collection-timestamp timezone)))
|
||||
(assoc :collection-time (when collection-timestamp (dt/generate-time-string collection-timestamp timezone)))
|
||||
(dissoc :collection-timestamp))))
|
||||
samples))
|
||||
|
||||
(defn attributes-and-values-join-fn
|
||||
[sample values]
|
||||
(reduce (fn [sample value]
|
||||
(assoc sample (:attribute value) (:value value))) sample values))
|
||||
|
||||
(defn kit-form-values-join-fn
|
||||
[sample values]
|
||||
(if (:collected sample)
|
||||
(reduce (fn [sample value]
|
||||
(if (= (:field-type value) "time")
|
||||
(assoc sample
|
||||
(:field-id value)
|
||||
(dt/generate-time-string (:value value) (:timezone sample)))
|
||||
(assoc sample
|
||||
(:field-id value)
|
||||
(:value value))))
|
||||
sample values)
|
||||
sample))
|
||||
|
||||
(defn kit-type->sample-type-map-reduce-fn
|
||||
"A reduce function that expects a sample-type map as input.
|
||||
Builds an output map of the form
|
||||
{kit-type-uuid: {sample-type-uuid: {:name 'sample-type-name' :id-suffix 'sample-type-id-suffix'}}"
|
||||
[m sample-type]
|
||||
(let [kit-type-uuid (:kit-type-uuid sample-type)
|
||||
cur-values (or (get m kit-type-uuid) {})
|
||||
sample-type-map {:name (:name sample-type)
|
||||
:suffix (:id-suffix sample-type)}
|
||||
updated-values (assoc cur-values
|
||||
(:uuid sample-type)
|
||||
sample-type-map)]
|
||||
(assoc m kit-type-uuid updated-values)))
|
||||
|
||||
(defn kit->sample-map-reduce-fn
|
||||
"A reduce function that expects a sample map as an input.
|
||||
Builds an output map of the form {kit-uuid: {sample-type-uuid: sample}}"
|
||||
[m sample]
|
||||
(let [kit-uuid (:kit-uuid sample)
|
||||
cur-values (or (get m kit-uuid) {})
|
||||
updated-values (assoc cur-values
|
||||
(:sample-type-uuid sample) sample)]
|
||||
(assoc m kit-uuid updated-values)))
|
||||
|
||||
(defn kit-sample-type-uuids
|
||||
"For a given kit, finds the kit-type for that kit and then finds the sample-types for that kit-type.
|
||||
Returns a list of the sample-type-uuids for a given kit."
|
||||
[kit-uuid kit-type-sample-type-map kit-sample-map]
|
||||
(let [samples-map (get kit-sample-map kit-uuid)
|
||||
first-sample (first (vals samples-map))
|
||||
kit-type-uuid (get first-sample :kit-type-uuid)
|
||||
kit-sample-types (get kit-type-sample-type-map kit-type-uuid)]
|
||||
(keys kit-sample-types)))
|
||||
|
||||
(defn build-uncollected-sample
|
||||
"Given a kit and a sample-type for that kit, builds an uncollected sample by taking the first collected sample for
|
||||
that kit and then clearing any sample specific information and adding the correct sample-type-name and sample-id."
|
||||
[kit-uuid sample-type-uuid kit-type-sample-type-map kit-sample-map]
|
||||
(let [samples-map (get kit-sample-map kit-uuid)
|
||||
first-sample (first (vals samples-map))
|
||||
kit-type-uuid (get first-sample :kit-type-uuid)
|
||||
cur-sample-type (get-in kit-type-sample-type-map [kit-type-uuid sample-type-uuid])]
|
||||
(-> first-sample
|
||||
(dissoc :collection-timestamp)
|
||||
(assoc :sample-type-name (:name cur-sample-type))
|
||||
(assoc :sample-id (str (:kit-id first-sample) (:suffix cur-sample-type)))
|
||||
(assoc :collected false)
|
||||
(assoc :shipped false)
|
||||
(assoc :air-waybill ""))))
|
||||
|
||||
(defn add-uncollected-samples
|
||||
"Expects a sample map and a boolean flag to add uncollected. Normally a sample map only contains samples that have
|
||||
been collected. If add-uncollected is true, iterates over the sample-types for the kits represented in samples
|
||||
and then generates samples for the uncollected samples. If add-uncollected is false just returns the passed in
|
||||
samples."
|
||||
[kit-type-sample-type-map add-uncollected]
|
||||
(fn [xf]
|
||||
(fn
|
||||
([] (xf))
|
||||
([processed-samples] (xf processed-samples))
|
||||
([processed-samples new-samples]
|
||||
(if add-uncollected
|
||||
(let [kit-sample-map (reduce kit->sample-map-reduce-fn {} new-samples)
|
||||
full-kit-sample-map (for [cur-kit-uuid (keys kit-sample-map)
|
||||
cur-sample-type-uuid (kit-sample-type-uuids cur-kit-uuid kit-type-sample-type-map
|
||||
kit-sample-map)]
|
||||
(if-let [cur-kit-sample (get-in kit-sample-map [cur-kit-uuid cur-sample-type-uuid])]
|
||||
cur-kit-sample
|
||||
(build-uncollected-sample cur-kit-uuid cur-sample-type-uuid kit-type-sample-type-map
|
||||
kit-sample-map)))]
|
||||
(xf processed-samples full-kit-sample-map))
|
||||
(xf processed-samples new-samples))))))
|
||||
|
||||
(defn remove-unused-columns
|
||||
[samples]
|
||||
(map #(apply dissoc % (c/sample-export-columns-to-drop)) samples))
|
||||
|
||||
; TODO - Could possibly use some refactoring here.
|
||||
; Could be cleaner to get all kit types and sample types, and then iterate through all existing kits and samples.
|
||||
; If a sample is present for a kit, get the sample type and fill in the collected sample's specific information.
|
||||
; Otherwise we would emit a "base" uncollected sample.
|
||||
;
|
||||
; Readability isn't the best to decrease memory usage.
|
||||
(defn get-samples-for-export
|
||||
"Gets all of the samples for export as a list of maps ready to pass to csv/write-csv-file.
|
||||
Config map can have a :uuid key to export only a specific kit, or an :include-uncollected key
|
||||
if we want to include any uncollected samples in the export."
|
||||
([config-map]
|
||||
(let [samples (sample-db/list-samples-for-export config-map)
|
||||
kit-type-sample-type-map (reduce kit-type->sample-type-map-reduce-fn {} (sample-type-db/list-sample-types nil))
|
||||
timepoint-map (build-timepoint-map config-map)
|
||||
attributes-and-values-join-map (build-sample-join-map
|
||||
(sample-attribute-db/list-sample-attributes-and-values-for-export config-map)
|
||||
:sample-id)
|
||||
kit-form-join-map (build-sample-join-map
|
||||
(form-value-db/list-form-values config-map)
|
||||
:kit-uuid)
|
||||
sample-transducer (comp
|
||||
(map (partial join-to-sample-map kit-form-join-map :kit-uuid kit-form-values-join-fn))
|
||||
(map (partial join-to-sample-map attributes-and-values-join-map :sample-id attributes-and-values-join-fn))
|
||||
(map (partial add-timepoints-to-samples timepoint-map))
|
||||
(map parse-and-split-collection-timestamp)
|
||||
(add-uncollected-samples kit-type-sample-type-map (:include-uncollected config-map)))
|
||||
]
|
||||
(->> (transduce sample-transducer concat (vals (group-by :kit-uuid samples)))
|
||||
(sort-by (juxt :kit-uuid :sample-id))
|
||||
(remove-unused-columns)))))
|
||||
|
||||
(defn export-options
|
||||
[]
|
||||
{:column-order (c/sample-export-column-order) :columns-to-rename (c/sample-export-columns-to-rename)})
|
||||
|
||||
(defn export-samples-to-csv
|
||||
[config-map csv-path]
|
||||
(csv/write-csv-file csv-path (get-samples-for-export config-map) (export-options)))
|
||||
|
||||
(defn export-samples-to-streaming-csv
|
||||
[config-map]
|
||||
(csv/csv-output-stream-fn (get-samples-for-export config-map) (export-options)))
|
||||
53
src/clj/org/parkerici/sample_tracking/api/firebase.clj
Normal file
53
src/clj/org/parkerici/sample_tracking/api/firebase.clj
Normal file
@@ -0,0 +1,53 @@
|
||||
(ns org.parkerici.sample-tracking.api.firebase
|
||||
(:require [clojure.string :as str]
|
||||
[org.parkerici.sample-tracking.api.iam :as iam]
|
||||
[taoensso.timbre :as log])
|
||||
(:import [com.google.firebase FirebaseApp FirebaseOptions]
|
||||
[com.google.auth.oauth2 GoogleCredentials]
|
||||
[com.google.firebase.auth FirebaseAuth]))
|
||||
|
||||
(defn get-authorization-jwt
|
||||
[request]
|
||||
(when-let [authorization-header (get-in request [:headers "authorization"])]
|
||||
(let [split-header (str/split authorization-header #" " 2)]
|
||||
(when (= (first split-header) "Bearer")
|
||||
(second split-header)))))
|
||||
|
||||
(defn check-initialize-firebase
|
||||
[]
|
||||
(when (empty? (FirebaseApp/getApps))
|
||||
(let [firebase-options (-> (FirebaseOptions/builder)
|
||||
(.setCredentials (GoogleCredentials/getApplicationDefault))
|
||||
(.build))]
|
||||
(FirebaseApp/initializeApp firebase-options))))
|
||||
|
||||
(defn verify-token
|
||||
"Verifies that the passed in JWT is valid.
|
||||
If it's valid, returns a decoded FirebaseToken"
|
||||
[token]
|
||||
(check-initialize-firebase)
|
||||
(-> (FirebaseAuth/getInstance)
|
||||
(.verifyIdToken token true)))
|
||||
|
||||
(defn process-firebase-jwt-request
|
||||
[session request-jwt]
|
||||
(let [decoded-jwt (verify-token request-jwt)
|
||||
firebase-email (.getEmail decoded-jwt)
|
||||
user (iam/get-user firebase-email)
|
||||
is-a-user (and (some? user) (not (:deactivated user)))
|
||||
email-verified (.isEmailVerified decoded-jwt)
|
||||
roles (set (iam/get-users-roles firebase-email))]
|
||||
(merge session
|
||||
{:identity firebase-email :roles roles :is-a-user is-a-user :email-verified email-verified})))
|
||||
|
||||
(defn add-firebase-auth-to-session
|
||||
[session firebase-jwt]
|
||||
(try
|
||||
(process-firebase-jwt-request session firebase-jwt)
|
||||
(catch Exception e
|
||||
(log/error e)
|
||||
(assoc session :auth-error true))))
|
||||
|
||||
(defn remove-firebase-auth-from-session
|
||||
[session]
|
||||
(dissoc session :identity :roles :is-a-user :email-verified))
|
||||
51
src/clj/org/parkerici/sample_tracking/api/form_type.clj
Normal file
51
src/clj/org/parkerici/sample_tracking/api/form_type.clj
Normal file
@@ -0,0 +1,51 @@
|
||||
(ns org.parkerici.sample-tracking.api.form-type
|
||||
"Form types are custom, configurable forms that are associated with
|
||||
kit types to collect information for that kit type outside of the
|
||||
default fields collected.
|
||||
|
||||
This file is focused on taking in a csv with form type definitions
|
||||
along with the kit item numbers of the kits they are used for,
|
||||
parsing that csv, and then creating the appropriate values in the database."
|
||||
(:require [clojure.edn :as edn]
|
||||
[org.parkerici.sample-tracking.utils.csv :as csv]
|
||||
[org.parkerici.sample-tracking.configuration :as config]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.form-type :as form-type-db]))
|
||||
|
||||
; Used with filter to remove rows in the input CSV that don't have the required values.
|
||||
(defn row-has-required-values
|
||||
[row]
|
||||
(not (or (empty? (:form-type-name row))
|
||||
(empty? (:kit-item-no row)))))
|
||||
|
||||
; Does not create a form-type if form-type-fields is missing from the row.
|
||||
(defn create-form-type
|
||||
[row]
|
||||
(when-not (empty? (:form-type-fields row))
|
||||
(let [raw-form-type-fields (edn/read-string (:form-type-fields row))
|
||||
form-type-fields (map #(vector :form-type-field/uuid (form-type-db/create-form-type-field %)) raw-form-type-fields)
|
||||
form-type (form-type-db/create-form-type (:form-type-name row) form-type-fields)]
|
||||
form-type)))
|
||||
|
||||
; Tries to find form-type by name. Returns it if found, otherwise creates it with row information.
|
||||
(defn find-or-create-form-type
|
||||
[row]
|
||||
(let [form-type-uuid (form-type-db/find-form-type (:form-type-name row))]
|
||||
(if form-type-uuid
|
||||
form-type-uuid
|
||||
(create-form-type row))))
|
||||
|
||||
(defn create-row-in-db
|
||||
[row]
|
||||
(let [form-type (find-or-create-form-type row)
|
||||
kit-item-numbers (csv/split-csv-string (:kit-item-no row))]
|
||||
(doseq [kit-item-number kit-item-numbers]
|
||||
(when (and form-type
|
||||
(not (kit-type-db/kit-type-has-form-type kit-item-number)))
|
||||
(kit-type-db/add-form-type-to-kit-type form-type (Integer/parseInt kit-item-number))))))
|
||||
|
||||
(defn parse-form-type-csv-and-save-to-db
|
||||
[fpath]
|
||||
(let [csv-headers (config/csv-file-headers :form-type)
|
||||
csv-data (csv/read-csv-into-map fpath csv-headers row-has-required-values)]
|
||||
(doseq [row csv-data] (create-row-in-db row))))
|
||||
59
src/clj/org/parkerici/sample_tracking/api/iam.clj
Normal file
59
src/clj/org/parkerici/sample_tracking/api/iam.clj
Normal file
@@ -0,0 +1,59 @@
|
||||
(ns org.parkerici.sample-tracking.api.iam
|
||||
(:require [org.parkerici.sample-tracking.db.user :as user-db]
|
||||
[org.parkerici.sample-tracking.db.role :as role-db]))
|
||||
|
||||
(defn find-or-create-user
|
||||
[email]
|
||||
(let [user-uuid (user-db/find-user-uuid email)]
|
||||
(if user-uuid
|
||||
user-uuid
|
||||
(user-db/create-user email))))
|
||||
|
||||
(defn find-or-create-role
|
||||
[name]
|
||||
(let [role-uuid (role-db/find-role-uuid name)]
|
||||
(if role-uuid
|
||||
role-uuid
|
||||
(role-db/create-role name))))
|
||||
|
||||
(defn add-role-to-user
|
||||
[email role-name]
|
||||
(let [user-uuid (find-or-create-user email)
|
||||
role-uuid (find-or-create-role role-name)]
|
||||
(if (user-db/user-has-role user-uuid role-uuid)
|
||||
(throw (Exception. "User already has role."))
|
||||
(user-db/add-role-to-user user-uuid role-uuid))))
|
||||
|
||||
(defn remove-role-from-user
|
||||
[email role-name]
|
||||
(let [user-uuid (find-or-create-user email)
|
||||
role-uuid (find-or-create-role role-name)]
|
||||
(if (user-db/user-has-role user-uuid role-uuid)
|
||||
(user-db/remove-role-from-user user-uuid role-uuid)
|
||||
(throw (Exception. "User does not have role to remove.")))))
|
||||
|
||||
(defn get-users-roles
|
||||
[email]
|
||||
(doall (map first (user-db/get-users-roles email))))
|
||||
|
||||
(defn get-users-with-role
|
||||
[role-name]
|
||||
(doall (map first (user-db/get-users-with-role role-name))))
|
||||
|
||||
(defn get-user
|
||||
[email]
|
||||
(first (user-db/list-users {:email email})))
|
||||
|
||||
(defn reactivate-user
|
||||
[email]
|
||||
(user-db/set-user-deactivated-status email false)
|
||||
(find-or-create-user email))
|
||||
|
||||
(defn deactivate-user
|
||||
[email]
|
||||
(let [user-uuid (user-db/find-user-uuid email)]
|
||||
(user-db/set-user-deactivated-status email true)
|
||||
(doseq [role (role-db/list-roles)]
|
||||
(when (user-db/user-has-role user-uuid (:uuid role))
|
||||
(user-db/remove-role-from-user user-uuid (:uuid role))))
|
||||
user-uuid))
|
||||
216
src/clj/org/parkerici/sample_tracking/api/kit_shipment.clj
Normal file
216
src/clj/org/parkerici/sample_tracking/api/kit_shipment.clj
Normal file
@@ -0,0 +1,216 @@
|
||||
(ns org.parkerici.sample-tracking.api.kit-shipment
|
||||
(:require [clojure.set :as set]
|
||||
[java-time :as time]
|
||||
[org.parkerici.sample-tracking.db.core :as db]
|
||||
[org.parkerici.sample-tracking.db.timepoint :as timepoint-db]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.kit :as kit-db]
|
||||
[org.parkerici.sample-tracking.db.form-type :as form-type-db]
|
||||
[org.parkerici.sample-tracking.db.form-value :as form-value-db]
|
||||
[org.parkerici.sample-tracking.db.sample :as sample-db]
|
||||
[org.parkerici.sample-tracking.db.shipment :as shipment-db]
|
||||
[org.parkerici.sample-tracking.db.history :as history-db]
|
||||
[org.parkerici.sample-tracking.db.proposed-kit-edit :as proposed-kit-edit-db]
|
||||
[org.parkerici.sample-tracking.api.email :as email]
|
||||
[org.parkerici.sample-tracking.utils.collection :as coll-utils])
|
||||
(:import (java.util Date UUID)))
|
||||
|
||||
(defn create-samples-and-add-to-kit-shipment
|
||||
[kit-uuid shipment-uuid samples]
|
||||
(doseq [sample-type-uuid (keys samples)]
|
||||
(let [sample (get samples sample-type-uuid)
|
||||
sample-collected (boolean (:collected sample))
|
||||
sample-shipped (boolean (:shipped sample))]
|
||||
(when sample-collected
|
||||
(let [sample-uuid (sample-db/create-or-update-sample nil (name sample-type-uuid) (:sample-id sample)
|
||||
sample-collected sample-shipped)]
|
||||
(kit-db/add-sample-to-kit kit-uuid sample-uuid)
|
||||
(when (and shipment-uuid sample-shipped) (sample-db/add-sample-to-shipment shipment-uuid sample-uuid)))))))
|
||||
|
||||
(defn create-update-form-value
|
||||
[form-value-uuid form-value-field-id-key form-fields form-values]
|
||||
(let [form-value-field-id (name form-value-field-id-key)
|
||||
form-field (first (filter #(= form-value-field-id (:field-id %)) form-fields))
|
||||
form-field-type (:type form-field)
|
||||
form-field-uuid (:uuid form-field)
|
||||
raw-form-value (get form-values form-value-field-id-key)
|
||||
parsed-form-value (case form-field-type
|
||||
"time" (if (string? raw-form-value) (time/java-date raw-form-value) raw-form-value)
|
||||
"boolean" (if (string? raw-form-value) (Boolean/valueOf raw-form-value) raw-form-value)
|
||||
"int" (if (string? raw-form-value) (Long/parseLong raw-form-value) raw-form-value)
|
||||
raw-form-value)]
|
||||
(form-value-db/create-or-update-form-value form-value-uuid form-field-uuid form-field-type parsed-form-value)))
|
||||
|
||||
(defn create-form-values-and-add-to-kit
|
||||
[kit-uuid kit-type-uuid form-values]
|
||||
(let [form-fields (form-type-db/get-form-type-fields kit-type-uuid)]
|
||||
(doseq [form-value-field-id-key (keys form-values)]
|
||||
(let [form-value-uuid (create-update-form-value nil form-value-field-id-key form-fields form-values)]
|
||||
(kit-db/add-form-value-to-kit kit-uuid form-value-uuid)))))
|
||||
|
||||
(defn create-kit-shipment
|
||||
[kit-map]
|
||||
(let [{:keys [air-waybill kit-type samples form-type-field-values]} kit-map
|
||||
kit-type-uuid (UUID/fromString kit-type)
|
||||
kit-uuid (kit-db/create-or-update-kit nil kit-map)
|
||||
shipment-uuid (when (some? air-waybill) (shipment-db/create-or-update-shipment nil air-waybill))]
|
||||
(when (some? shipment-uuid) (kit-db/add-shipment-to-kit kit-uuid shipment-uuid))
|
||||
(create-samples-and-add-to-kit-shipment kit-uuid shipment-uuid samples)
|
||||
(create-form-values-and-add-to-kit kit-uuid kit-type-uuid form-type-field-values)
|
||||
kit-uuid))
|
||||
|
||||
; If uuid is passed in then filters on that as a kit uuid. Otherwise returns all kits.
|
||||
; If tx-id is passed in then queries the kit-shipment values as-of the historical tx-id
|
||||
(defn list-kit-shipment
|
||||
[config-map]
|
||||
(let [kits (kit-db/list-kits config-map)
|
||||
timepoints (timepoint-db/list-kit-timepoints config-map)
|
||||
samples (sample-db/list-samples config-map)
|
||||
form-values (form-value-db/list-form-values config-map)
|
||||
shipments (shipment-db/list-shipments config-map)
|
||||
pending-edits (map #(select-keys % [:kit-uuid :uuid :email :time])
|
||||
(proposed-kit-edit-db/list-proposed-edits {:status "pending"}))
|
||||
edit-history (map #(select-keys % [:entity-uuid :agent-email :time])
|
||||
(history-db/list-history nil))]
|
||||
(-> kits
|
||||
(coll-utils/merge-map-colls :uuid timepoints :kit-uuid :timepoints)
|
||||
(coll-utils/merge-map-colls :uuid samples :kit-uuid :samples)
|
||||
(coll-utils/merge-map-colls :uuid form-values :kit-uuid :form-values)
|
||||
(coll-utils/merge-map-colls :uuid shipments :kit-uuid :shipments)
|
||||
(coll-utils/merge-map-colls :uuid pending-edits :kit-uuid :pending-edits)
|
||||
(coll-utils/merge-map-colls :uuid edit-history :entity-uuid :history))))
|
||||
|
||||
(defn delete-samples
|
||||
[current-sample-map sample-type-uuids]
|
||||
(let [uuids (doall (map #(vector :sample-type/uuid (:uuid (get current-sample-map %))) sample-type-uuids))]
|
||||
(db/retract-entities uuids)))
|
||||
|
||||
(defn update-existing-samples
|
||||
[shipment-uuid current-sample-map updated-sample-map sample-type-uuids]
|
||||
(let [shipment-sample-uuids (sample-db/list-shipment-samples shipment-uuid)]
|
||||
(doseq [sample-type-uuid sample-type-uuids]
|
||||
(let [current-sample (get current-sample-map sample-type-uuid)
|
||||
sample-uuid (:uuid current-sample)
|
||||
current-sample-in-shipment (boolean (some #(= sample-uuid %) shipment-sample-uuids))
|
||||
updated-sample (get updated-sample-map sample-type-uuid)
|
||||
updated-sample-collected (boolean (:collected updated-sample))
|
||||
updated-sample-shipped (boolean (:shipped updated-sample))]
|
||||
; Update the existing shipment in the db with the new values
|
||||
(sample-db/create-or-update-sample sample-uuid (name sample-type-uuid) (:sample-id updated-sample)
|
||||
updated-sample-collected updated-sample-shipped)
|
||||
; If the current sample was marked as shipped, but the updated one was not then remove the sample from the associated shipment.
|
||||
(when (and current-sample-in-shipment (not updated-sample-shipped)) (sample-db/remove-sample-from-shipment shipment-uuid sample-uuid))
|
||||
; If the current sample was not marked as shipped, but the updated one is then add the sample to the associated shipment
|
||||
(when (and (not current-sample-in-shipment) updated-sample-shipped) (sample-db/add-sample-to-shipment shipment-uuid sample-uuid))))))
|
||||
|
||||
; Currently assumes one shipment per kit. May not be the case in the future.
|
||||
(defn create-or-update-shipment
|
||||
[kit-uuid air-waybill]
|
||||
(let [current-shipment-uuid (:uuid (first (shipment-db/list-shipments kit-uuid)))
|
||||
new-shipment-uuid (shipment-db/create-or-update-shipment current-shipment-uuid air-waybill)]
|
||||
(when (and (some? new-shipment-uuid) (not= new-shipment-uuid current-shipment-uuid))
|
||||
(kit-db/add-shipment-to-kit kit-uuid new-shipment-uuid))
|
||||
(if current-shipment-uuid
|
||||
current-shipment-uuid
|
||||
new-shipment-uuid)))
|
||||
|
||||
(defn create-update-delete-samples
|
||||
[kit-uuid shipment-uuid current-sample-map updated-sample-map]
|
||||
(let [updated-sample-type-uuids (set (keys updated-sample-map))
|
||||
current-sample-type-uuids (set (keys current-sample-map))
|
||||
new-sample-type-uuids (set/difference updated-sample-type-uuids current-sample-type-uuids)
|
||||
delete-sample-type-uuids (set/difference current-sample-type-uuids updated-sample-type-uuids)
|
||||
update-sample-type-uuids (set/intersection current-sample-type-uuids updated-sample-type-uuids)]
|
||||
(create-samples-and-add-to-kit-shipment kit-uuid shipment-uuid (select-keys updated-sample-map new-sample-type-uuids))
|
||||
(delete-samples current-sample-map delete-sample-type-uuids)
|
||||
(update-existing-samples shipment-uuid current-sample-map updated-sample-map update-sample-type-uuids)))
|
||||
|
||||
(defn update-existing-form-values
|
||||
[kit-uuid kit-type-uuid current-form-values new-form-values]
|
||||
(let [form-fields (form-type-db/get-form-type-fields kit-type-uuid)
|
||||
current-form-field-id-map (reduce (fn [m v] (assoc m (keyword (:field-id v)) (:uuid v))) {} current-form-values)]
|
||||
(doseq [form-value-field-id-key (keys new-form-values)]
|
||||
(let [current-form-value-id (get current-form-field-id-map form-value-field-id-key)
|
||||
updated-form-value-id (create-update-form-value (get current-form-field-id-map form-value-field-id-key) form-value-field-id-key form-fields new-form-values)]
|
||||
(when (nil? current-form-value-id) (kit-db/add-form-value-to-kit kit-uuid updated-form-value-id))))))
|
||||
|
||||
(defn delete-existing-form-values
|
||||
[current-form-values]
|
||||
(let [ids (map #(vector :form-value/uuid (:uuid %)) current-form-values)]
|
||||
(db/retract-entities ids)))
|
||||
|
||||
(defn delete-existing-create-new-form-values
|
||||
[kit-uuid kit-type-uuid current-form-values new-form-values]
|
||||
(delete-existing-form-values current-form-values)
|
||||
(create-form-values-and-add-to-kit kit-uuid kit-type-uuid new-form-values))
|
||||
|
||||
(defn update-form-values
|
||||
[kit-db-id current-kit-type-uuid updated-kit-type-uuid current-form-values new-form-values]
|
||||
(let [current-form-type (kit-type-db/get-kit-type-form-type current-kit-type-uuid)
|
||||
updated-form-type (kit-type-db/get-kit-type-form-type updated-kit-type-uuid)]
|
||||
; If the form-type hasn't changed we can just update the existing form values.
|
||||
; If it has changed then we should delete the existing values and create new ones.
|
||||
(if (= (:uuid current-form-type) (:uuid updated-form-type))
|
||||
(update-existing-form-values kit-db-id updated-kit-type-uuid current-form-values new-form-values)
|
||||
(delete-existing-create-new-form-values kit-db-id updated-kit-type-uuid current-form-values new-form-values))))
|
||||
|
||||
(defn get-kit-values
|
||||
[kit-uuid]
|
||||
(let [config-map {:uuid kit-uuid}
|
||||
kit (first (kit-db/list-kits config-map))
|
||||
sample-map (reduce (fn [m v] (assoc m (keyword (str (:sample-type-uuid v))) v)) {} (sample-db/list-samples config-map))
|
||||
form-values (form-value-db/list-form-values config-map)
|
||||
shipment (first (shipment-db/list-shipments config-map))]
|
||||
{:kit kit
|
||||
:samples sample-map
|
||||
:form-values form-values
|
||||
:shipment shipment}))
|
||||
|
||||
(defn remove-deleted-timepoints
|
||||
[kit-uuid updated-kit-map]
|
||||
(let [current-timepoints (timepoint-db/list-kit-timepoints {:uuid kit-uuid})
|
||||
current-timepoint-uuids (map :uuid current-timepoints)
|
||||
updated-timepoints-uuids (map #(UUID/fromString %) (:timepoints updated-kit-map))
|
||||
deleted-timepoints (set/difference (set current-timepoint-uuids) (set updated-timepoints-uuids))]
|
||||
(doseq [timepoint-uuid deleted-timepoints] (kit-db/remove-timepoint-from-kit kit-uuid timepoint-uuid))))
|
||||
|
||||
(defn update-kit-shipment
|
||||
[kit-uuid kit-map]
|
||||
(let [{:keys [air-waybill kit-type samples form-type-field-values]} kit-map
|
||||
config-map {:uuid kit-uuid}
|
||||
kit-type-uuid (UUID/fromString kit-type)
|
||||
current-kit (first (kit-db/list-kits config-map))
|
||||
current-sample-map (reduce (fn [m v] (assoc m (keyword (str (:sample-type-uuid v))) v)) {} (sample-db/list-samples config-map))
|
||||
current-form-values (form-value-db/list-form-values config-map)
|
||||
shipment-id (create-or-update-shipment kit-uuid air-waybill)]
|
||||
(kit-db/create-or-update-kit kit-uuid kit-map)
|
||||
(remove-deleted-timepoints kit-uuid kit-map)
|
||||
(create-update-delete-samples kit-uuid shipment-id current-sample-map samples)
|
||||
(update-form-values kit-uuid (:kit-type-uuid current-kit) kit-type-uuid current-form-values form-type-field-values)
|
||||
kit-uuid))
|
||||
|
||||
(defn update-kit-shipment-with-history
|
||||
[kit-uuid user kit-map]
|
||||
(let [current-kit-values (get-kit-values kit-uuid)]
|
||||
(update-kit-shipment kit-uuid kit-map)
|
||||
(history-db/create-history user :kit-shipment kit-uuid (str current-kit-values) (str (get-kit-values kit-uuid)))
|
||||
kit-uuid))
|
||||
|
||||
; If a kit hasn't been created, create it as complete otherwise update it to be complete. Send and email when done.
|
||||
(defn submit-kit-shipment
|
||||
[submitted-kit-uuid kit-map]
|
||||
(let [completed-kit-map (merge kit-map {:complete true :submission-timestamp (Date.)})
|
||||
kit-uuid (or submitted-kit-uuid (create-kit-shipment completed-kit-map))]
|
||||
(when-not (nil? submitted-kit-uuid)
|
||||
(update-kit-shipment kit-uuid completed-kit-map))
|
||||
(email/send-manifest-email kit-map kit-uuid)
|
||||
kit-uuid))
|
||||
|
||||
(defn set-kit-shipment-archived
|
||||
[kit-uuid user archived]
|
||||
(let [current-kit-values (get-kit-values kit-uuid)]
|
||||
(kit-db/set-archived kit-uuid archived)
|
||||
(doseq [shipment (shipment-db/list-shipments {:uuid kit-uuid})]
|
||||
(shipment-db/set-archived (:uuid shipment) archived))
|
||||
(history-db/create-history user :kit-shipment kit-uuid (str current-kit-values) (str (get-kit-values kit-uuid)))
|
||||
kit-uuid))
|
||||
179
src/clj/org/parkerici/sample_tracking/api/kit_type.clj
Normal file
179
src/clj/org/parkerici/sample_tracking/api/kit_type.clj
Normal file
@@ -0,0 +1,179 @@
|
||||
(ns org.parkerici.sample-tracking.api.kit-type
|
||||
"This file is focused on taking in a csv with kit and sample type definitions
|
||||
along with the studies, cohorts, and timepoints they belong to,
|
||||
parsing that csv, and then creating the appropriate values in the database."
|
||||
(:require [org.parkerici.sample-tracking.utils.csv :as csv]
|
||||
[org.parkerici.sample-tracking.configuration :as config]
|
||||
[clojure.string :as str]
|
||||
[clojure.set :as set]
|
||||
[org.parkerici.sample-tracking.db.study :as study-db]
|
||||
[org.parkerici.sample-tracking.db.cohort :as cohort-db]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.timepoint :as timepoint-db]
|
||||
[org.parkerici.sample-tracking.db.sample-type :as sample-type-db]
|
||||
[org.parkerici.sample-tracking.db.sample-attribute :as sample-attribute-db]))
|
||||
|
||||
; Used with filter to remove rows in the input CSV that don't have the required values.
|
||||
(defn row-has-required-values
|
||||
[row]
|
||||
(not (or (empty? (:study-name row))
|
||||
(empty? (:cohort-name row))
|
||||
(empty? (:kit-item-no row))
|
||||
(empty? (:kit-name row))
|
||||
(empty? (:sample-id-suffix row))
|
||||
(empty? (:sample-name row))
|
||||
(empty? (:kit-timepoints row))
|
||||
(empty? (:ships-with-kit row)))))
|
||||
|
||||
(defn read-csv
|
||||
[fpath]
|
||||
(filter row-has-required-values (drop 1 (csv/read-csv-file fpath))))
|
||||
|
||||
(defn find-or-create-study
|
||||
[study-name]
|
||||
(or (:uuid (study-db/find-study-by-name study-name)) (study-db/create-study study-name)))
|
||||
|
||||
(defn find-or-create-cohort-and-add-to-study
|
||||
[study-uuid cohort-name]
|
||||
(let [cohort-uuid (or (:uuid (cohort-db/find-cohort-by-name-and-study cohort-name study-uuid) (cohort-db/create-cohort cohort-name study-uuid)))]
|
||||
(when-not (study-db/cohort-associated-with-study study-uuid cohort-uuid)
|
||||
(study-db/add-cohort-to-study study-uuid cohort-uuid))
|
||||
cohort-uuid))
|
||||
|
||||
(defn create-kit-type-and-add-to-cohort
|
||||
[cohort-uuid kit-name kit-item-number vendor-email collection-date-required air-waybill-required]
|
||||
(let [kit-type-uuid (kit-type-db/create-kit-type kit-name kit-item-number vendor-email collection-date-required air-waybill-required)]
|
||||
(cohort-db/add-kit-type-to-cohort cohort-uuid kit-type-uuid)
|
||||
kit-type-uuid))
|
||||
|
||||
(defn add-attribute-to-sample-type
|
||||
[sample-type-uuid attribute value]
|
||||
(let [attribute-uuid (or (sample-attribute-db/find-sample-attribute attribute) (sample-attribute-db/create-sample-attribute attribute))
|
||||
value-uuid (or (sample-attribute-db/find-sample-attribute-value value attribute-uuid) (sample-attribute-db/create-sample-attribute-value value attribute-uuid))]
|
||||
(sample-type-db/add-attribute-value-to-sample-type sample-type-uuid value-uuid)))
|
||||
|
||||
(defn find-or-create-timepoint-and-add-to-kit-type
|
||||
[kit-type-uuid timepoint-name]
|
||||
(let [timepoint-uuid (or (timepoint-db/find-timepoint-uuid-from-name timepoint-name) (timepoint-db/create-timepoint timepoint-name))]
|
||||
(kit-type-db/add-timepoint-to-kit-type timepoint-uuid kit-type-uuid)))
|
||||
|
||||
(defn create-sample-type-and-add-to-kit-type
|
||||
[kit-type-uuid sample-name sample-id-suffix sample-ships-with-kit sample-reminder attributes-and-values]
|
||||
(let [sample-type-uuid (sample-type-db/create-sample-type sample-name sample-id-suffix sample-ships-with-kit sample-reminder)]
|
||||
(doseq [[attribute value] attributes-and-values]
|
||||
(add-attribute-to-sample-type sample-type-uuid attribute value))
|
||||
(kit-type-db/add-sample-type-to-kit-type sample-type-uuid kit-type-uuid)
|
||||
sample-type-uuid))
|
||||
|
||||
(defn parse-boolean
|
||||
[value]
|
||||
(case (str/lower-case value)
|
||||
"yes" true
|
||||
"no" false))
|
||||
|
||||
; Attributes and values are taken from any extra columns in the input CSV.
|
||||
; The first n columns are expected to map to the column names in (config/csv-file-headers :kit-type)
|
||||
; Any remaining columns after the first column are taken as attributes and values.
|
||||
; The column header is used as the attribute and the cell value for the row is used as the value for that attribute.
|
||||
(defn get-attributes-and-values
|
||||
[row]
|
||||
(let [attributes (set/difference (set (keys row)) (set (config/csv-file-headers :kit-type)))]
|
||||
(select-keys row attributes)))
|
||||
|
||||
(defn update-sample-types-map
|
||||
[row kit-type-map]
|
||||
(let [sample-types (or (:sample-types kit-type-map) [])
|
||||
sample-attributes-and-values (get-attributes-and-values row)
|
||||
sample-type {:name (:sample-name row)
|
||||
:id-suffix (:sample-id-suffix row)
|
||||
:ships-with-kit (parse-boolean (:ships-with-kit row))
|
||||
:reminders (:sample-reminders row)
|
||||
:attributes-and-values sample-attributes-and-values}
|
||||
updated-sample-types (conj sample-types sample-type)]
|
||||
updated-sample-types))
|
||||
|
||||
(defn update-kit-type-map
|
||||
[row kit-name cohort-map]
|
||||
(let [kit-type-map (or (get cohort-map kit-name) {})
|
||||
timepoints (or (:timepoints kit-type-map) (csv/split-csv-string (:kit-timepoints row)))
|
||||
item-number (or (:item-number kit-type-map) (Integer/parseInt (:kit-item-no row)))
|
||||
vendor-email (or (:vendor-email kit-type-map) (:vendor-email row))
|
||||
collection-date-required (or (:collection-date-required kit-type-map) (not (= (str/lower-case (:collection-date-optional row)) "true")))
|
||||
air-waybill-required (or (:air-waybill-required kit-type-map) (not (= (str/lower-case (:air-waybill-optional row)) "true")))
|
||||
sample-types (update-sample-types-map row kit-type-map)
|
||||
updated-kit-type-map (-> kit-type-map
|
||||
(assoc :sample-types sample-types)
|
||||
(assoc :timepoints timepoints)
|
||||
(assoc :item-number item-number)
|
||||
(assoc :vendor-email vendor-email)
|
||||
(assoc :collection-date-required collection-date-required)
|
||||
(assoc :air-waybill-required air-waybill-required))]
|
||||
updated-kit-type-map))
|
||||
|
||||
(defn update-cohort-map
|
||||
[row cohort-name study-map]
|
||||
(let [cohort-map (or (get study-map cohort-name) {})
|
||||
kit-name (:kit-name row)
|
||||
kit-type-map (update-kit-type-map row kit-name cohort-map)
|
||||
updated-cohort-map (assoc cohort-map kit-name kit-type-map)]
|
||||
updated-cohort-map))
|
||||
|
||||
(defn update-study-map
|
||||
[row study-name m]
|
||||
(let [study-map (or (get m study-name) {})
|
||||
cohort-name (:cohort-name row)
|
||||
cohort-map (update-cohort-map row cohort-name study-map)
|
||||
updated-study-map (assoc study-map cohort-name cohort-map)]
|
||||
updated-study-map))
|
||||
|
||||
(defn build-type-map
|
||||
[csv-data]
|
||||
(reduce (fn [type-map row]
|
||||
(let [study-name (:study-name row)
|
||||
study-map (update-study-map row study-name type-map)
|
||||
updated-m (assoc type-map study-name study-map)]
|
||||
updated-m)) {} csv-data))
|
||||
|
||||
(defn process-sample-type-map
|
||||
[kit-type-uuid sample-type-map]
|
||||
(create-sample-type-and-add-to-kit-type kit-type-uuid
|
||||
(:name sample-type-map)
|
||||
(:id-suffix sample-type-map)
|
||||
(:ships-with-kit sample-type-map)
|
||||
(:reminders sample-type-map)
|
||||
(:attributes-and-values sample-type-map)))
|
||||
|
||||
(defn process-kit-type-map
|
||||
[cohort-uuid kit-type-name kit-type-map]
|
||||
(when-not (kit-type-db/find-active-kit-type-by-name-and-cohort kit-type-name cohort-uuid)
|
||||
(let [kit-type-uuid (create-kit-type-and-add-to-cohort
|
||||
cohort-uuid kit-type-name (:item-number kit-type-map) (:vendor-email kit-type-map)
|
||||
(:collection-date-required kit-type-map) (:air-waybill-required kit-type-map))]
|
||||
(doseq [timepoint (:timepoints kit-type-map)]
|
||||
(find-or-create-timepoint-and-add-to-kit-type kit-type-uuid timepoint))
|
||||
(doseq [sample-type (:sample-types kit-type-map)]
|
||||
(process-sample-type-map kit-type-uuid sample-type)))))
|
||||
|
||||
(defn process-cohort-map
|
||||
[study-uuid cohort-name cohort-map]
|
||||
(let [cohort-uuid (find-or-create-cohort-and-add-to-study study-uuid cohort-name)]
|
||||
(doseq [kit-type (keys cohort-map)]
|
||||
(process-kit-type-map cohort-uuid kit-type (get cohort-map kit-type)))))
|
||||
|
||||
(defn process-study-map
|
||||
[study-name study-map]
|
||||
(let [study-uuid (find-or-create-study study-name)]
|
||||
(doseq [cohort (keys study-map)]
|
||||
(process-cohort-map study-uuid cohort (get study-map cohort)))))
|
||||
|
||||
(defn process-type-map
|
||||
[type-map]
|
||||
(doseq [study (keys type-map)]
|
||||
(process-study-map study (get type-map study))))
|
||||
|
||||
(defn parse-kit-type-csv-and-save-to-db
|
||||
[fpath]
|
||||
(let [csv-headers (config/csv-file-headers :kit-type)
|
||||
csv-data (csv/read-csv-into-map fpath csv-headers row-has-required-values)
|
||||
type-map (build-type-map csv-data)]
|
||||
(process-type-map type-map)))
|
||||
20
src/clj/org/parkerici/sample_tracking/api/migrate.clj
Normal file
20
src/clj/org/parkerici/sample_tracking/api/migrate.clj
Normal file
@@ -0,0 +1,20 @@
|
||||
(ns org.parkerici.sample-tracking.api.migrate
|
||||
(:require [org.parkerici.sample-tracking.db.migration :as migration]
|
||||
[org.parkerici.sample-tracking.db.migration.air-waybill-required :as air-waybill-migration]
|
||||
[taoensso.timbre :as log]))
|
||||
|
||||
(defn migrate-kit-types-without-air-waybill-required
|
||||
[]
|
||||
(doseq [to-migrate (air-waybill-migration/list-kit-types-without-air-waybill-required)]
|
||||
(air-waybill-migration/set-kit-type-air-waybill-required (:uuid to-migrate) true)))
|
||||
|
||||
(defn run-migration
|
||||
[name fn]
|
||||
(when-not (migration/migration-has-been-run name)
|
||||
(log/info "Running migration" name)
|
||||
(fn)
|
||||
(migration/create-migration name)))
|
||||
|
||||
(defn run-pending-migrations
|
||||
[]
|
||||
(run-migration "add-kit-type-air-waybill" migrate-kit-types-without-air-waybill-required))
|
||||
181
src/clj/org/parkerici/sample_tracking/api/propose_kit_edits.clj
Normal file
181
src/clj/org/parkerici/sample_tracking/api/propose_kit_edits.clj
Normal file
@@ -0,0 +1,181 @@
|
||||
(ns org.parkerici.sample-tracking.api.propose-kit-edits
|
||||
(:require [clojure.edn :as edn]
|
||||
[org.parkerici.sample-tracking.api.kit-shipment :as kit-shipment]
|
||||
[org.parkerici.sample-tracking.db.proposed-kit-edit :as proposed-kit-edit-db]
|
||||
[org.parkerici.sample-tracking.db.site :as site-db]
|
||||
[org.parkerici.sample-tracking.db.study :as study-db]
|
||||
[org.parkerici.sample-tracking.db.cohort :as cohort-db]
|
||||
[org.parkerici.sample-tracking.db.form-type :as form-type-db]
|
||||
[org.parkerici.sample-tracking.db.kit-type :as kit-type-db]
|
||||
[org.parkerici.sample-tracking.db.sample-type :as sample-type-db]
|
||||
[org.parkerici.sample-tracking.db.timepoint :as timepoint-db]
|
||||
[org.parkerici.sample-tracking.api.email :as email]
|
||||
[org.parkerici.sample-tracking.utils.collection :as coll-utils])
|
||||
(:import (java.util UUID)))
|
||||
|
||||
(defn propose-kit-edits
|
||||
[kit-map user-email]
|
||||
(let [kit-uuid (UUID/fromString (:uuid kit-map))
|
||||
pending-proposed-edit-uuid (:uuid (first (proposed-kit-edit-db/list-proposed-edits {:kit-uuid kit-uuid :status "pending"})))
|
||||
uuid (proposed-kit-edit-db/create-or-update-proposed-edit pending-proposed-edit-uuid kit-uuid (str kit-map) user-email)]
|
||||
(email/send-proposed-edit-email kit-map user-email)
|
||||
uuid))
|
||||
|
||||
(defn list-proposed-edits
|
||||
[config-map]
|
||||
(let [proposed-edits (proposed-kit-edit-db/list-proposed-edits config-map)
|
||||
timepoints (timepoint-db/list-kit-timepoints config-map)]
|
||||
(coll-utils/merge-map-colls proposed-edits :kit-uuid timepoints :kit-uuid :timepoints)))
|
||||
|
||||
(defn convert-update-map-to-display-map
|
||||
"There are three formats of maps for kits. Form maps for populating edit forms, display maps for generating a view page
|
||||
using manifest.cljc, and create/update maps for creating or updating kits.
|
||||
This function converts an update map to a display map."
|
||||
[update-map]
|
||||
(let [kit-type-uuid (UUID/fromString (:kit-type update-map))
|
||||
site-name (:name (site-db/find-site-by-uuid (UUID/fromString (:site update-map))))
|
||||
study-name (:name (study-db/find-study-by-uuid (UUID/fromString (:study update-map))))
|
||||
cohort-name (:name (cohort-db/find-cohort-by-uuid (UUID/fromString (:cohort update-map))))
|
||||
timepoint-names (map #(:name (timepoint-db/find-timepoint-by-uuid (UUID/fromString %))) (:timepoints update-map))
|
||||
kit-name (kit-type-db/get-kit-type-name kit-type-uuid)
|
||||
collection-timestamp (:collection-timestamp update-map)
|
||||
selected-form-type-fields (form-type-db/get-form-type-fields kit-type-uuid)
|
||||
selected-sample-types (sample-type-db/list-sample-types kit-type-uuid)
|
||||
unchaged-update-map (select-keys update-map [:kit-id :participant-id :form-type-field-values :air-waybill
|
||||
:completing-first-name :completing-last-name :completing-email
|
||||
:comments :complete])
|
||||
display-map {:site-name site-name
|
||||
:study-name study-name
|
||||
:cohort-name cohort-name
|
||||
:timepoint-names timepoint-names
|
||||
:kit-name kit-name
|
||||
:collection-date collection-timestamp
|
||||
:collection-time collection-timestamp
|
||||
:selected-form-type-fields selected-form-type-fields
|
||||
:selected-sample-types selected-sample-types
|
||||
:sample-values (:samples update-map)
|
||||
:archived false
|
||||
}]
|
||||
(merge display-map unchaged-update-map)))
|
||||
|
||||
(defn convert-form-map-to-display-map
|
||||
"There are three formats of maps for kits. Form maps for populating edit forms, display maps for generating a view page
|
||||
using manifest.cljc, and create/update maps for creating or updating kits.
|
||||
This function converts an edit form map to a display map."
|
||||
[original-map]
|
||||
(let [kit-type-uuid (:kit-type-uuid original-map)
|
||||
site-name (:name (site-db/find-site-by-uuid (:site-uuid original-map)))
|
||||
study-name (:name (study-db/find-study-by-uuid (:study-uuid original-map)))
|
||||
cohort-name (:name (cohort-db/find-cohort-by-uuid (:cohort-uuid original-map)))
|
||||
timepoint-names (map :timepoint-name (:timepoints original-map))
|
||||
kit-name (kit-type-db/get-kit-type-name kit-type-uuid)
|
||||
collection-timestamp (:collection-timestamp original-map)
|
||||
selected-form-type-fields (form-type-db/get-form-type-fields kit-type-uuid)
|
||||
form-type-field-values (reduce (fn [m v]
|
||||
(assoc m (keyword (:field-id v)) (:value v))) {} (:form-values original-map))
|
||||
selected-sample-types (sample-type-db/list-sample-types kit-type-uuid)
|
||||
samples (reduce (fn [m s] (assoc m (:sample-type-uuid s) s)) {} (:samples original-map))
|
||||
air-waybill (:air-waybill (first (:shipments original-map)))
|
||||
unchaged-map-entries (select-keys original-map [:kit-id :participant-id :completing-first-name
|
||||
:completing-last-name :completing-email :comments :complete
|
||||
:archived])
|
||||
display-map {:site-name site-name
|
||||
:study-name study-name
|
||||
:cohort-name cohort-name
|
||||
:timepoint-names timepoint-names
|
||||
:kit-name kit-name
|
||||
:collection-date collection-timestamp
|
||||
:collection-time collection-timestamp
|
||||
:selected-form-type-fields selected-form-type-fields
|
||||
:form-type-field-values form-type-field-values
|
||||
:selected-sample-types selected-sample-types
|
||||
:sample-values samples
|
||||
:air-waybill air-waybill
|
||||
:archived false
|
||||
}]
|
||||
(merge display-map unchaged-map-entries)))
|
||||
|
||||
(defn get-proposed-kit-edit-for-display
|
||||
[uuid]
|
||||
(let [proposed-edit (first (proposed-kit-edit-db/list-proposed-edits {:uuid uuid}))
|
||||
tx-id (proposed-kit-edit-db/get-proposed-edit-tx-id uuid)
|
||||
unedited-map (first (kit-shipment/list-kit-shipment {:uuid (:kit-uuid proposed-edit) :tx-id tx-id}))
|
||||
unedited-display-map (convert-form-map-to-display-map unedited-map)
|
||||
update-map (edn/read-string (:update-map proposed-edit))
|
||||
updated-display-map (convert-update-map-to-display-map update-map)]
|
||||
{:original-map unedited-display-map :update-map updated-display-map :status (:status proposed-edit)}))
|
||||
|
||||
(defn get-proposed-kit-edit
|
||||
[uuid]
|
||||
(first (proposed-kit-edit-db/list-proposed-edits {:uuid uuid})))
|
||||
|
||||
(defn approve-proposed-kit-edit
|
||||
[uuid reviewing-user]
|
||||
(let [proposed-edit (first (proposed-kit-edit-db/list-proposed-edits {:uuid uuid}))
|
||||
update-map (edn/read-string (:update-map proposed-edit))]
|
||||
(kit-shipment/update-kit-shipment-with-history (:kit-uuid proposed-edit) reviewing-user update-map)
|
||||
(proposed-kit-edit-db/approve-proposed-edit uuid reviewing-user)))
|
||||
|
||||
(defn deny-proposed-kit-edit
|
||||
[uuid reviewing-user]
|
||||
(proposed-kit-edit-db/deny-proposed-edit uuid reviewing-user))
|
||||
|
||||
(defn kit-has-pending-edits
|
||||
[uuid]
|
||||
(> (count (proposed-kit-edit-db/list-proposed-edits {:uuid uuid :status "pending"})) 0))
|
||||
|
||||
(defn convert-update-map-form-values
|
||||
[kit-type form-type-field-values]
|
||||
(let [form-type-fields (form-type-db/get-form-type-fields (UUID/fromString kit-type))
|
||||
updated-form-values form-type-field-values]
|
||||
(map (fn [field-key]
|
||||
(let [field (first (filter #(= (name field-key) (:field-id %)) form-type-fields))
|
||||
value (get updated-form-values field-key)
|
||||
field-type (:type field)
|
||||
field-id (:field-id field)]
|
||||
(-> {}
|
||||
(assoc :field-id field-id)
|
||||
(assoc :value value)
|
||||
(assoc :field-type field-type))))
|
||||
(keys updated-form-values))))
|
||||
|
||||
(defn convert-update-map-to-form-map
|
||||
" There are three formats of maps for kits. Form maps for populating edit forms, display maps for generating a view page
|
||||
using manifest.cljc, and create/update maps for creating or updating kits.
|
||||
This function converts an update map to an edit form map."
|
||||
[proposed-edit]
|
||||
(let [proposed-edit-uuid (:uuid proposed-edit)
|
||||
proposed-edit-email (:email proposed-edit)
|
||||
proposed-edit-time (:time proposed-edit)
|
||||
update-map (edn/read-string (:update-map proposed-edit))
|
||||
{:keys [samples timepoints form-type-field-values air-waybill site kit-type cohort study]} update-map
|
||||
form-samples (map (fn [sample-type-uuid]
|
||||
(let [sample (get samples sample-type-uuid)]
|
||||
(assoc sample :sample-type-uuid sample-type-uuid)))
|
||||
(keys samples))
|
||||
form-timepoints (map #(assoc {} :uuid %) timepoints)
|
||||
shipments [{:air-waybill air-waybill}]
|
||||
form-values (convert-update-map-form-values kit-type form-type-field-values)
|
||||
unchaged-map-entries (select-keys update-map [:timezone :completing-last-name :collection-timestamp
|
||||
:completing-email :comments :completing-first-name
|
||||
:participant-id :kit-id :uuid])
|
||||
form-map {:pending-edits [{:uuid proposed-edit-uuid :email proposed-edit-email :time proposed-edit-time}]
|
||||
:samples form-samples
|
||||
:timepoints form-timepoints
|
||||
:shipments shipments
|
||||
:site-uuid site
|
||||
:kit-type-uuid kit-type
|
||||
:cohort-uuid cohort
|
||||
:form-values form-values
|
||||
:study-uuid study}]
|
||||
(merge unchaged-map-entries form-map)))
|
||||
|
||||
(defn get-kit-or-proposed-edit
|
||||
"Gets a kit map if there is no pending proposed edit, otherwise gets a map of the pending proposed edit. When using
|
||||
this function you should get the kit from kit-shipment first so that the email filtering from the config-map is used."
|
||||
[config-map]
|
||||
(let [kit (first (kit-shipment/list-kit-shipment config-map))]
|
||||
(if (= (count (:pending-edits kit)) 0)
|
||||
kit
|
||||
(let [pending-proposed-edit (first (proposed-kit-edit-db/list-proposed-edits {:kit-uuid (:uuid kit) :status "pending"}))]
|
||||
(convert-update-map-to-form-map pending-proposed-edit)))))
|
||||
31
src/clj/org/parkerici/sample_tracking/api/site.clj
Normal file
31
src/clj/org/parkerici/sample_tracking/api/site.clj
Normal file
@@ -0,0 +1,31 @@
|
||||
(ns org.parkerici.sample-tracking.api.site
|
||||
"This file deals with reading in a csv with sites along with the studies they are running,
|
||||
parsing that csv, and then creating the appropriate associations of sites with studies in the database."
|
||||
(:require [org.parkerici.sample-tracking.utils.csv :as csv]
|
||||
[org.parkerici.sample-tracking.configuration :as config]
|
||||
[org.parkerici.sample-tracking.db.study :as study-db]
|
||||
[org.parkerici.sample-tracking.db.site :as site-db]))
|
||||
|
||||
; Used with filter to remove rows in the input CSV that don't have the required values.
|
||||
(defn row-has-required-values
|
||||
[row]
|
||||
(not (or (empty? (:site row))
|
||||
(empty? (:study-names row)))))
|
||||
|
||||
(defn find-or-create-site
|
||||
[name]
|
||||
(or (:id (site-db/find-site-by-name name)) (site-db/create-site name)))
|
||||
|
||||
(defn create-site
|
||||
[row]
|
||||
(let [site-uuid (find-or-create-site (:site row))
|
||||
study-names (csv/split-csv-string (:study-names row))]
|
||||
(doseq [study-name study-names]
|
||||
(when-not (study-db/site-is-associated-with-study site-uuid study-name)
|
||||
(study-db/add-site-to-study site-uuid study-name)))))
|
||||
|
||||
(defn parse-site-csv-and-save-to-db
|
||||
[fpath]
|
||||
(let [csv-headers (config/csv-file-headers :site)
|
||||
csv-data (csv/read-csv-into-map fpath csv-headers row-has-required-values)]
|
||||
(doseq [row csv-data] (create-site row))))
|
||||
28
src/clj/org/parkerici/sample_tracking/api/study.clj
Normal file
28
src/clj/org/parkerici/sample_tracking/api/study.clj
Normal file
@@ -0,0 +1,28 @@
|
||||
(ns org.parkerici.sample-tracking.api.study
|
||||
"This file deals with reading in a csv with studies along with validation information for participant and kit ids,
|
||||
parsing that csv, and then creating the appropriate associations of studies with validation information."
|
||||
(:require [org.parkerici.sample-tracking.utils.csv :as csv]
|
||||
[org.parkerici.sample-tracking.configuration :as config]
|
||||
[org.parkerici.sample-tracking.db.study :as study-db]
|
||||
[org.parkerici.sample-tracking.utils.str :as str]))
|
||||
|
||||
; Used with filter to remove rows in the input CSV that don't have the required values.
|
||||
(defn row-has-required-values
|
||||
[row]
|
||||
(str/not-blank? (:study row)))
|
||||
|
||||
(defn add-validation-to-study
|
||||
[row]
|
||||
(let [{:keys [study participant-id-prefix participant-id-regex participant-id-validation-message kit-id-prefix
|
||||
kit-id-regex kit-id-validation-message]} row]
|
||||
(when (str/not-blank? participant-id-regex)
|
||||
(study-db/add-participant-id-validation-to-study study participant-id-prefix participant-id-regex participant-id-validation-message))
|
||||
(when (str/not-blank? kit-id-regex)
|
||||
(study-db/add-kit-id-validation-to-study study kit-id-prefix kit-id-regex kit-id-validation-message))))
|
||||
|
||||
(defn parse-study-csv-and-save-to-db
|
||||
[fpath]
|
||||
(let [csv-headers (config/csv-file-headers :study)
|
||||
csv-data (csv/read-csv-into-map fpath csv-headers row-has-required-values)]
|
||||
(doseq [row csv-data]
|
||||
(add-validation-to-study row))))
|
||||
99
src/clj/org/parkerici/sample_tracking/cli.clj
Normal file
99
src/clj/org/parkerici/sample_tracking/cli.clj
Normal file
@@ -0,0 +1,99 @@
|
||||
(ns org.parkerici.sample-tracking.cli
|
||||
(:gen-class)
|
||||
(:require [org.parkerici.sample-tracking.db.schema :as schema]
|
||||
[org.parkerici.sample-tracking.api.iam :as auth]
|
||||
[org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.server :as server]
|
||||
[org.parkerici.sample-tracking.api.kit-type :as kit-type]
|
||||
[org.parkerici.sample-tracking.api.site :as site]
|
||||
[org.parkerici.sample-tracking.api.study :as study]
|
||||
[org.parkerici.sample-tracking.api.form-type :as form-type]
|
||||
[org.parkerici.sample-tracking.api.migrate :as migrate]
|
||||
[org.parkerici.sample-tracking.configuration :as c]
|
||||
[clojure.java.io :as io]
|
||||
[taoensso.timbre :as log]
|
||||
[clojure.tools.cli :as cli]
|
||||
[clojure.string :as str]
|
||||
[org.parkerici.sample-tracking.api.iam :as iam]))
|
||||
|
||||
(def default-port 1777)
|
||||
|
||||
(defmulti command
|
||||
(fn [command _arguments _options _summary] command))
|
||||
|
||||
(defmethod command "predeploy"
|
||||
[_ _ _ _]
|
||||
(log/info "Transacting schema.")
|
||||
(schema/transact-schema)
|
||||
(log/info "Running pending migrations.")
|
||||
(d/wrap-datomic-fn migrate/run-pending-migrations)
|
||||
(log/info "Initializing roles.")
|
||||
(d/wrap-datomic-fn #(doall (map auth/find-or-create-role (c/application-role-values)))))
|
||||
|
||||
(defmethod command "test-setup"
|
||||
[_ _ _ _]
|
||||
(schema/transact-schema)
|
||||
(d/wrap-datomic-fn #(doall (map auth/find-or-create-role (c/application-role-values))))
|
||||
(d/wrap-datomic-fn #(iam/find-or-create-user "test@example.com"))
|
||||
(d/wrap-datomic-fn #(kit-type/parse-kit-type-csv-and-save-to-db (io/resource "forms/kit_types.csv")))
|
||||
(d/wrap-datomic-fn #(site/parse-site-csv-and-save-to-db (io/resource "forms/sites.csv")))
|
||||
(d/wrap-datomic-fn #(study/parse-study-csv-and-save-to-db (io/resource "forms/studies.csv")))
|
||||
(d/wrap-datomic-fn #(form-type/parse-form-type-csv-and-save-to-db (io/resource "forms/form_types.csv"))))
|
||||
|
||||
(defmethod command "transact-schema"
|
||||
[_ _ _ _]
|
||||
(log/info "Transacting schema.")
|
||||
(schema/transact-schema))
|
||||
|
||||
(defmethod command "create-roles"
|
||||
[_ _ _ _]
|
||||
(d/wrap-datomic-fn #(doall (map auth/find-or-create-role (c/application-role-values)))))
|
||||
|
||||
(defmethod command "add-admin"
|
||||
[_ arguments _ _]
|
||||
(let [user (first arguments)]
|
||||
(d/wrap-datomic-fn #(auth/add-role-to-user user (c/application-admin-role)))))
|
||||
|
||||
(defmethod command "server"
|
||||
[_ _ options _]
|
||||
(let [port (if (:port options) (Integer. (:port options)) default-port)]
|
||||
(server/start port)))
|
||||
|
||||
(defmethod command "run-pending-migrations"
|
||||
[_ _ _ _]
|
||||
(log/info "Running pending migrations")
|
||||
(d/wrap-datomic-fn migrate/run-pending-migrations))
|
||||
|
||||
(defn all-commands []
|
||||
(sort (keys (dissoc (methods command) :default))))
|
||||
|
||||
(defn usage
|
||||
[options-summary]
|
||||
(->> [""
|
||||
"Usage: java -jar sample-tracking.jar [ACTION] [OPTIONS]..."
|
||||
""
|
||||
"Actions:"
|
||||
(print-str (all-commands))
|
||||
""
|
||||
"Options:"
|
||||
options-summary]
|
||||
(str/join \newline)))
|
||||
|
||||
(defmethod command "help"
|
||||
[_ _ summary]
|
||||
(println (usage summary)))
|
||||
|
||||
(defmethod command :default
|
||||
[command _ summary]
|
||||
(log/error "Unknown command:" command)
|
||||
(println (usage summary)))
|
||||
|
||||
(def cli-options
|
||||
;; An option with a required argument
|
||||
[["-p" "--port PORT" "Port for the server to start on"]])
|
||||
|
||||
(defn -main
|
||||
[& args]
|
||||
(let [{:keys [options arguments summary]} (cli/parse-opts args cli-options)]
|
||||
(log/info "Running with environment" (c/environment))
|
||||
(command (first arguments) (rest arguments) options summary)))
|
||||
130
src/clj/org/parkerici/sample_tracking/configuration.clj
Normal file
130
src/clj/org/parkerici/sample_tracking/configuration.clj
Normal file
@@ -0,0 +1,130 @@
|
||||
(ns org.parkerici.sample-tracking.configuration
|
||||
(:require [aero.core :as aero]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(defn environment
|
||||
"Retrieves which profile we should be using based on which environment we're deployed to"
|
||||
[]
|
||||
(let [env (System/getenv "DEPLOY_ENVIRONMENT")]
|
||||
(if (empty? env)
|
||||
:default
|
||||
(keyword env))))
|
||||
|
||||
(def config (aero/read-config (io/resource "config.edn") {:profile (environment)}))
|
||||
|
||||
(defn datomic-config
|
||||
[]
|
||||
(:datomic config))
|
||||
|
||||
(defn datomic-endpoint
|
||||
[]
|
||||
(:endpoint (datomic-config)))
|
||||
|
||||
(defn datomic-access-key
|
||||
[]
|
||||
(:access-key (datomic-config)))
|
||||
|
||||
(defn datomic-secret
|
||||
[]
|
||||
(:secret (datomic-config)))
|
||||
|
||||
(defn datomic-db-name
|
||||
[]
|
||||
(:db-name (datomic-config)))
|
||||
|
||||
(defn datomic-validate-hostnames
|
||||
[]
|
||||
(:validate-hostnames (datomic-config)))
|
||||
|
||||
(defn application-config
|
||||
[]
|
||||
(:application config))
|
||||
|
||||
(defn firebase-js-credentials-path
|
||||
[]
|
||||
(:firebase-js-credentials-path (application-config)))
|
||||
|
||||
(defn application-roles
|
||||
[]
|
||||
(:roles (application-config)))
|
||||
|
||||
(defn application-role-values
|
||||
[]
|
||||
(vals (application-roles)))
|
||||
|
||||
(defn application-admin-role
|
||||
[]
|
||||
(:admin (application-roles)))
|
||||
|
||||
(defn application-editor-role
|
||||
[]
|
||||
(:editor (application-roles)))
|
||||
|
||||
(defn application-viewer-role
|
||||
[]
|
||||
(:viewer (application-roles)))
|
||||
|
||||
(defn site-admin-role
|
||||
[]
|
||||
(:site-admin (application-roles)))
|
||||
|
||||
(defn site-coordinator-role
|
||||
[]
|
||||
(:site-coordinator (application-roles)))
|
||||
|
||||
(defn csv-files-config
|
||||
[]
|
||||
(:csv-files (application-config)))
|
||||
|
||||
(defn csv-file-headers
|
||||
[file]
|
||||
(get-in (csv-files-config) [file :headers]))
|
||||
|
||||
(defn email-config
|
||||
[]
|
||||
(:email (application-config)))
|
||||
|
||||
(defn sendgrid-api-key
|
||||
[]
|
||||
(:sendgrid-api-key (email-config)))
|
||||
|
||||
(defn email-sender
|
||||
[]
|
||||
(:sender (email-config)))
|
||||
|
||||
(defn email-manifest-recipient
|
||||
[]
|
||||
(:manifest-recipient (email-config)))
|
||||
|
||||
(defn send-manifest-emails
|
||||
[]
|
||||
(= (str/lower-case (:send-manifest-emails (email-config))) "true"))
|
||||
|
||||
(defn send-vendor-emails
|
||||
[]
|
||||
(= (str/lower-case (:send-vendor-emails (email-config))) "true"))
|
||||
|
||||
(defn temp-path
|
||||
[]
|
||||
(:temp-path (application-config)))
|
||||
|
||||
(defn api-key
|
||||
[]
|
||||
(:api-key (application-config)))
|
||||
|
||||
(defn sample-export-config
|
||||
[]
|
||||
(:sample-export (application-config)))
|
||||
|
||||
(defn sample-export-columns-to-drop
|
||||
[]
|
||||
(:columns-to-drop (sample-export-config)))
|
||||
|
||||
(defn sample-export-column-order
|
||||
[]
|
||||
(:column-order (sample-export-config)))
|
||||
|
||||
(defn sample-export-columns-to-rename
|
||||
[]
|
||||
(:columns-to-rename (sample-export-config)))
|
||||
73
src/clj/org/parkerici/sample_tracking/db/cohort.clj
Normal file
73
src/clj/org/parkerici/sample_tracking/db/cohort.clj
Normal file
@@ -0,0 +1,73 @@
|
||||
(ns org.parkerici.sample-tracking.db.cohort
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-cohort
|
||||
[name study-uuid]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:cohort/name name :cohort/uuid uuid :cohort/create-time (Date.) :cohort/study [:study/uuid study-uuid]}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn add-kit-type-to-cohort
|
||||
[cohort-uuid kit-type-uuid]
|
||||
(d/transact [[:db/add [:cohort/uuid cohort-uuid] :cohort/kit-types [[:kit-type/uuid kit-type-uuid] true]]]))
|
||||
|
||||
; TODO - Try converting to a pull
|
||||
(defn find-cohort-by-name-and-study
|
||||
[cohort-name study-uuid]
|
||||
(first (d/q-latest '[:find ?uuid ?create-time
|
||||
:keys uuid create-time
|
||||
:in $ ?cohort-name ?study-uuid
|
||||
:where
|
||||
[?cohort :cohort/uuid ?uuid]
|
||||
[?cohort :cohort/name ?cohort-name]
|
||||
[?cohort :cohort/create-time ?create-time]
|
||||
[?cohort :cohort/study ?study]
|
||||
[?study :study/uuid ?study-uuid]]
|
||||
cohort-name study-uuid)))
|
||||
|
||||
(defn find-cohort-by-uuid
|
||||
[uuid]
|
||||
(first (d/q-latest '[:find ?cohort-name ?create-time
|
||||
:keys name create-time
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?cohort :cohort/uuid ?uuid]
|
||||
[?cohort :cohort/name ?cohort-name]
|
||||
[?cohort :cohort/create-time ?create-time]]
|
||||
uuid)))
|
||||
|
||||
(defn list-cohorts
|
||||
[study-uuid active]
|
||||
(let [query {:find '[?cohort-uuid ?cohort-name ?active ?create-time]
|
||||
:keys '[uuid name active create-time]
|
||||
:where '[[?study :study/uuid ?study-uuid]
|
||||
[?study :study/cohorts ?cohort-tuple]
|
||||
[(untuple ?cohort-tuple) [?cohort ?active]]
|
||||
[?cohort :cohort/name ?cohort-name]
|
||||
[?cohort :cohort/uuid ?cohort-uuid]
|
||||
[?cohort :cohort/create-time ?create-time]]}
|
||||
filtered-query (if (nil? active)
|
||||
(assoc query :in '[$ ?study-uuid])
|
||||
(assoc query :in '[$ ?study-uuid ?active]))]
|
||||
(apply d/q-latest (remove nil? [filtered-query study-uuid active]))))
|
||||
|
||||
(defn update-cohort
|
||||
[uuid name]
|
||||
(d/transact [{:db/id [:cohort/uuid uuid]
|
||||
:cohort/name name}]))
|
||||
|
||||
(defn update-cohort-active-status
|
||||
[study-uuid cohort-uuid status]
|
||||
(let [current-tuple (first (d/q-latest '[:find ?cohort ?active
|
||||
:in $ ?cohort-uuid ?study-uuid
|
||||
:where
|
||||
[?study :study/uuid ?study-uuid]
|
||||
[?study :study/cohorts ?cohort-tuple]
|
||||
[(untuple ?cohort-tuple) [?cohort ?active]]
|
||||
[?cohort :cohort/uuid ?cohort-uuid]]
|
||||
cohort-uuid study-uuid))]
|
||||
(when (some? current-tuple) (d/transact [[:db/retract [:study/uuid study-uuid] :study/cohorts current-tuple]]))
|
||||
(d/transact [[:db/add [:study/uuid study-uuid] :study/cohorts [[:cohort/uuid cohort-uuid] status]]])))
|
||||
42
src/clj/org/parkerici/sample_tracking/db/core.clj
Normal file
42
src/clj/org/parkerici/sample_tracking/db/core.clj
Normal file
@@ -0,0 +1,42 @@
|
||||
(ns org.parkerici.sample-tracking.db.core
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[clojure.core.reducers :as r])
|
||||
(:import (java.util UUID)))
|
||||
|
||||
(defn squuid []
|
||||
(let [uuid (UUID/randomUUID)
|
||||
time (System/currentTimeMillis)
|
||||
secs (quot time 1000)
|
||||
lsb (.getLeastSignificantBits uuid)
|
||||
msb (.getMostSignificantBits uuid)
|
||||
timed-msb (bit-or (bit-shift-left secs 32)
|
||||
(bit-and 0x00000000ffffffff msb))]
|
||||
(UUID. timed-msb lsb)))
|
||||
|
||||
(defn remove-nil-map-values
|
||||
[map]
|
||||
(into {} (filter #(not (nil? (second %))) map)))
|
||||
|
||||
(defn reduce-fn-filter
|
||||
[map-coll fn]
|
||||
(into [] (r/filter fn map-coll)))
|
||||
|
||||
(defn reducer-filter
|
||||
[map-coll key value]
|
||||
(reduce-fn-filter map-coll (fn [map] (= (get map key) value))))
|
||||
|
||||
; Convenience function. Assumes that the passed in transaction will create/modify one entity.
|
||||
; Runs the transaction and returns the id of the created entity.
|
||||
(defn transact-and-return-id
|
||||
[txn]
|
||||
(let [transaction-results (d/transact (map remove-nil-map-values txn))]
|
||||
(first (vals (:tempids transaction-results)))))
|
||||
|
||||
(defn transact
|
||||
[txn]
|
||||
(d/transact (map remove-nil-map-values txn)))
|
||||
|
||||
(defn retract-entities
|
||||
[db-ids]
|
||||
(let [txns (for [db-id db-ids] [:db/retractEntity db-id])]
|
||||
(d/transact txns)))
|
||||
110
src/clj/org/parkerici/sample_tracking/db/datomic.clj
Normal file
110
src/clj/org/parkerici/sample_tracking/db/datomic.clj
Normal file
@@ -0,0 +1,110 @@
|
||||
(ns org.parkerici.sample-tracking.db.datomic
|
||||
(:require [datomic.client.api :as d]
|
||||
[org.parkerici.multitool.core :as u]
|
||||
[org.parkerici.sample-tracking.configuration :as c]))
|
||||
|
||||
;;; Source https://gist.github.com/natural/871d7a3ddfb6ae5f72fb141e549ca3bb
|
||||
(def ^{:dynamic true :doc "A Datomic database value used over the life of a Ring or CLI request."} *db*)
|
||||
(def ^{:dynamic true :doc "A Datomic connection bound for the life of a Ring or CLI request."} *connection*)
|
||||
|
||||
(defn config
|
||||
[]
|
||||
{:server-type :peer-server
|
||||
:access-key (c/datomic-access-key)
|
||||
:secret (c/datomic-secret)
|
||||
:endpoint (c/datomic-endpoint)
|
||||
:validate-hostnames (c/datomic-validate-hostnames)})
|
||||
|
||||
;;; Ben@Cognitect says that this caches behind the scenes, no need to do ourselves
|
||||
(defn conn
|
||||
[]
|
||||
(let [client (d/client (config))]
|
||||
(d/connect client {:db-name (c/datomic-db-name)})))
|
||||
|
||||
;;; In general this should not be used; instead, use wrap-datomic-fn or equivalent
|
||||
(defn latest-db
|
||||
[]
|
||||
(d/db (conn)))
|
||||
|
||||
(def default-timeout 60000) ;Far too long for web app, need TODO performance tuning / paging
|
||||
|
||||
(defn q
|
||||
[query & args]
|
||||
; (prn :q query :args args :db *db*)
|
||||
(d/q {:query query :args (cons *db* args) :timeout 60000}))
|
||||
|
||||
; Chat with Mike about using this.
|
||||
; If we don't query latest when creating a bunch of records from the uploaded files, we end up with duplicates instead of finding new values.
|
||||
(defn q-latest
|
||||
[query & args]
|
||||
; (prn :q query :args args :db *db*)
|
||||
(d/q {:query query :args (cons (d/db *connection*) args) :timeout 60000}))
|
||||
|
||||
(defn pull
|
||||
[spec eid]
|
||||
(d/pull *db* spec eid))
|
||||
|
||||
(defn q-as-of
|
||||
"Return a function that works like q but on a historical version of the database"
|
||||
[as-of]
|
||||
(fn [query & args]
|
||||
(apply d/q query (d/as-of (d/db *connection*) as-of) args)))
|
||||
|
||||
(defn pull-as-of
|
||||
[as-of]
|
||||
(fn [spec eid]
|
||||
(d/pull (d/as-of (d/db *connection*) as-of) spec eid)))
|
||||
|
||||
(defn q-history
|
||||
[query & args]
|
||||
(d/q {:query query :args (cons (d/history *db*) args) :timeout 60000}))
|
||||
|
||||
(defn q1
|
||||
"Query for a single result. Errors if there is more than one row returned."
|
||||
[query & args]
|
||||
(let [res (apply q query args)]
|
||||
(if (> (count res) 1)
|
||||
(throw (Error. (str "Multiple results where at most one expected: " query " " res)))
|
||||
(first res))))
|
||||
|
||||
(defn q11
|
||||
"Query for a single value in a single result. Errors if there is more than one row returned."
|
||||
[query & args]
|
||||
(let [res (apply q1 query args)]
|
||||
(if (> (count res) 1)
|
||||
(throw (Error. (str "Multiple results where at most one expected: " query " " res)))
|
||||
(first res))))
|
||||
|
||||
(defn transact
|
||||
[txn]
|
||||
(d/transact *connection* {:tx-data txn}))
|
||||
|
||||
(defn get-entity
|
||||
[id]
|
||||
(first
|
||||
(q1 '[:find (pull ?id [*])
|
||||
:in $ ?id]
|
||||
id)))
|
||||
|
||||
(defn wrap-datomic
|
||||
"A Ring middleware that provides a request-consistent database connection and
|
||||
value for the life of a request."
|
||||
[handler]
|
||||
(fn [request]
|
||||
(let [connection (conn)]
|
||||
(binding [*connection* connection
|
||||
*db* (d/db connection)]
|
||||
(handler request)))))
|
||||
|
||||
;;; TODO the doall-safe is to try to make sure lazy lists are realized within the scope of the db binding
|
||||
;;; but it doesn't really work because inner elements might be lazy. Really needs to do a walk of the structure.
|
||||
(defn wrap-datomic-fn
|
||||
[f]
|
||||
((wrap-datomic (fn [& _] (u/doall-safe (f)))) nil))
|
||||
|
||||
(defn update->txn
|
||||
"`entity` is an entity map, update is an updated version of it (can be incomplete). Generates a txn. Not recursive (but maybe should be)."
|
||||
[entity update]
|
||||
(for [[key val] update
|
||||
:when (not (= (get entity key) val))]
|
||||
[:db/add (:db/id entity) key val]))
|
||||
58
src/clj/org/parkerici/sample_tracking/db/form_type.clj
Normal file
58
src/clj/org/parkerici/sample_tracking/db/form_type.clj
Normal file
@@ -0,0 +1,58 @@
|
||||
(ns org.parkerici.sample-tracking.db.form-type
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
;TODO - This errors silently if field-type is not one of the valid enums. Should raise an error.
|
||||
(defn create-form-type-field
|
||||
[field-map]
|
||||
(let [uuid (db/squuid)
|
||||
{:keys [field-id type required label options]} field-map
|
||||
txn (cond-> {:form-type-field/uuid uuid
|
||||
:form-type-field/field-id field-id
|
||||
:form-type-field/field-type (keyword "form-type-field-type" type)
|
||||
:form-type-field/required required
|
||||
:form-type-field/label label}
|
||||
(some? options) (assoc :form-type-field/options options))]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn find-form-type
|
||||
[name]
|
||||
(ffirst (d/q-latest '[:find ?uuid
|
||||
:in $ ?form-type-name
|
||||
:where
|
||||
[?form-type :form-type/name ?form-type-name]
|
||||
[?form-type :form-type/uuid ?uuid]]
|
||||
name)))
|
||||
|
||||
(defn create-form-type
|
||||
[name fields]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:form-type/name name :form-type/uuid uuid :form-type/fields fields}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn process-form-type-field-pull
|
||||
[results]
|
||||
(map (fn [result]
|
||||
(let [result-map (first result)]
|
||||
(-> result-map
|
||||
(assoc :options (into {} (:options result-map)))
|
||||
(assoc :type (get-in result-map [:form-type-field/field-type :type]))
|
||||
(dissoc :form-type-field/field-type)))) results))
|
||||
|
||||
(defn get-form-type-fields
|
||||
[kit-type-uuid]
|
||||
(let [results (d/q-latest '[:find (pull ?field [[:form-type-field/uuid :as :uuid]
|
||||
[:form-type-field/field-id :as :field-id]
|
||||
[:form-type-field/required :as :required]
|
||||
[:form-type-field/label :as :label]
|
||||
[:form-type-field/options :as :options]
|
||||
{:form-type-field/field-type [[:db/doc :as :type]]}])
|
||||
:in $ ?kit-type-uuid
|
||||
:where
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/form-type ?form-type]
|
||||
[?form-type :form-type/fields ?field]] kit-type-uuid)]
|
||||
(process-form-type-field-pull results)))
|
||||
|
||||
37
src/clj/org/parkerici/sample_tracking/db/form_value.clj
Normal file
37
src/clj/org/parkerici/sample_tracking/db/form_value.clj
Normal file
@@ -0,0 +1,37 @@
|
||||
(ns org.parkerici.sample-tracking.db.form-value
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-or-update-form-value
|
||||
[uuid field field-type value]
|
||||
(let [uuid-to-return (or uuid (db/squuid))
|
||||
txn (cond-> {:form-value/field [:form-type-field/uuid field]}
|
||||
uuid (assoc :db/id [:form-value/uuid uuid])
|
||||
(nil? uuid) (assoc :form-value/uuid uuid-to-return)
|
||||
(= field-type "boolean") (assoc :form-value/value_boolean value)
|
||||
(= field-type "int") (assoc :form-value/value_long value)
|
||||
(= field-type "select") (assoc :form-value/value_string value)
|
||||
(= field-type "string") (assoc :form-value/value_string value)
|
||||
(= field-type "time") (assoc :form-value/value_instant value))]
|
||||
(db/transact [txn])
|
||||
uuid-to-return))
|
||||
|
||||
(defn list-form-values
|
||||
[config-map]
|
||||
(let [kit-uuid (:uuid config-map)
|
||||
query {:find '[?kit-uuid ?uuid ?field-id ?value ?type]
|
||||
:keys '[kit-uuid uuid field-id value field-type]
|
||||
:where '[[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/form-values ?form-value]
|
||||
[?form-value :form-value/uuid ?uuid]
|
||||
[?form-value :form-value/field ?field]
|
||||
[?field :form-type-field/field-id ?field-id]
|
||||
[?field :form-type-field/field-type ?field-type]
|
||||
[?field-type :db/doc ?type]
|
||||
[(get-some $ ?form-value
|
||||
:form-value/value_string :form-value/value_long :form-value/value_float
|
||||
:form-value/value_instant :form-value/value_boolean) [_attr ?value]]]}
|
||||
query-fn (if-let [tx-id (:tx-id config-map)] (d/q-as-of tx-id) d/q-latest)
|
||||
results (query-fn query)]
|
||||
(cond-> results
|
||||
kit-uuid (db/reducer-filter :kit-uuid kit-uuid))))
|
||||
51
src/clj/org/parkerici/sample_tracking/db/history.clj
Normal file
51
src/clj/org/parkerici/sample_tracking/db/history.clj
Normal file
@@ -0,0 +1,51 @@
|
||||
(ns org.parkerici.sample-tracking.db.history
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-history
|
||||
[agent-email entity-type entity-id old-value new-value]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:history/uuid uuid
|
||||
:history/agent-email agent-email
|
||||
:history/entity-type entity-type
|
||||
:history/entity-uuid entity-id
|
||||
:history/old-value old-value
|
||||
:history/new-value new-value
|
||||
:history/time (Date.)}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
; Pull version to use at some point. Didn't use before uuids because :as doesn't work with :db/id and returns
|
||||
; each entity as it's own list for some reason.
|
||||
;
|
||||
;(defn list-history
|
||||
; [id]
|
||||
; (let [query {:find '[(pull ?history [[:db/id :as :id] [:history/agent-email :as :agent-email]
|
||||
; [:history/entity-type :as :entity-type] [:history/entity-id :as :entity-id]
|
||||
; [:history/old-value :as :old-value] [:history/new-value :as :new-value]
|
||||
; [:history/time :as :time]])]
|
||||
; :where '[[?history :history/entity-id ?entity-id]]}
|
||||
; filtered-query (if (nil? id)
|
||||
; query
|
||||
; (assoc query :in '[$ ?entity-id]))]
|
||||
; (apply d/q-latest (remove nil? [filtered-query id]))))
|
||||
|
||||
(defn list-history
|
||||
[entity-uuid]
|
||||
(let [query {:find '[?history-uuid ?agent-email ?entity-type ?entity-uuid ?old-value ?new-value ?time ?tx-inst]
|
||||
:keys '[uuid agent-email entity-type entity-uuid old-value new-value time sort-time]
|
||||
:where '[[?history :history/uuid ?history-uuid ?tx-eid]
|
||||
[?history :history/agent-email ?agent-email]
|
||||
[?history :history/entity-type ?entity-type]
|
||||
[?history :history/entity-uuid ?entity-uuid]
|
||||
[?history :history/old-value ?old-value]
|
||||
[?history :history/new-value ?new-value]
|
||||
[?history :history/time ?time]
|
||||
[?tx-eid :db/txInstant ?tx-inst]]}
|
||||
filtered-query (if (nil? entity-uuid)
|
||||
query
|
||||
(assoc query :in '[$ ?entity-uuid]))
|
||||
results (apply d/q-latest (remove nil? [filtered-query entity-uuid]))
|
||||
sorted-results (reverse (sort-by :sort-time results))]
|
||||
(map #(dissoc % :sort-time) sorted-results)))
|
||||
103
src/clj/org/parkerici/sample_tracking/db/kit.clj
Normal file
103
src/clj/org/parkerici/sample_tracking/db/kit.clj
Normal file
@@ -0,0 +1,103 @@
|
||||
(ns org.parkerici.sample-tracking.db.kit
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]
|
||||
[java-time :as time]
|
||||
[clojure.string :as str])
|
||||
(:import (java.util UUID)))
|
||||
|
||||
(defn create-or-update-kit
|
||||
[uuid kit-map]
|
||||
(let [uuid-to-return (or uuid (db/squuid))
|
||||
{:keys [kit-id participant-id collection-timestamp timezone
|
||||
completing-first-name completing-last-name completing-email comments site cohort timepoints kit-type
|
||||
complete submission-timestamp]} kit-map
|
||||
txn (cond-> {:kit/kit-id kit-id
|
||||
:kit/complete complete
|
||||
:kit/submission-timestamp submission-timestamp
|
||||
:kit/participant-id participant-id
|
||||
:kit/timezone timezone
|
||||
:kit/completing-first-name completing-first-name
|
||||
:kit/completing-last-name completing-last-name
|
||||
:kit/completing-email completing-email
|
||||
:kit/comments comments
|
||||
:kit/site [:site/uuid (UUID/fromString site)]
|
||||
:kit/cohort [:cohort/uuid (UUID/fromString cohort)]
|
||||
:kit/timepoints (map #(vector :timepoint/uuid (UUID/fromString %)) timepoints)
|
||||
:kit/kit-type [:kit-type/uuid (UUID/fromString kit-type)]}
|
||||
uuid (assoc :db/id [:kit/uuid uuid])
|
||||
(nil? uuid) (assoc :kit/uuid uuid-to-return)
|
||||
collection-timestamp (assoc :kit/collection-timestamp (time/java-date collection-timestamp)))]
|
||||
(db/transact [txn])
|
||||
uuid-to-return))
|
||||
|
||||
(defn add-sample-to-kit
|
||||
[kit-uuid sample-uuid]
|
||||
(d/transact [[:db/add [:kit/uuid kit-uuid] :kit/samples [:sample/uuid sample-uuid]]]))
|
||||
|
||||
(defn add-shipment-to-kit
|
||||
[kit-uuid shipment-uuid]
|
||||
(d/transact [[:db/add [:kit/uuid kit-uuid] :kit/shipments [:shipment/uuid shipment-uuid]]]))
|
||||
|
||||
(defn add-form-value-to-kit
|
||||
[kit-uuid form-value-uuid]
|
||||
(d/transact [[:db/add [:kit/uuid kit-uuid] :kit/form-values [:form-value/uuid form-value-uuid]]]))
|
||||
|
||||
(defn remove-timepoint-from-kit
|
||||
[kit-uuid timepoint-uuid]
|
||||
(d/transact [[:db/retract [:kit/uuid kit-uuid] :kit/timepoints [:timepoint/uuid timepoint-uuid]]]))
|
||||
|
||||
; TODO - Convert to a pull
|
||||
(defn list-kits
|
||||
[config-map]
|
||||
(let [{:keys [uuid complete archived kit-id completing-email completing-email-domain]} config-map
|
||||
query '[:find ?kit-uuid ?kit-id ?participant-id ?collection-timestamp ?timezone ?first-name ?last-name
|
||||
?email ?comments ?kit-type-uuid ?kit-type-name ?site-uuid ?study-uuid ?cohort-uuid ?complete ?archived
|
||||
:keys uuid kit-id participant-id collection-timestamp timezone completing-first-name completing-last-name
|
||||
completing-email comments kit-type-uuid kit-type-name site-uuid study-uuid cohort-uuid complete archived
|
||||
:where [?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/kit-id ?kit-id]
|
||||
[?kit :kit/complete ?complete]
|
||||
[?kit :kit/timezone ?timezone]
|
||||
[(get-else $ ?kit :kit/participant-id "") ?participant-id]
|
||||
[(get-else $ ?kit :kit/collection-timestamp "") ?collection-timestamp]
|
||||
[(get-else $ ?kit :kit/completing-first-name "") ?first-name]
|
||||
[(get-else $ ?kit :kit/completing-last-name "") ?last-name]
|
||||
[(get-else $ ?kit :kit/completing-email "") ?email]
|
||||
[(get-else $ ?kit :kit/comments "") ?comments]
|
||||
[(get-else $ ?kit :kit/archived false) ?archived]
|
||||
[?kit :kit/kit-type ?kit-type]
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/name ?kit-type-name]
|
||||
[?kit :kit/site ?site]
|
||||
[?site :site/uuid ?site-uuid]
|
||||
[?kit :kit/cohort ?cohort]
|
||||
[?cohort :cohort/uuid ?cohort-uuid]
|
||||
[?cohort :cohort/study ?study]
|
||||
[?study :study/uuid ?study-uuid]]
|
||||
query-fn (if-let [tx-id (:tx-id config-map)] (d/q-as-of tx-id) d/q-latest)
|
||||
results (query-fn query)]
|
||||
(cond-> results
|
||||
uuid (db/reducer-filter :uuid uuid)
|
||||
(some? completing-email) (db/reducer-filter :completing-email completing-email)
|
||||
(some? completing-email-domain) (db/reduce-fn-filter (fn [map] (str/ends-with? (:completing-email map) completing-email-domain)))
|
||||
(some? kit-id) (db/reducer-filter :kit-id kit-id)
|
||||
(some? complete) (db/reducer-filter :complete complete)
|
||||
(some? archived) (db/reducer-filter :archived (boolean archived)))))
|
||||
|
||||
(defn get-kit
|
||||
[config-map]
|
||||
(first (list-kits config-map)))
|
||||
|
||||
(defn get-kit-vendor-email
|
||||
[uuid]
|
||||
(let [query '[:find ?vendor-email
|
||||
:in $ ?kit-uuid
|
||||
:where
|
||||
[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/kit-type ?kit-type]
|
||||
[?kit-type :kit-type/vendor-email ?vendor-email]]]
|
||||
(ffirst (d/q-latest query uuid))))
|
||||
|
||||
(defn set-archived
|
||||
[uuid archived]
|
||||
(db/transact [{:db/id [:kit/uuid uuid] :kit/archived archived}]))
|
||||
127
src/clj/org/parkerici/sample_tracking/db/kit_type.clj
Normal file
127
src/clj/org/parkerici/sample_tracking/db/kit_type.clj
Normal file
@@ -0,0 +1,127 @@
|
||||
(ns org.parkerici.sample-tracking.db.kit-type
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-kit-type
|
||||
[name item-number vendor-email collection-date-required air-waybill-required]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:kit-type/name name
|
||||
:kit-type/item-number item-number
|
||||
:kit-type/vendor-email vendor-email
|
||||
:kit-type/collection-date-required collection-date-required
|
||||
:kit-type/air-waybill-required air-waybill-required
|
||||
:kit-type/uuid uuid
|
||||
:kit-type/create-time (Date.)}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn find-active-kit-type-by-name-and-cohort
|
||||
[kit-type-name cohort-uuid]
|
||||
(first (d/q-latest '[:find ?kit-type-uuid
|
||||
:keys uuid
|
||||
:in $ ?kit-type-name ?cohort-uuid ?active
|
||||
:where
|
||||
[?cohort :cohort/uuid ?cohort-uuid]
|
||||
[?cohort :cohort/kit-types ?kit-type-tuple]
|
||||
[(untuple ?kit-type-tuple) [?kit-type ?active]]
|
||||
[?kit-type :kit-type/name ?kit-type-name]
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]] kit-type-name cohort-uuid true)))
|
||||
|
||||
;TODO - Convert to pull
|
||||
(defn find-kit-type-by-uuid
|
||||
[uuid]
|
||||
(first (d/q-latest '[:find ?name ?item-number ?create-time
|
||||
:keys name item-number create-time
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?kit-type :kit-type/uuid ?uuid]
|
||||
[?kit-type :kit-type/name ?name]
|
||||
[?kit-type :kit-type/item-number ?item-number]
|
||||
[?kit-type :kit-type/create-time ?create-time]]
|
||||
uuid)))
|
||||
|
||||
(defn add-timepoint-to-kit-type
|
||||
[timepoint-uuid kit-type-uuid]
|
||||
(d/transact [[:db/add [:kit-type/uuid kit-type-uuid] :kit-type/timepoints [:timepoint/uuid timepoint-uuid]]]))
|
||||
|
||||
(defn add-form-type-to-kit-type
|
||||
[form-type-uuid kit-type-item-no]
|
||||
(d/transact [{:db/id [:kit-type/item-number kit-type-item-no] :kit-type/form-type [:form-type/uuid form-type-uuid]}]))
|
||||
|
||||
(defn add-sample-type-to-kit-type
|
||||
[sample-type-uuid kit-type-uuid]
|
||||
(d/transact [[:db/add [:kit-type/uuid kit-type-uuid] :kit-type/sample-types [:sample-type/uuid sample-type-uuid]]]))
|
||||
|
||||
(defn kit-type-has-form-type
|
||||
[kit-type-item-no]
|
||||
(seq (d/q-latest '[:find ?form-type
|
||||
:in $ ?item-number
|
||||
:where
|
||||
[?kit-type :kit-type/item-number ?item-number]
|
||||
[?kit-type :kit-type/form-type ?form-type]]
|
||||
kit-type-item-no)))
|
||||
|
||||
(defn get-kit-type-form-type
|
||||
[kit-type-uuid]
|
||||
(first (d/q-latest '[:find ?form-type-uuid ?form-type-name ?form-type-fields
|
||||
:keys uuid name fields
|
||||
:in $ ?kit-type-uuid
|
||||
:where
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/form-type ?form-type]
|
||||
[?form-type :form-type/uuid ?form-type-uuid]
|
||||
[?form-type :form-type/name ?form-type-name]
|
||||
[?form-type :form-type/fields ?form-type-fields]]
|
||||
kit-type-uuid)))
|
||||
|
||||
(defn list-kit-types
|
||||
[cohort-uuid active]
|
||||
(let [query {:find '[?kit-type-uuid ?kit-type-name ?item-number ?active ?create-time ?collection-date-required
|
||||
?air-waybill-required]
|
||||
:keys '[uuid name item-number active create-time collection-date-required air-waybill-required]
|
||||
:where '[[?cohort :cohort/uuid ?cohort-uuid]
|
||||
[?cohort :cohort/kit-types ?kit-type-tuple]
|
||||
[(untuple ?kit-type-tuple) [?kit-type ?active]]
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/timepoints ?timepoints]
|
||||
[?kit-type :kit-type/name ?kit-type-name]
|
||||
[?kit-type :kit-type/item-number ?item-number]
|
||||
[(get-else $ ?kit-type :kit-type/form-type "") ?form-type]
|
||||
[?kit-type :kit-type/create-time ?create-time]
|
||||
[?kit-type :kit-type/collection-date-required ?collection-date-required]
|
||||
[?kit-type :kit-type/air-waybill-required ?air-waybill-required]]}
|
||||
filtered-query (if (nil? active)
|
||||
(assoc query :in '[$ ?cohort-uuid])
|
||||
(assoc query :in '[$ ?cohort-uuid ?active]))]
|
||||
(apply d/q-latest (remove nil? [filtered-query cohort-uuid active]))))
|
||||
|
||||
(defn get-kit-type-name
|
||||
[uuid]
|
||||
(ffirst (d/q-latest '[:find ?kit-type-name
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?kit-type :kit-type/uuid ?uuid]
|
||||
[?kit-type :kit-type/name ?kit-type-name]]
|
||||
uuid)))
|
||||
|
||||
(defn update-kit-type
|
||||
[uuid name item-number collection-date-required air-waybill-required]
|
||||
(d/transact [{:db/id [:kit-type/uuid uuid]
|
||||
:kit-type/name name
|
||||
:kit-type/item-number item-number
|
||||
:kit-type/collection-date-required collection-date-required
|
||||
:kit-type/air-waybill-required air-waybill-required}]))
|
||||
|
||||
(defn update-kit-type-active-status
|
||||
[cohort-uuid kit-type-uuid status]
|
||||
(let [current-tuple (first (d/q-latest '[:find ?kit-type ?active
|
||||
:in $ ?kit-type-uuid ?cohort-uuid
|
||||
:where
|
||||
[?cohort :cohort/uuid ?cohort-uuid]
|
||||
[?cohort :cohort/kit-types ?kit-type-tuple]
|
||||
[(untuple ?kit-type-tuple) [?kit-type ?active]]
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]]
|
||||
kit-type-uuid cohort-uuid))]
|
||||
(when (some? current-tuple) (d/transact [[:db/retract [:cohort/uuid cohort-uuid] :cohort/kit-types current-tuple]]))
|
||||
(d/transact [[:db/add [:cohort/uuid cohort-uuid] :cohort/kit-types [[:kit-type/uuid kit-type-uuid] status]]])))
|
||||
20
src/clj/org/parkerici/sample_tracking/db/migration.clj
Normal file
20
src/clj/org/parkerici/sample_tracking/db/migration.clj
Normal file
@@ -0,0 +1,20 @@
|
||||
(ns org.parkerici.sample-tracking.db.migration
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-migration
|
||||
[name]
|
||||
(let [uuid (db/squuid)]
|
||||
(db/transact [{:migration/uuid uuid :migration/name name :migration/time (Date.)}])
|
||||
uuid))
|
||||
|
||||
(defn migration-has-been-run
|
||||
[name]
|
||||
(let [migrations (d/q-latest '[:find ?uuid
|
||||
:in $ ?migration-name
|
||||
:where
|
||||
[?migration :migration/name ?migration-name]
|
||||
[?migration :migration/uuid ?uuid]]
|
||||
name)]
|
||||
(not= (count migrations) 0)))
|
||||
@@ -0,0 +1,22 @@
|
||||
(ns org.parkerici.sample-tracking.db.migration.air-waybill-required
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn list-kit-types-without-air-waybill-required
|
||||
[]
|
||||
(d/q-latest {:find '[?uuid]
|
||||
:keys '[uuid]
|
||||
:where '[[?kit-type :kit-type/uuid ?uuid]
|
||||
[(missing? $ ?kit-type :kit-type/air-waybill-required)]]}))
|
||||
|
||||
(defn list-kit-types-air-waybill
|
||||
[]
|
||||
(d/q-latest {:find '[?uuid ?air-waybill]
|
||||
:keys '[uuid air-waybill]
|
||||
:where '[[?kit-type :kit-type/uuid ?uuid]
|
||||
[?kit-type :kit-type/air-waybill-required ?air-waybill]]}))
|
||||
|
||||
|
||||
(defn set-kit-type-air-waybill-required
|
||||
[uuid required]
|
||||
(db/transact [{:db/id [:kit-type/uuid uuid] :kit-type/air-waybill-required required}]))
|
||||
@@ -0,0 +1,70 @@
|
||||
(ns org.parkerici.sample-tracking.db.proposed-kit-edit
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]
|
||||
[clojure.string :as str])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-or-update-proposed-edit
|
||||
"kit-uuid must be parsed uuid and not a string"
|
||||
[edit-uuid kit-uuid kit-map email]
|
||||
(let [uuid (or edit-uuid (db/squuid))
|
||||
txn {:proposed-kit-edit/uuid uuid
|
||||
:proposed-kit-edit/kit [:kit/uuid kit-uuid]
|
||||
:proposed-kit-edit/update-map kit-map
|
||||
:proposed-kit-edit/status :kit-edit-status/pending
|
||||
:proposed-kit-edit/user [:user/email email]
|
||||
:proposed-kit-edit/time (Date.)}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn list-proposed-edits
|
||||
[config-map]
|
||||
(let [{:keys [uuid kit-uuid status]} config-map
|
||||
query {:find '[?uuid ?kit-uuid ?kit-id ?update-map ?status ?email ?time ?participant-id ?collection-timestamp
|
||||
?kit-email ?kit-type-name]
|
||||
:keys '[uuid kit-uuid kit-id update-map status email time participant-id collection-timestamp
|
||||
kit-email kit-type-name]
|
||||
:where '[[?proposed-edit :proposed-kit-edit/uuid ?uuid]
|
||||
[?proposed-edit :proposed-kit-edit/kit ?kit]
|
||||
[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/kit-id ?kit-id]
|
||||
[(get-else $ ?kit :kit/participant-id "") ?participant-id]
|
||||
[(get-else $ ?kit :kit/collection-timestamp "") ?collection-timestamp]
|
||||
[(get-else $ ?kit :kit/completing-email "") ?kit-email]
|
||||
[?kit :kit/kit-type ?kit-type]
|
||||
[?kit-type :kit-type/name ?kit-type-name]
|
||||
[?proposed-edit :proposed-kit-edit/update-map ?update-map]
|
||||
[?proposed-edit :proposed-kit-edit/status ?status-enum]
|
||||
[?status-enum :db/doc ?status]
|
||||
[?proposed-edit :proposed-kit-edit/user ?user]
|
||||
[?user :user/email ?email]
|
||||
[?proposed-edit :proposed-kit-edit/time ?time]]}
|
||||
results (apply d/q-latest [query])]
|
||||
(cond-> results
|
||||
(some? uuid) (db/reducer-filter :uuid uuid)
|
||||
(some? kit-uuid) (db/reducer-filter :kit-uuid kit-uuid)
|
||||
(not (str/blank? status)) (db/reducer-filter :status status))))
|
||||
|
||||
(defn get-proposed-edit-tx-id
|
||||
[uuid]
|
||||
(ffirst (d/q-latest '[:find ?tx
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?form-type :proposed-kit-edit/uuid ?uuid ?tx ?op]]
|
||||
uuid)))
|
||||
|
||||
(defn update-proposed-edit-status
|
||||
[uuid reviewing-email status]
|
||||
(let [txn {:proposed-kit-edit/uuid uuid
|
||||
:proposed-kit-edit/status status
|
||||
:proposed-kit-edit/reviewing-user [:user/email reviewing-email]}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn approve-proposed-edit
|
||||
[uuid reviewing-email]
|
||||
(update-proposed-edit-status uuid reviewing-email :kit-edit-status/approved))
|
||||
|
||||
(defn deny-proposed-edit
|
||||
[uuid reviewing-email]
|
||||
(update-proposed-edit-status uuid reviewing-email :kit-edit-status/denied))
|
||||
24
src/clj/org/parkerici/sample_tracking/db/role.clj
Normal file
24
src/clj/org/parkerici/sample_tracking/db/role.clj
Normal file
@@ -0,0 +1,24 @@
|
||||
(ns org.parkerici.sample-tracking.db.role
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-role
|
||||
[name]
|
||||
(let [uuid (db/squuid)]
|
||||
(db/transact [{:role/name name :role/uuid uuid}])
|
||||
uuid))
|
||||
|
||||
(defn find-role-uuid
|
||||
[name]
|
||||
(ffirst (d/q-latest '[:find ?uuid
|
||||
:in $ ?name
|
||||
:where
|
||||
[?role :role/name ?name]
|
||||
[?role :role/uuid ?uuid]]
|
||||
name)))
|
||||
|
||||
(defn list-roles
|
||||
[]
|
||||
(map first (d/q-latest '[:find (pull ?role [[:role/uuid :as :uuid]
|
||||
[:role/name :as :name]])
|
||||
:where [?role :role/uuid]])))
|
||||
102
src/clj/org/parkerici/sample_tracking/db/sample.clj
Normal file
102
src/clj/org/parkerici/sample_tracking/db/sample.clj
Normal file
@@ -0,0 +1,102 @@
|
||||
(ns org.parkerici.sample-tracking.db.sample
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db])
|
||||
(:import (java.util UUID)))
|
||||
|
||||
(defn create-or-update-sample
|
||||
[uuid sample-type-uuid sample-id collected shipped]
|
||||
(let [uuid-to-return (or uuid (db/squuid))
|
||||
txn (cond-> {:sample/sample-type [:sample-type/uuid (UUID/fromString sample-type-uuid)]
|
||||
:sample/sample-id sample-id
|
||||
:sample/collected collected
|
||||
:sample/shipped shipped}
|
||||
uuid (assoc :db/id [:sample/uuid uuid])
|
||||
(nil? uuid) (assoc :sample/uuid uuid-to-return))]
|
||||
(db/transact [txn])
|
||||
uuid-to-return))
|
||||
|
||||
(defn add-sample-to-shipment
|
||||
[shipment-uuid sample-uuid]
|
||||
(d/transact [{:db/id [:sample/uuid sample-uuid] :sample/shipment [:shipment/uuid shipment-uuid]}]))
|
||||
|
||||
(defn remove-sample-from-shipment
|
||||
[shipment-uuid sample-uuid]
|
||||
(d/transact [[:db/retract [:sample/uuid sample-uuid] :sample/shipment [:shipment/uuid shipment-uuid]]]))
|
||||
|
||||
(defn list-shipment-samples
|
||||
[shipment-uuid]
|
||||
(flatten (d/q-latest '[:find ?sample-uuid
|
||||
:in $ ?shipment-uuid
|
||||
:where
|
||||
[?sample :sample/uuid ?sample-uuid]
|
||||
[?sample :sample/shipment ?shipment]
|
||||
[?shipment :shipment/uuid ?shipment-uuid]] shipment-uuid)))
|
||||
|
||||
(defn list-samples
|
||||
[config-map]
|
||||
(let [kit-uuid (:uuid config-map)
|
||||
query {:find '[?kit-uuid ?sample-uuid ?sample-id ?sample-type-uuid ?collected ?shipped]
|
||||
:keys '[kit-uuid uuid sample-id sample-type-uuid collected shipped]
|
||||
:where '[[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/samples ?sample]
|
||||
[?sample :sample/uuid ?sample-uuid]
|
||||
[?sample :sample/sample-type ?sample-type]
|
||||
[?sample :sample/sample-id ?sample-id]
|
||||
[(get-else $ ?sample :sample/collected false) ?collected]
|
||||
[(get-else $ ?sample :sample/shipped false) ?shipped]
|
||||
[?sample-type :sample-type/uuid ?sample-type-uuid]]}
|
||||
query-fn (if-let [tx-id (:tx-id config-map)] (d/q-as-of tx-id) d/q-latest)
|
||||
results (query-fn query)]
|
||||
(cond-> results
|
||||
kit-uuid (db/reducer-filter :kit-uuid kit-uuid))))
|
||||
|
||||
; TODO - Convert to a pull
|
||||
(defn list-samples-for-export
|
||||
([config-map]
|
||||
(let [{:keys [uuid complete shipped archived]} config-map
|
||||
query '[:find ?site-name ?study-name ?cohort-name ?kit-type-name ?kit-type-uuid ?kit-type-item-number ?kit-uuid
|
||||
?kit-id ?participant-id ?collection-timestamp ?completing-first-name ?completing-last-name
|
||||
?completing-email ?kit-comments ?sample-type-name ?sample-type-uuid ?sample-id ?collected ?shipped
|
||||
?air-waybill ?complete ?timezone ?archived
|
||||
:keys site-name study-name cohort-name kit-type-name kit-type-uuid kit-type-item-number kit-uuid kit-id
|
||||
participant-id collection-timestamp completing-first-name completing-last-name completing-email
|
||||
kit-comments sample-type-name sample-type-uuid sample-id collected shipped air-waybill complete
|
||||
timezone archived
|
||||
:where [?kit :kit/kit-id ?kit-id]
|
||||
[?kit :kit/complete ?complete]
|
||||
[?kit :kit/timezone ?timezone]
|
||||
[(get-else $ ?kit :kit/participant-id "") ?participant-id]
|
||||
[(get-else $ ?kit :kit/collection-timestamp "") ?collection-timestamp]
|
||||
[(get-else $ ?kit :kit/completing-first-name "") ?completing-first-name]
|
||||
[(get-else $ ?kit :kit/completing-last-name "") ?completing-last-name]
|
||||
[(get-else $ ?kit :kit/completing-email "") ?completing-email]
|
||||
[(get-else $ ?kit :kit/comments "") ?kit-comments]
|
||||
[(get-else $ ?kit :kit/archived false) ?archived]
|
||||
[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/kit-type ?kit-type]
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/name ?kit-type-name]
|
||||
[?kit-type :kit-type/item-number ?kit-type-item-number]
|
||||
[?kit :kit/site ?site]
|
||||
[?site :site/name ?site-name]
|
||||
[?study :study/name ?study-name]
|
||||
[?kit :kit/cohort ?cohort]
|
||||
[?cohort :cohort/name ?cohort-name]
|
||||
[?cohort :cohort/study ?study]
|
||||
[?kit :kit/samples ?sample]
|
||||
[?sample :sample/sample-type ?sample-type]
|
||||
[?sample-type :sample-type/name ?sample-type-name]
|
||||
[?sample-type :sample-type/uuid ?sample-type-uuid]
|
||||
[?sample :sample/sample-id ?sample-id]
|
||||
[(get-else $ ?sample :sample/collected false) ?collected]
|
||||
[(get-else $ ?sample :sample/shipped false) ?shipped]
|
||||
[(get-else $ ?sample :sample/shipment -1) ?shipment]
|
||||
[(get-else $ ?shipment :shipment/air-waybill "") ?air-waybill]]
|
||||
results (d/q-latest query)]
|
||||
(cond-> results
|
||||
uuid (db/reducer-filter :kit-uuid uuid)
|
||||
(some? complete) (db/reducer-filter :complete complete)
|
||||
(some? shipped) (db/reducer-filter :shipped shipped)
|
||||
(some? archived) (db/reducer-filter :archived (boolean archived)))))
|
||||
([]
|
||||
(list-samples-for-export {})))
|
||||
@@ -0,0 +1,60 @@
|
||||
(ns org.parkerici.sample-tracking.db.sample-attribute
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-sample-attribute
|
||||
[name]
|
||||
(let [uuid (db/squuid)]
|
||||
(db/transact [{:sample-attribute/uuid uuid
|
||||
:sample-attribute/name name}])
|
||||
uuid))
|
||||
|
||||
; There should only be one sample-attribute with a given name.
|
||||
; Returns the uuid of the attribute with the passed in name if it exists.
|
||||
(defn find-sample-attribute
|
||||
[name]
|
||||
(ffirst (d/q-latest '[:find ?uuid
|
||||
:in $ ?attribute-name
|
||||
:where
|
||||
[?sample-attribute :sample-attribute/uuid ?uuid]
|
||||
[?sample-attribute :sample-attribute/name ?attribute-name]]
|
||||
name)))
|
||||
|
||||
(defn create-sample-attribute-value
|
||||
[name attribute-uuid]
|
||||
(let [uuid (db/squuid)]
|
||||
(db/transact [{:sample-attribute-value/uuid uuid
|
||||
:sample-attribute-value/name name
|
||||
:sample-attribute-value/attribute [:sample-attribute/uuid attribute-uuid]}])
|
||||
uuid))
|
||||
|
||||
; There should only be one attribute-value with a given name and attribute.
|
||||
; Returns the uuid of the attribute-value with the passed in name and attribute if it exists.
|
||||
(defn find-sample-attribute-value
|
||||
[name attribute-uuid]
|
||||
(ffirst (d/q-latest '[:find ?sample-attribute-value-uuid
|
||||
:in $ ?value-name ?attribute-uuid
|
||||
:where
|
||||
[?sample-attribute-value :sample-attribute-value/uuid ?sample-attribute-value-uuid]
|
||||
[?sample-attribute-value :sample-attribute-value/name ?value-name]
|
||||
[?sample-attribute-value :sample-attribute-value/attribute ?attribute]
|
||||
[?attribute :sample-attribute/uuid ?attribute-uuid]]
|
||||
name attribute-uuid)))
|
||||
|
||||
(defn list-sample-attributes-and-values-for-export
|
||||
([config-map]
|
||||
(let [kit-uuid (:uuid config-map)
|
||||
query {:find '[?sample-id ?sample-attribute-name ?attribute-value-name]
|
||||
:keys '[sample-id attribute value]
|
||||
:where '[[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/kit-id ?kit-id]
|
||||
[?kit :kit/samples ?sample]
|
||||
[?sample :sample/sample-id ?sample-id]
|
||||
[?sample :sample/sample-type ?sample-type]
|
||||
[?sample-type :sample-type/attribute-values ?attribute-value]
|
||||
[?attribute-value :sample-attribute-value/name ?attribute-value-name]
|
||||
[?attribute-value :sample-attribute-value/attribute ?sample-attribute]
|
||||
[?sample-attribute :sample-attribute/name ?sample-attribute-name]]}
|
||||
results (d/q-latest query)]
|
||||
(cond-> results
|
||||
kit-uuid (db/reducer-filter :kit-uuid kit-uuid)))))
|
||||
54
src/clj/org/parkerici/sample_tracking/db/sample_type.clj
Normal file
54
src/clj/org/parkerici/sample_tracking/db/sample_type.clj
Normal file
@@ -0,0 +1,54 @@
|
||||
(ns org.parkerici.sample-tracking.db.sample-type
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-sample-type
|
||||
[name id-suffix ships-with-kit reminder]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:sample-type/name name
|
||||
:sample-type/uuid uuid
|
||||
:sample-type/id-suffix id-suffix
|
||||
:sample-type/ships-with-kit ships-with-kit
|
||||
:sample-type/reminder reminder}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn find-sample-type-by-uuid
|
||||
[uuid]
|
||||
(first (d/q-latest '[:find ?name ?id-suffix ?ships-with-kit ?reminder
|
||||
:keys name id-suffix ships-with-kit reminder
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?sample-type :sample-type/uuid ?uuid]
|
||||
[?sample-type :sample-type/name ?name]
|
||||
[?sample-type :sample-type/id-suffix ?id-suffix]
|
||||
[?sample-type :sample-type/ships-with-kit ?ships-with-kit]
|
||||
[?sample-type :sample-type/reminder ?reminder]]
|
||||
uuid)))
|
||||
|
||||
(defn add-attribute-value-to-sample-type
|
||||
[sample-type-uuid value-uuid]
|
||||
(d/transact [[:db/add [:sample-type/uuid sample-type-uuid] :sample-type/attribute-values [:sample-attribute-value/uuid value-uuid]]]))
|
||||
|
||||
(defn list-sample-types
|
||||
[kit-type-uuid]
|
||||
(let [results (d/q-latest '[:find ?sample-type-uuid ?sample-type-name ?id-suffix ?ships-with-kit ?reminder ?kit-type-uuid
|
||||
:keys uuid name id-suffix ships-with-kit reminder kit-type-uuid
|
||||
:where
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/sample-types ?sample-type]
|
||||
[?sample-type :sample-type/name ?sample-type-name]
|
||||
[?sample-type :sample-type/uuid ?sample-type-uuid]
|
||||
[?sample-type :sample-type/id-suffix ?id-suffix]
|
||||
[?sample-type :sample-type/ships-with-kit ?ships-with-kit]
|
||||
[?sample-type :sample-type/reminder ?reminder]])]
|
||||
(cond-> results
|
||||
kit-type-uuid (db/reducer-filter :kit-type-uuid kit-type-uuid))))
|
||||
|
||||
(defn update-sample-type
|
||||
[uuid name id-suffix ships-with-kit reminder]
|
||||
(d/transact [{:db/id [:sample-type/uuid uuid]
|
||||
:sample-type/name name
|
||||
:sample-type/id-suffix id-suffix
|
||||
:sample-type/ships-with-kit ships-with-kit
|
||||
:sample-type/reminder reminder}]))
|
||||
426
src/clj/org/parkerici/sample_tracking/db/schema.clj
Normal file
426
src/clj/org/parkerici/sample_tracking/db/schema.clj
Normal file
@@ -0,0 +1,426 @@
|
||||
(ns org.parkerici.sample-tracking.db.schema
|
||||
(:require [org.parkerici.multitool.cljcore :as u]
|
||||
[org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.alzabo.schema :as schema]
|
||||
[org.parkerici.alzabo.datomic :as datomic]))
|
||||
|
||||
;;; NOTE: whenever this changes, run the function (transact-schema) to update all databases.
|
||||
;;; Also note that some schema changes are outlawed by Datomic, so verify it works.
|
||||
|
||||
;;; This uses the schema format from Alzabo: https://github.com/ParkerICI/alzabo/blob/master/src/alzabo/schema.clj
|
||||
|
||||
(def schema
|
||||
{:kinds
|
||||
{:study
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The name of the study (e.g. PICI0002)."}
|
||||
:active {:type :boolean
|
||||
:required true
|
||||
:doc "If this entity is active and should be displayed to users"}
|
||||
:create-time {:type :instant
|
||||
:required true
|
||||
:doc "The time this entity was created"}
|
||||
:participant-id-prefix {:type :string
|
||||
:doc "An initial prefix for this study's participant-ids"}
|
||||
:participant-id-regex {:type :string
|
||||
:doc "A regex for validating participant-ids"}
|
||||
:participant-id-validation-message {:type :string
|
||||
:doc "A message to display for invalid participant-ids"}
|
||||
:kit-id-prefix {:type :string
|
||||
:doc "An initial prefix for this study's kit-ids"}
|
||||
:kit-id-regex {:type :string
|
||||
:doc "A regex for validating kit-ids"}
|
||||
:kit-id-validation-message {:type :string
|
||||
:doc "A message to display for invalid kit-ids"}
|
||||
:cohorts {:type [:cohort :boolean]
|
||||
:cardinality :many
|
||||
:doc "The cohorts of participants in the study and their active statuses."}
|
||||
:sites {:type [:site :boolean]
|
||||
:cardinality :many
|
||||
:doc "The sites a study is running at and their active statuses."}}}
|
||||
|
||||
:site
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true
|
||||
:unique-id true
|
||||
:doc "The name of a site"}
|
||||
:create-time {:type :instant
|
||||
:required true
|
||||
:doc "The time this entity was created"}}}
|
||||
|
||||
:cohort
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true
|
||||
:doc "The name of a cohort of participants (e.g. Default or Cohort B)."}
|
||||
:study {:type :study
|
||||
:required true
|
||||
:doc "The study this cohort belongs to"}
|
||||
:create-time {:type :instant
|
||||
:required true
|
||||
:doc "The time this entity was created"}
|
||||
:kit-types {:type [:kit-type :boolean]
|
||||
:cardinality :many
|
||||
:doc "The types of kits that may be used for a cohort and their active statues."}}}
|
||||
|
||||
:kit-type
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true
|
||||
:doc "The name of a kit type (e.g. Blood Collection Kit)."}
|
||||
:create-time {:type :instant
|
||||
:required true
|
||||
:doc "The time this entity was created"}
|
||||
:collection-date-required {:type :boolean
|
||||
:required true
|
||||
:doc "Whether or not collection timestamp is required for this kit"}
|
||||
:air-waybill-required {:type :boolean
|
||||
:required true
|
||||
:doc "Whether or not air waybill is required for this kit"}
|
||||
:vendor-email {:type :string
|
||||
:doc "The email address for the vendor this kit belongs to."}
|
||||
:item-number {:type :long
|
||||
:required true
|
||||
:unique-id true
|
||||
:doc "The external ID for a kit-type. Used as a unique ID and to join with Therapak."}
|
||||
:sample-types {:type :sample-type
|
||||
:component true
|
||||
:cardinality :many
|
||||
:doc "A kit usually has multiple samples collected for it. These are the types of samples that can be collected for this type of kit."}
|
||||
:timepoints {:type :timepoint
|
||||
:component true
|
||||
:cardinality :many
|
||||
:doc "The timepoints this kit can be used for (e.g. Cycle 1 Day 1)"}
|
||||
:form-type {:type :form-type
|
||||
:component true
|
||||
:cardinality :one
|
||||
:doc "Form-type stores custom form field definitions that need to be collected for a kit. Depending on how the kit is being used, a different form might need to be filled out."}}}
|
||||
|
||||
:timepoint
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The name of the timepoint (e.g. Cycle 2 Day 3)."}}}
|
||||
|
||||
:sample-type
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true
|
||||
:doc "The name of a sample type (e.g. Red Cap Serum)"}
|
||||
:id-suffix {:type :string
|
||||
:required true
|
||||
:doc "A sample has a two part ID. The first part is the kit id that it belongs two, and the second part is this generic id-suffix."}
|
||||
:ships-with-kit {:type :boolean
|
||||
:required true
|
||||
:doc "If true, this sample is shipped out immediately by the site once the kit has been used. If false, the sample is kept by the site and might ship at a later date."}
|
||||
:reminder {:type :string
|
||||
:doc "A reminder about the sample to be displayed to the user. E.g. Please place tube only in Primary Bag or Cryobox"}
|
||||
:attribute-values {:type :sample-attribute-value
|
||||
:component true
|
||||
:cardinality :many
|
||||
:doc "Attributes for a sample (e.g. primary vs backup)"}}}
|
||||
|
||||
:sample-attribute
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true?
|
||||
:doc "The name of a sample attribute"}}}
|
||||
|
||||
:sample-attribute-value
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true?
|
||||
:doc "The name of a sample attribute value"}
|
||||
:attribute {:type :sample-attribute
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The attribute this value belongs to"}}}
|
||||
|
||||
:form-type
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:required true
|
||||
:unique-id true
|
||||
:doc "The name of a form. Different sample types can share the same form"}
|
||||
:fields {:type :form-type-field
|
||||
:cardinality :many
|
||||
:component true
|
||||
:required true
|
||||
:doc "The fields that belong to this form-type"}}}
|
||||
|
||||
:form-type-field
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:field-id {:type :string
|
||||
:required true
|
||||
:doc "The id used for this field on forms"}
|
||||
:field-type {:type :form-type-field-type
|
||||
:component true
|
||||
:required true
|
||||
:doc "The type of field this is (e.g. boolean, int, time, string, select)"}
|
||||
:required {:type :boolean
|
||||
:required true
|
||||
:doc "Whether or not this field is required"}
|
||||
:label {:type :string
|
||||
:required true
|
||||
:doc "The label for this field"}
|
||||
:options {:type [:string :string]
|
||||
:cardinality :many
|
||||
:doc "If this field is a select field, tuples of (id, value) for the select field"}}}
|
||||
|
||||
:kit
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:kit-id {:type :string
|
||||
:required true
|
||||
:doc "The string identifier for this kit."}
|
||||
:participant-id {:type :string
|
||||
:doc "The ID of the participant that this kit is being used to collect samples from."}
|
||||
:collection-timestamp {:type :instant
|
||||
:doc "A timestamp for when this kit was collected. Defined by the person entering data into the form."}
|
||||
:timezone {:type :string
|
||||
:required true
|
||||
:doc "The timezone for proper rendering of the timestamps that belong to this kit (e.g. America/Los_Angeles)"}
|
||||
:completing-first-name {:type :string
|
||||
:doc "The first name of the person completing this kit."}
|
||||
:completing-last-name {:type :string
|
||||
:doc "The last name of the person completing this kit."}
|
||||
:completing-email {:type :string
|
||||
:doc "The email address of the person completing this kit."}
|
||||
:comments {:type :string
|
||||
:doc "Comments about the kit."}
|
||||
:complete {:type :boolean
|
||||
:required true
|
||||
:doc "Whether or not this kit has been completed and submitted by the site."}
|
||||
:site {:type :site
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The site this kit was collected for."}
|
||||
:cohort {:type :cohort
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The cohort this kit was collected for."}
|
||||
:timepoints {:type :timepoint
|
||||
:cardinality :many
|
||||
:required true
|
||||
:doc "The timepoint this kit was collected for."}
|
||||
:kit-type {:type :kit-type
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The kit-type that this kit is an instance of."}
|
||||
:samples {:type :sample
|
||||
:component true
|
||||
:cardinality :many
|
||||
:doc "The samples that were collected for this kit."}
|
||||
; We can get a kit's shipments through samples, but also keep an explicit reference so that we don't lose
|
||||
; shipments associated with kits that don't have samples marked as shipped (can happen during the kit
|
||||
; sharing process or possibly if a user accidentally doesn't mark any samples in a kit as shipped).
|
||||
; Feels a little hacky, but best solution I have for now.
|
||||
; Maybe disable air waybill field unless a sample is marked as shipped, but could be confusing for users?
|
||||
:shipments {:type :shipment
|
||||
:cardinality :many
|
||||
:required false
|
||||
:doc "Any shipments associated with this kit"}
|
||||
:form-values {:type :form-value
|
||||
:component true
|
||||
:cardinality :many
|
||||
:doc "The values for the custom form fields defined in form-type collected for this kit."}
|
||||
:submission-timestamp {:type :instant
|
||||
:doc "A timestamp for when this kit was submitted."}
|
||||
:archived {:type :boolean
|
||||
:doc "If this kit has been archived"}}}
|
||||
|
||||
:sample
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:sample-id {:type :string
|
||||
:required :true
|
||||
:doc "The barcoded ID on this sample"}
|
||||
:collected {:type :boolean
|
||||
:doc "If this sample was collected"}
|
||||
:shipped {:type :boolean
|
||||
:doc "If this sample was shipped"}
|
||||
:sample-type {:type :sample-type
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The sample-type that this sample is an instance of."}
|
||||
:shipment {:type :shipment
|
||||
:cardinality :one
|
||||
:required false
|
||||
:doc "The shipment that this sample was shipped in"}}}
|
||||
|
||||
:form-value
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:field {:type :form-type-field
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The form-type-field that this value belongs to"}
|
||||
:value_string {:type :string
|
||||
:doc "If this field is a string, then value will be stored here."}
|
||||
:value_long {:type :long
|
||||
:doc "If this field is a long, then value will be stored here."}
|
||||
:value_float {:type :float
|
||||
:doc "If this field is a float, then value will be stored here."}
|
||||
:value_instant {:type :instant
|
||||
:doc "If this field is an instant (time), then value will be stored here."}
|
||||
:value_boolean {:type :boolean
|
||||
:doc "If this field is a boolean, then value will be stored here."}}}
|
||||
|
||||
:shipment
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:air-waybill {:type :string
|
||||
:required true}
|
||||
:archived {:type :boolean
|
||||
:doc "If this shipment has been archived"}}}
|
||||
|
||||
:proposed-kit-edit
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:kit {:type :kit
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The kit that this is proposing to edit"}
|
||||
:update-map {:type :string
|
||||
:required true
|
||||
:doc "A stringified kit map that can be used to update the kit via the kit-shipment api"}
|
||||
:status {:type :kit-edit-status
|
||||
:component true
|
||||
:required true
|
||||
:doc "The status of this edit (e.g. pending, approved, or denied)"}
|
||||
:user {:type :user
|
||||
:cardinality :one
|
||||
:required true
|
||||
:doc "The user proposing the edit."}
|
||||
:time {:type :instant
|
||||
:required true
|
||||
:doc "The time this edit was proposed."}
|
||||
:reviewing-user {:type :user
|
||||
:cardinality :one
|
||||
:doc "The user proposing the edit."}}}
|
||||
|
||||
:role
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:unique-id true
|
||||
:required true}}}
|
||||
|
||||
:user
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:email {:type :string
|
||||
:unique-id true
|
||||
:required true}
|
||||
:deactivated {:type :boolean}
|
||||
:roles {:type :role
|
||||
:cardinality :many
|
||||
:required true
|
||||
:doc "The roles that this user belongs to"}}}
|
||||
|
||||
:history
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:agent-email {:type :string
|
||||
:required true
|
||||
:doc "The email address of the agent making the change"}
|
||||
:time {:type :instant
|
||||
:required true
|
||||
:doc "The time this change was made"}
|
||||
:entity-type {:type :keyword
|
||||
:required true
|
||||
:doc "The type of entity being changed"}
|
||||
:entity-uuid {:type :uuid
|
||||
:required true
|
||||
:doc "The id of the database entity being changed"}
|
||||
:old-value {:type :string
|
||||
:required true
|
||||
:doc "The old value of the entity being changed"}
|
||||
:new-value {:type :string
|
||||
:doc "The new value of the entity being changed. Can be blank in the case of deletion"}}}
|
||||
|
||||
:migration
|
||||
{:fields {:uuid {:type :uuid
|
||||
:unique-id true
|
||||
:required true
|
||||
:doc "The UUID for the entity"}
|
||||
:name {:type :string
|
||||
:unique-id true
|
||||
:require true
|
||||
:doc "The name of the migration"}
|
||||
:time {:type :instant
|
||||
:require true
|
||||
:doc "The time the migration was made"}}}}
|
||||
|
||||
:enums {
|
||||
:form-type-field-type
|
||||
{:values #:form-type-field-type{:boolean "boolean"
|
||||
:int "int"
|
||||
:time "time"
|
||||
:select "select"
|
||||
:string "string"}}
|
||||
:kit-edit-status
|
||||
{:values #:kit-edit-status{:pending "pending"
|
||||
:approved "approved"
|
||||
:denied "denied"}}}})
|
||||
|
||||
(defn write-schema-file
|
||||
[datomic-schema]
|
||||
(u/schpit "resources/schema.edn" datomic-schema))
|
||||
|
||||
(defn transact-schema
|
||||
[]
|
||||
(let [datomic-schema (datomic/datomic-schema (schema/validate-schema schema))]
|
||||
(write-schema-file datomic-schema)
|
||||
(d/wrap-datomic-fn #(d/transact datomic-schema))))
|
||||
31
src/clj/org/parkerici/sample_tracking/db/shipment.clj
Normal file
31
src/clj/org/parkerici/sample_tracking/db/shipment.clj
Normal file
@@ -0,0 +1,31 @@
|
||||
(ns org.parkerici.sample-tracking.db.shipment
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-or-update-shipment
|
||||
[uuid air-waybill]
|
||||
(let [uuid-to-return (or uuid (db/squuid))
|
||||
txn (cond-> {:shipment/air-waybill air-waybill}
|
||||
uuid (assoc :db/id [:shipment/uuid uuid])
|
||||
(nil? uuid) (assoc :shipment/uuid uuid-to-return))]
|
||||
(db/transact [txn])
|
||||
uuid-to-return))
|
||||
|
||||
; Gets the shipments explicitly associated with a kit
|
||||
(defn list-shipments
|
||||
[config-map]
|
||||
(let [kit-uuid (:uuid config-map)
|
||||
query {:find '[?shipment-uuid ?air-waybill ?kit-uuid]
|
||||
:keys '[uuid air-waybill kit-uuid]
|
||||
:where '[[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/shipments ?shipment]
|
||||
[?shipment :shipment/uuid ?shipment-uuid]
|
||||
[?shipment :shipment/air-waybill ?air-waybill]]}
|
||||
query-fn (if-let [tx-id (:tx-id config-map)] (d/q-as-of tx-id) d/q-latest)
|
||||
results (query-fn query)]
|
||||
(cond-> results
|
||||
kit-uuid (db/reducer-filter :kit-uuid kit-uuid))))
|
||||
|
||||
(defn set-archived
|
||||
[uuid archived]
|
||||
(db/transact [{:db/id [:shipment/uuid uuid] :shipment/archived archived}]))
|
||||
82
src/clj/org/parkerici/sample_tracking/db/site.clj
Normal file
82
src/clj/org/parkerici/sample_tracking/db/site.clj
Normal file
@@ -0,0 +1,82 @@
|
||||
(ns org.parkerici.sample-tracking.db.site
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-site
|
||||
[name]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:site/name name :site/uuid uuid :site/create-time (Date.)}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn find-site-by-name
|
||||
[name]
|
||||
(first (d/q-latest '[:find ?site-uuid ?create-time
|
||||
:keys uuid create-time
|
||||
:in $ ?site-name
|
||||
:where
|
||||
[?site :site/uuid ?site-uuid]
|
||||
[?site :site/name ?site-name]
|
||||
[?site :site/create-time ?create-time]]
|
||||
name)))
|
||||
|
||||
(defn find-site-by-uuid
|
||||
[uuid]
|
||||
(first (d/q-latest '[:find ?site-name ?create-time
|
||||
:keys name create-time
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?site :site/uuid ?uuid]
|
||||
[?site :site/name ?site-name]
|
||||
[?site :site/create-time ?create-time]]
|
||||
uuid)))
|
||||
|
||||
(defn list-sites
|
||||
[study-uuid active]
|
||||
(let [query {:find '[?site-uuid ?site-name ?active ?create-time]
|
||||
:keys '[uuid name active create-time]
|
||||
:where '[[?study :study/uuid ?study-uuid]
|
||||
[?study :study/sites ?site-tuple]
|
||||
[(untuple ?site-tuple) [?site ?active]]
|
||||
[?site :site/name ?site-name]
|
||||
[?site :site/uuid ?site-uuid]
|
||||
[?site :site/create-time ?create-time]]}
|
||||
filtered-query (if (nil? active)
|
||||
(assoc query :in '[$ ?study-uuid])
|
||||
(assoc query :in '[$ ?study-uuid ?active]))]
|
||||
(apply d/q-latest (remove nil? [filtered-query study-uuid active]))))
|
||||
|
||||
(defn list-study-tuples
|
||||
[]
|
||||
(let [query {:find '[?study-uuid ?site-tuple]
|
||||
:keys '[uuid tuple]
|
||||
:where '[[?study :study/uuid ?study-uuid]
|
||||
[?study :study/sites ?site-tuple]]}]
|
||||
(apply d/q-latest (remove nil? [query]))))
|
||||
|
||||
(defn list-all-sites
|
||||
[]
|
||||
(let [query {:find '[?site ?site-uuid ?site-name]
|
||||
:keys '[id uuid name]
|
||||
:where '[[?site :site/uuid ?site-uuid]
|
||||
[?site :site/name ?site-name]]}]
|
||||
(apply d/q-latest (remove nil? [query]))))
|
||||
|
||||
(defn update-site
|
||||
[uuid name]
|
||||
(d/transact [{:db/id [:site/uuid uuid]
|
||||
:site/name name}]))
|
||||
|
||||
(defn update-site-active-status
|
||||
[study-uuid site-uuid status]
|
||||
(let [current-tuple (first (d/q-latest '[:find ?site ?active
|
||||
:in $ ?site-uuid ?study-uuid
|
||||
:where
|
||||
[?study :study/uuid ?study-uuid]
|
||||
[?study :study/sites ?site-tuple]
|
||||
[(untuple ?site-tuple) [?site ?active]]
|
||||
[?site :site/uuid ?site-uuid]]
|
||||
site-uuid study-uuid))]
|
||||
(when (some? current-tuple) (d/transact [[:db/retract [:study/uuid study-uuid] :study/sites current-tuple]]))
|
||||
(d/transact [[:db/add [:study/uuid study-uuid] :study/sites [[:site/uuid site-uuid] status]]])))
|
||||
110
src/clj/org/parkerici/sample_tracking/db/study.clj
Normal file
110
src/clj/org/parkerici/sample_tracking/db/study.clj
Normal file
@@ -0,0 +1,110 @@
|
||||
(ns org.parkerici.sample-tracking.db.study
|
||||
(:require [org.parkerici.sample-tracking.db.core :as db]
|
||||
[org.parkerici.sample-tracking.db.datomic :as d])
|
||||
(:import (java.util Date)))
|
||||
|
||||
(defn create-study
|
||||
[name]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:study/name name :study/uuid uuid :study/active true :study/create-time (Date.)}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
(defn find-study-by-name
|
||||
[name]
|
||||
(first (d/q-latest '[:find ?study-uuid ?active ?create-time
|
||||
:keys uuid active create-time
|
||||
:in $ ?study-name
|
||||
:where
|
||||
[?study :study/uuid ?study-uuid]
|
||||
[?study :study/name ?study-name]
|
||||
[?study :study/active ?active]
|
||||
[?study :study/create-time ?create-time]]
|
||||
name)))
|
||||
|
||||
(defn find-study-by-uuid
|
||||
[uuid]
|
||||
(first (d/q-latest '[:find ?study-name ?active ?create-time
|
||||
:keys name active create-time
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?study :study/uuid ?uuid]
|
||||
[?study :study/name ?study-name]
|
||||
[?study :study/active ?active]
|
||||
[?study :study/create-time ?create-time]]
|
||||
uuid)))
|
||||
|
||||
(defn add-site-to-study
|
||||
[site-uuid study-name]
|
||||
(d/transact [[:db/add [:study/name study-name] :study/sites [[:site/uuid site-uuid] true]]]))
|
||||
|
||||
(defn site-is-associated-with-study
|
||||
[site-uuid study-name]
|
||||
(seq (d/q-latest '[:find ?study
|
||||
:in $ ?site-uuid ?study-name
|
||||
:where
|
||||
[?study :study/name ?study-name]
|
||||
[?study :study/sites ?site-tuple]
|
||||
[(untuple ?site-tuple) [?site ?active]]
|
||||
[?site :site/uuid ?site-uuid]]
|
||||
site-uuid study-name)))
|
||||
|
||||
(defn add-cohort-to-study
|
||||
[study-uuid cohort-uuid]
|
||||
(d/transact [[:db/add [:study/uuid study-uuid] :study/cohorts [[:cohort/uuid cohort-uuid] true]]]))
|
||||
|
||||
(defn add-participant-id-validation-to-study
|
||||
[study-name prefix regex message]
|
||||
(d/transact [{:db/id [:study/name study-name]
|
||||
:study/participant-id-prefix prefix
|
||||
:study/participant-id-regex regex
|
||||
:study/participant-id-validation-message message}]))
|
||||
|
||||
(defn add-kit-id-validation-to-study
|
||||
[study-name prefix regex message]
|
||||
(d/transact [{:db/id [:study/name study-name]
|
||||
:study/kit-id-prefix prefix
|
||||
:study/kit-id-regex regex
|
||||
:study/kit-id-validation-message message}]))
|
||||
|
||||
(defn list-studies
|
||||
[active]
|
||||
(let [query {:find '[?uuid ?study-name ?active ?create-time ?participant-id-prefix ?participant-id-regex
|
||||
?participant-id-validation-message ?kit-id-prefix ?kit-id-regex ?kit-id-validation-message]
|
||||
:keys '[uuid name active create-time participant-id-prefix participant-id-regex
|
||||
participant-id-validation-message kit-id-prefix kit-id-regex kit-id-validation-message]
|
||||
:where '[[?study :study/name ?study-name]
|
||||
[?study :study/active ?active]
|
||||
[?study :study/create-time ?create-time]
|
||||
[?study :study/uuid ?uuid]
|
||||
[(get-else $ ?study :study/participant-id-prefix "") ?participant-id-prefix]
|
||||
[(get-else $ ?study :study/participant-id-regex "") ?participant-id-regex]
|
||||
[(get-else $ ?study :study/participant-id-validation-message "") ?participant-id-validation-message]
|
||||
[(get-else $ ?study :study/kit-id-prefix "") ?kit-id-prefix]
|
||||
[(get-else $ ?study :study/kit-id-regex "") ?kit-id-regex]
|
||||
[(get-else $ ?study :study/kit-id-validation-message "") ?kit-id-validation-message]]}
|
||||
filtered-query (if (nil? active)
|
||||
query
|
||||
(assoc query :in '[$ ?active]))]
|
||||
(apply d/q-latest (remove nil? [filtered-query active]))))
|
||||
|
||||
(defn cohort-associated-with-study
|
||||
[study-uuid cohort-uuid]
|
||||
(seq (d/q-latest '[:find ?cohort ?study
|
||||
:in $ ?cohort-uuid ?study-uuid
|
||||
:where
|
||||
[?study :study/uuid ?study-uuid]
|
||||
[?study :study/cohorts ?cohort-tuple]
|
||||
[(untuple ?cohort-tuple) [?cohort ?active]]
|
||||
[?cohort :cohort/uuid ?cohort-uuid]]
|
||||
cohort-uuid study-uuid)))
|
||||
|
||||
(defn update-study
|
||||
[uuid name]
|
||||
(d/transact [{:db/id [:study/uuid uuid]
|
||||
:study/name name}]))
|
||||
|
||||
(defn update-study-active-status
|
||||
[uuid status]
|
||||
(d/transact [{:db/id [:study/uuid uuid]
|
||||
:study/active status}]))
|
||||
68
src/clj/org/parkerici/sample_tracking/db/timepoint.clj
Normal file
68
src/clj/org/parkerici/sample_tracking/db/timepoint.clj
Normal file
@@ -0,0 +1,68 @@
|
||||
(ns org.parkerici.sample-tracking.db.timepoint
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-timepoint
|
||||
[name]
|
||||
(let [uuid (db/squuid)
|
||||
txn {:timepoint/name name :timepoint/uuid uuid}]
|
||||
(db/transact [txn])
|
||||
uuid))
|
||||
|
||||
; There should only be one timepoint with a given name.
|
||||
; Returns the ID of the timepoint with the passed in name if it exists.
|
||||
(defn find-timepoint-uuid-from-name
|
||||
[name]
|
||||
(ffirst (d/q-latest '[:find ?timepoint-uuid
|
||||
:in $ ?timepoint-name
|
||||
:where
|
||||
[?timepoint :timepoint/name ?timepoint-name]
|
||||
[?timepoint :timepoint/uuid ?timepoint-uuid]]
|
||||
name)))
|
||||
|
||||
(defn find-timepoint-by-uuid
|
||||
[uuid]
|
||||
(first (d/q-latest '[:find ?timepoint-name
|
||||
:keys name
|
||||
:in $ ?uuid
|
||||
:where
|
||||
[?timepoint :timepoint/uuid ?uuid]
|
||||
[?timepoint :timepoint/name ?timepoint-name]]
|
||||
uuid)))
|
||||
|
||||
(defn list-sorted-kit-type-timepoints
|
||||
"Gets the timepoints associated with a given kit type
|
||||
in the order they were associated with that kit type"
|
||||
[kit-type-uuid]
|
||||
(let [results (d/q-latest '[:find ?timepoint-uuid ?timepoint-name ?tx-inst
|
||||
:keys uuid name sort-time
|
||||
:in $ ?kit-type-uuid
|
||||
:where
|
||||
[?kit-type :kit-type/uuid ?kit-type-uuid]
|
||||
[?kit-type :kit-type/timepoints ?timepoint ?tx-eid]
|
||||
[?tx-eid :db/txInstant ?tx-inst]
|
||||
[?kit-type :kit-type/timepoints ?timepoint]
|
||||
[?timepoint :timepoint/name ?timepoint-name]
|
||||
[?timepoint :timepoint/uuid ?timepoint-uuid]]
|
||||
kit-type-uuid)
|
||||
sorted-results (sort-by :sort-time results)]
|
||||
(map #(dissoc % :sort-time) sorted-results)))
|
||||
|
||||
(defn update-timepoint
|
||||
[uuid name]
|
||||
(d/transact [{:db/id [:timepoint/uuid uuid]
|
||||
:timepoint/name name}]))
|
||||
|
||||
(defn list-kit-timepoints
|
||||
[config-map]
|
||||
(let [kit-uuid (:uuid config-map)
|
||||
query {:find '[?timepoint-uuid ?timepoint-name ?kit-uuid]
|
||||
:keys '[uuid timepoint-name kit-uuid]
|
||||
:where '[[?kit :kit/uuid ?kit-uuid]
|
||||
[?kit :kit/timepoints ?timepoint]
|
||||
[?timepoint :timepoint/name ?timepoint-name]
|
||||
[?timepoint :timepoint/uuid ?timepoint-uuid]]}
|
||||
query-fn (if-let [tx-id (:tx-id config-map)] (d/q-as-of tx-id) d/q-latest)
|
||||
results (query-fn query)]
|
||||
(cond-> results
|
||||
kit-uuid (db/reducer-filter :kit-uuid kit-uuid))))
|
||||
73
src/clj/org/parkerici/sample_tracking/db/user.clj
Normal file
73
src/clj/org/parkerici/sample_tracking/db/user.clj
Normal file
@@ -0,0 +1,73 @@
|
||||
(ns org.parkerici.sample-tracking.db.user
|
||||
(:require [org.parkerici.sample-tracking.db.datomic :as d]
|
||||
[org.parkerici.sample-tracking.db.core :as db]))
|
||||
|
||||
(defn create-user
|
||||
[email]
|
||||
(let [uuid (db/squuid)]
|
||||
(db/transact [{:user/email email :user/uuid uuid}])
|
||||
uuid))
|
||||
|
||||
(defn find-user-uuid
|
||||
[email]
|
||||
(ffirst (d/q-latest '[:find ?uuid
|
||||
:in $ ?email
|
||||
:where
|
||||
[?user :user/email ?email]
|
||||
[?user :user/uuid ?uuid]]
|
||||
email)))
|
||||
|
||||
(defn add-role-to-user
|
||||
[user-uuid role-uuid]
|
||||
(d/transact [[:db/add [:user/uuid user-uuid] :user/roles [:role/uuid role-uuid]]]))
|
||||
|
||||
(defn remove-role-from-user
|
||||
[user-uuid role-uuid]
|
||||
(d/transact [[:db/retract [:user/uuid user-uuid] :user/roles [:role/uuid role-uuid]]]))
|
||||
|
||||
(defn set-user-deactivated-status
|
||||
[email status]
|
||||
(d/transact [{:db/id [:user/email email]
|
||||
:user/deactivated status}]))
|
||||
|
||||
(defn user-has-role
|
||||
[user-uuid role-uuid]
|
||||
(seq (d/q-latest '[:find ?email
|
||||
:in $ ?user-uuid ?role-uuid
|
||||
:where
|
||||
[?user :user/uuid ?user-uuid]
|
||||
[?user :user/email ?email]
|
||||
[?user :user/roles ?role]
|
||||
[?role :role/uuid ?role-uuid]] user-uuid role-uuid)))
|
||||
|
||||
(defn get-users-roles
|
||||
[email]
|
||||
(d/q-latest '[:find ?role-name
|
||||
:in $ ?email
|
||||
:where
|
||||
[?user :user/email ?email]
|
||||
[?user :user/roles ?role]
|
||||
[?role :role/name ?role-name]]
|
||||
email))
|
||||
|
||||
(defn get-users-with-role
|
||||
[role-name]
|
||||
(d/q-latest '[:find ?email
|
||||
:in $ ?role-name
|
||||
:where
|
||||
[?role :role/name ?role-name]
|
||||
[?user :user/roles ?role]
|
||||
[?user :user/email ?email]]
|
||||
role-name))
|
||||
|
||||
(defn list-users
|
||||
[options]
|
||||
(let [all-users (map first (d/q-latest '[:find (pull ?user [[:user/uuid :as :uuid]
|
||||
[:user/email :as :email]
|
||||
[:user/deactivated :default false :as :deactivated]
|
||||
{[:user/roles :as :roles] [[:role/name :as :name]
|
||||
[:role/uuid :as :uuid]]}])
|
||||
:where [?user :user/uuid]]))]
|
||||
(if (:email options)
|
||||
(db/reducer-filter all-users :email (:email options))
|
||||
all-users)))
|
||||
173
src/clj/org/parkerici/sample_tracking/handler.clj
Normal file
173
src/clj/org/parkerici/sample_tracking/handler.clj
Normal file
@@ -0,0 +1,173 @@
|
||||
(ns org.parkerici.sample-tracking.handler
|
||||
(:require [compojure.core :refer [defroutes context routes POST GET PATCH DELETE make-route]]
|
||||
[compojure.route :as route]
|
||||
[ring.middleware.format-params :refer [wrap-transit-json-params]]
|
||||
[ring.middleware.format-response :refer [wrap-transit-json-response]]
|
||||
[ring.logger :as logger]
|
||||
[ring.middleware.session.memory :as ring-memory]
|
||||
[ring.middleware.gzip :refer [wrap-gzip]]
|
||||
[taoensso.timbre :as log]
|
||||
[ring.middleware.defaults :as middleware]
|
||||
[ring.util.response :as response]
|
||||
[org.parkerici.sample-tracking.api :as api]
|
||||
[org.parkerici.sample-tracking.utils.ring :as ring-utils]
|
||||
[org.parkerici.sample-tracking.handlers.auth :as auth]
|
||||
[org.parkerici.sample-tracking.db.datomic :as datomic]))
|
||||
|
||||
(defroutes site-routes
|
||||
;; Things handled by SPA
|
||||
(GET "*" [] (response/content-type (response/resource-response "index.html" {:root "public"}) "text/html")))
|
||||
|
||||
;;; Weird that this isn't a standard part of ring
|
||||
(defn wrap-exception-handling
|
||||
[handler]
|
||||
(fn [request]
|
||||
(try
|
||||
(handler request)
|
||||
(catch clojure.lang.ExceptionInfo e
|
||||
{:status 400 :headers {} :body (str "Error: " (ex-message e))})
|
||||
(catch Throwable e
|
||||
{:status 500 :headers {} :body (str "Error: " (print-str e))}))))
|
||||
|
||||
;;; Weird that this isn't a standard part of ring
|
||||
(defn wrap-no-read-eval
|
||||
[handler]
|
||||
(fn [request]
|
||||
(binding [*read-eval* false]
|
||||
(handler request))))
|
||||
|
||||
;;; Ensure API and site pages use the same store, so authentication works for API.
|
||||
(def common-store (ring-memory/memory-store))
|
||||
|
||||
;;; Note: static resources are handled by middleware, see middleware/site-defaults
|
||||
(def site-defaults
|
||||
(-> middleware/site-defaults
|
||||
auth/set-auth-site-defaults
|
||||
(assoc-in [:security :anti-forgery] false) ;necessary for upload (TODO not great from sec viewpoint)
|
||||
(assoc :cookies true)
|
||||
(assoc-in [:params :multipart] true) ;to support file uploads
|
||||
(assoc-in [:session :flash] false)
|
||||
(assoc-in [:session :store] common-store)))
|
||||
|
||||
(defn wrap-logger
|
||||
"Hook Ring logger to timbre unless logger is disabled"
|
||||
[handler options]
|
||||
(if (:disable-logger options)
|
||||
handler
|
||||
(logger/wrap-with-logger
|
||||
handler
|
||||
{:log-fn (fn [{:keys [level throwable message]}]
|
||||
(log/log level throwable message))})))
|
||||
|
||||
(defn make-site
|
||||
[options]
|
||||
(-> site-routes
|
||||
(auth/wrap-auth options)
|
||||
datomic/wrap-datomic
|
||||
(middleware/wrap-defaults site-defaults)
|
||||
wrap-no-read-eval
|
||||
(wrap-logger options)
|
||||
wrap-exception-handling))
|
||||
|
||||
(defroutes api-routes
|
||||
(context "/api" []
|
||||
(GET "/" [] (api/api-version))
|
||||
(context "/kit" []
|
||||
(POST "/" request (api/submit-kit-shipment request))
|
||||
(PATCH "/" request (api/update-kit-shipment request))
|
||||
(GET "/" request (api/list-kit-shipments request))
|
||||
(GET "/submitted" [kit-id] (api/kit-shipment-submitted kit-id))
|
||||
(PATCH "/set-archived" [uuid archived :as request] (api/set-kit-shipment-archived request uuid archived))
|
||||
(context "/share" []
|
||||
(POST "/" request (api/create-incomplete-kit-shipment request))
|
||||
(PATCH "/" request (api/update-incomplete-kit-shipment request))
|
||||
(GET "/" [uuid] (api/get-incomplete-kit-shipment uuid)))
|
||||
(context "/propose-edit" []
|
||||
(GET "/" request (api/get-kit-shipment-or-proposed-edit request))
|
||||
(GET "/view" request (api/get-proposed-kit-shipment-edit-for-view request))
|
||||
(GET "/list" [status] (api/list-proposed-kit-shipment-edits status))
|
||||
(POST "/" request (api/propose-kit-shipment-edit request))
|
||||
(POST "/set-status" request (api/set-kit-shipment-edit-status request))))
|
||||
(context "/upload" []
|
||||
(POST "/kit-type" request (api/upload-kit-types request))
|
||||
(POST "/form-type" request (api/upload-form-types request))
|
||||
(POST "/site" request (api/upload-sites request))
|
||||
(POST "/study" request (api/upload-studies request)))
|
||||
(context "/site" []
|
||||
(GET "/" [study active] (api/list-sites study active))
|
||||
(POST "/" request (api/update-site request)))
|
||||
(context "/study" []
|
||||
(GET "/" [active] (api/list-studies active))
|
||||
(POST "/" request (api/update-study request)))
|
||||
(context "/cohort" []
|
||||
(GET "/" [study active] (api/list-cohorts study active))
|
||||
(POST "/" request (api/update-cohort request)))
|
||||
(context "/kit-type" []
|
||||
(GET "/" [cohort active] (api/list-kit-types cohort active))
|
||||
(POST "/" request (api/update-kit-type request)))
|
||||
(context "/timepoint" []
|
||||
(GET "/" [kit-type] (api/list-timepoints kit-type))
|
||||
(POST "/" request (api/update-timepoint request)))
|
||||
(context "/sample-type" []
|
||||
(GET "/" [kit-type] (api/list-sample-types kit-type))
|
||||
(POST "/" request (api/update-sample-type request)))
|
||||
(context "/sample" []
|
||||
(GET "/export" [uuid complete archived uncollected]
|
||||
(api/export-samples->csv uuid complete archived uncollected)))
|
||||
(context "/user" []
|
||||
(GET "/" [] (api/list-users))
|
||||
(POST "/" request (api/create-user request))
|
||||
(DELETE "/" request (api/deactivate-user request))
|
||||
(GET "/current" request (api/user-info request))
|
||||
(context "/role" []
|
||||
(POST "/" request (api/add-role-to-user request))
|
||||
(DELETE "/" request (api/remove-role-from-user request))))
|
||||
(GET "/role" [] (api/list-roles))
|
||||
(GET "/form-type-fields" [kit-type] (api/get-form-type-fields kit-type))
|
||||
(GET "/history" [uuid] (api/list-history uuid))
|
||||
(POST "/set-active" request (api/set-active request))
|
||||
(GET "/configuration" [] (api/list-configuration))
|
||||
(POST "/log-in" request (api/log-in request))
|
||||
(POST "/log-out" request (api/log-out request))
|
||||
(GET "/firebase-credentials" [] (api/firebase-js-credentials))
|
||||
(GET "/health" [] (ring-utils/json-response {:success true} :status 200))
|
||||
(route/not-found (ring-utils/json-response {:error "Not Found"} :status 404))))
|
||||
|
||||
(def api-defaults
|
||||
(-> middleware/api-defaults
|
||||
auth/set-auth-site-defaults
|
||||
(assoc :cookies true)
|
||||
(assoc-in [:session :flash] false)
|
||||
(assoc-in [:session :store] common-store)))
|
||||
|
||||
;;; Must be something built-in for this?
|
||||
(defn wrap-filter
|
||||
[handler path]
|
||||
(make-route nil path handler))
|
||||
|
||||
(defn make-api
|
||||
[options]
|
||||
(-> api-routes
|
||||
(auth/wrap-auth options)
|
||||
(middleware/wrap-defaults api-defaults)
|
||||
wrap-no-read-eval
|
||||
datomic/wrap-datomic
|
||||
wrap-transit-json-params
|
||||
(wrap-logger options)
|
||||
wrap-exception-handling
|
||||
wrap-transit-json-response
|
||||
wrap-gzip
|
||||
(wrap-filter "/api/*")))
|
||||
|
||||
; Returns a blank response for anything called to /__/auth/*
|
||||
; Used for firebase auth stuff. Hopefully works.
|
||||
(defn make-firebase
|
||||
[]
|
||||
(wrap-filter (GET "/__/auth/*" [] {}) "/__/auth/*"))
|
||||
|
||||
(defn make-app
|
||||
[options]
|
||||
(routes (make-api options) (make-firebase) (make-site options)))
|
||||
|
||||
(def app
|
||||
(make-app {}))
|
||||
127
src/clj/org/parkerici/sample_tracking/handlers/auth.clj
Normal file
127
src/clj/org/parkerici/sample_tracking/handlers/auth.clj
Normal file
@@ -0,0 +1,127 @@
|
||||
(ns org.parkerici.sample-tracking.handlers.auth
|
||||
(:require [clojure.string :as str]
|
||||
[ring.util.response :as response]
|
||||
[buddy.auth :refer [authenticated?]]
|
||||
[buddy.auth.backends.session :refer [session-backend]]
|
||||
[buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]
|
||||
[buddy.auth.accessrules :refer [wrap-access-rules]]
|
||||
[org.parkerici.sample-tracking.utils.ring :as ring-utils]
|
||||
[org.parkerici.sample-tracking.configuration :as config]))
|
||||
|
||||
(defn set-auth-site-defaults
|
||||
[site-defaults]
|
||||
(assoc-in site-defaults [:session :cookie-attrs :same-site] :lax))
|
||||
|
||||
; Default unauthorized handler. If the request is to an API page return a json response
|
||||
; Otherwise redirect the user to the unauthorized page.
|
||||
(defn unauthorized-handler
|
||||
[request _metadata]
|
||||
(if (str/starts-with? (:uri request) "/api")
|
||||
(if (authenticated? request)
|
||||
(ring-utils/json-response {:error "Unauthorized"} :status 403)
|
||||
(ring-utils/json-response {:error "Unauthorized"} :status 401))
|
||||
(let [{:keys [auth-error is-a-user email-verified]} (:session request)]
|
||||
(cond
|
||||
(false? is-a-user) (response/redirect "/auth/not-a-user")
|
||||
(false? email-verified) (response/redirect "/auth/verify-email")
|
||||
auth-error (response/redirect "/auth/auth-error")
|
||||
:else (response/redirect "/auth/unauthorized")))))
|
||||
|
||||
; Create an instance of session auth backend.
|
||||
(def session-auth-backend
|
||||
(session-backend {:unauthorized-handler unauthorized-handler}))
|
||||
|
||||
; Checks if the logged in user has been added to the database
|
||||
; if their email is verified and if there were any errors during authentication
|
||||
(defn auth-successful?
|
||||
[request]
|
||||
(let [{:keys [auth-error is-a-user email-verified]} (:session request)]
|
||||
(and is-a-user email-verified (not auth-error))))
|
||||
|
||||
; Admin access handler.
|
||||
; Checks if the session roles has the admin role in it.
|
||||
(defn admin-access
|
||||
[request]
|
||||
(let [roles (get-in request [:session :roles])]
|
||||
(contains? roles (config/application-admin-role))))
|
||||
|
||||
(defn admin-or-editor-access
|
||||
[request]
|
||||
(let [roles (get-in request [:session :roles])]
|
||||
(or
|
||||
(contains? roles (config/application-admin-role))
|
||||
(contains? roles (config/application-editor-role)))))
|
||||
|
||||
(defn internal-access
|
||||
[request]
|
||||
(let [roles (get-in request [:session :roles])]
|
||||
(or
|
||||
(contains? roles (config/application-admin-role))
|
||||
(contains? roles (config/application-editor-role))
|
||||
(contains? roles (config/application-viewer-role)))))
|
||||
|
||||
(defn site-access
|
||||
[request]
|
||||
(let [roles (get-in request [:session :roles])]
|
||||
(or
|
||||
(contains? roles (config/site-admin-role))
|
||||
(contains? roles (config/site-coordinator-role)))))
|
||||
|
||||
(defn valid-api-key?
|
||||
[request]
|
||||
(let [auth-header (get-in request [:headers "authorization"])
|
||||
api-key (if auth-header (second (str/split auth-header #" ")) nil)]
|
||||
(= api-key (config/api-key))))
|
||||
|
||||
; Open access. Always returns true.
|
||||
(defn open-access
|
||||
[_request]
|
||||
true)
|
||||
|
||||
; Access rules for the buddy-auth system
|
||||
(def rules
|
||||
[{:uris ["/" "/auth/*" "/manifest" "/api/" "/api/study" "/api/cohort" "/api/timepoint" "/api/kit-type"
|
||||
"/api/sample-type" "/api/form-type-fields" "/index.html" "/favicon.ico" "/api/health" "/api/site"
|
||||
"/cljs-out/main.js" "/css/*" "/oauth2/*" "/__/auth/*" "/api/current-user" "/share/*" "/images/*"
|
||||
"/api/user/current" "/api/kit/submitted" "/api/firebase-credentials"]
|
||||
:handler open-access
|
||||
:request-method :get}
|
||||
{:uris ["/api/kit" "/api/log-in" "/api/log-out"]
|
||||
:handler open-access
|
||||
:request-method :post}
|
||||
{:uri "/api/kit/share"
|
||||
:handler open-access
|
||||
:request-method #{:post :patch :get}}
|
||||
{:uris ["/console" "/console/kit/list" "/console/kit/propose/new/*" "/api/kit"]
|
||||
:handler {:and [auth-successful? {:or [internal-access site-access]}]}
|
||||
:request-method #{:get}}
|
||||
{:uri "/api/kit/propose-edit"
|
||||
:handler {:and [auth-successful? {:or [internal-access site-access]}]}
|
||||
:request-method #{:post :get}}
|
||||
{:uris ["/console/*" "/api/history"]
|
||||
:handler {:and [auth-successful? internal-access]}
|
||||
:request-method #{:get}}
|
||||
{:uri "/api/sample/export"
|
||||
:handler {:or [valid-api-key? {:and [auth-successful? internal-access]}]}
|
||||
:request-method #{:get}}
|
||||
{:uri "/api/kit/set-archived"
|
||||
:handler {:and [auth-successful? admin-or-editor-access]}
|
||||
:request-method #{:patch}}
|
||||
{:uris ["/console/kit/propose/*" "/api/kit/propose-edit*"]
|
||||
:handler admin-or-editor-access
|
||||
:request-method #{:get :post}}
|
||||
{:uris ["/api/upload/*" "/api/site" "/api/study" "/api/cohort" "/api/timepoint" "/api/kit-type" "/api/kit"
|
||||
"/api/sample-type" "/api/set-active" "/api/user" "/api/user/*" "/api/role" "/api/configuration"]
|
||||
:handler {:and [auth-successful? admin-access]}
|
||||
:request-method #{:post :patch :get :delete}}])
|
||||
|
||||
(defn wrap-auth
|
||||
[handler options]
|
||||
(let [buddy-auth-handler (-> handler
|
||||
(wrap-access-rules {:rules rules
|
||||
:policy :reject})
|
||||
(wrap-authorization session-auth-backend)
|
||||
(wrap-authentication session-auth-backend))]
|
||||
(if-let [auth-wrapper-override (:auth-wrapper options)]
|
||||
(auth-wrapper-override buddy-auth-handler)
|
||||
buddy-auth-handler)))
|
||||
19
src/clj/org/parkerici/sample_tracking/server.clj
Executable file
19
src/clj/org/parkerici/sample_tracking/server.clj
Executable file
@@ -0,0 +1,19 @@
|
||||
(ns org.parkerici.sample-tracking.server
|
||||
(:require [ring.adapter.jetty :as jetty]
|
||||
[taoensso.timbre :as log]
|
||||
[trptcolin.versioneer.core :as version]
|
||||
[org.parkerici.sample-tracking.handler :as handler]))
|
||||
|
||||
(def server (atom nil))
|
||||
|
||||
(defn stop
|
||||
[]
|
||||
(when @server
|
||||
(.stop @server)))
|
||||
|
||||
(defn start
|
||||
([port] (start port handler/app))
|
||||
([port handler]
|
||||
(log/infof "Starting sample-tracking server version %s at port %s" (version/get-version "sample-tracking" "sample-tracking") port)
|
||||
(stop)
|
||||
(reset! server (jetty/run-jetty handler {:port port :join? false}))))
|
||||
74
src/clj/org/parkerici/sample_tracking/utils/csv.clj
Normal file
74
src/clj/org/parkerici/sample_tracking/utils/csv.clj
Normal file
@@ -0,0 +1,74 @@
|
||||
(ns org.parkerici.sample-tracking.utils.csv
|
||||
(:require [clojure.java.io :as io]
|
||||
[clojure.set :as set]
|
||||
[clojure.string :as str]
|
||||
[clojure.data.csv :as csv]))
|
||||
|
||||
; Might be worth switching to https://github.com/jimpil/clj-bom if we have more encoding issues in the future.
|
||||
(defn read-csv-file
|
||||
"Encoding can be any valid encoding like 'UTF-8' or 'UTF-16LE'. Defaults to 'UTF-8'.
|
||||
Delimiter for read-csv-file defaults to comma, but can be any character (e.g. \tab)"
|
||||
[fpath & {:keys [encoding delimiter] :or {delimiter \,}}]
|
||||
(with-open [reader (io/reader fpath :encoding encoding)]
|
||||
(doall
|
||||
(csv/read-csv reader :separator delimiter))))
|
||||
|
||||
(defn split-csv-string
|
||||
[value]
|
||||
(doall (map str/trim (str/split value #","))))
|
||||
|
||||
(defn generate-raw-headers
|
||||
"Generates a list of all of the distinct keys from the maps in data-seq as strings"
|
||||
[data-seq column-order]
|
||||
(let [headers-set (set (reduce (fn [headers row] (concat headers (keys row))) [] data-seq))
|
||||
headers-missing-from-order (set/difference headers-set (set column-order))]
|
||||
(concat column-order (vec headers-missing-from-order))))
|
||||
|
||||
(defn generate-csv-rows
|
||||
[headers data-seq]
|
||||
(map (fn [row] (mapv row headers)) data-seq))
|
||||
|
||||
(defn generate-csv-data
|
||||
"Takes input of a seq of maps
|
||||
Outputs a seq of seqs of the format csv/write-csv expects.
|
||||
The first seq being the header and the rest being data.
|
||||
Expects a list or nil for column order. If passed in uses it to order the columns.
|
||||
Any missing columns are appended to the end in random order.
|
||||
Expects map or nil for renamed-columns. If passed in uses the values in the map to rename the columns.
|
||||
Otherwise uses (name)."
|
||||
[data-seq column-order columns-to-rename]
|
||||
(let [raw-headers (generate-raw-headers data-seq column-order)
|
||||
string-headers (map (fn [header]
|
||||
(let [renamed-header (get columns-to-rename header)]
|
||||
(if renamed-header
|
||||
renamed-header
|
||||
(name header)))) raw-headers)]
|
||||
(cons string-headers (generate-csv-rows raw-headers data-seq))))
|
||||
|
||||
(defn csv-output-stream-fn
|
||||
"Takes input of a seq of maps
|
||||
Outputs a function that writes the csv data to a stream"
|
||||
[data-seq options]
|
||||
(let [csv-data (generate-csv-data data-seq (:column-order options) (:columns-to-rename options))]
|
||||
(fn [out-stream] (csv/write-csv out-stream csv-data)
|
||||
(.flush out-stream))))
|
||||
|
||||
(defn write-csv-file
|
||||
[fpath data-seq options]
|
||||
(with-open [w (io/writer fpath)]
|
||||
(doall
|
||||
(csv/write-csv w (generate-csv-data data-seq (:column-order options) (:columns-to-rename options))))))
|
||||
|
||||
(defn read-csv-into-map
|
||||
"Reads a CSV at fpath. Expects it to have a header
|
||||
Returns a list of maps where each column value is keyed on the csv-headers passed in
|
||||
If csv-headers is empty or missing values will use the column/header names from the file.
|
||||
Applies required-values-fn to each map value to filter out bad rows."
|
||||
[fpath csv-headers required-values-fn]
|
||||
(let [raw-csv (read-csv-file fpath)
|
||||
csv-header (first raw-csv)
|
||||
extra-headers (subvec csv-header (count csv-headers))
|
||||
all-headers (concat csv-headers extra-headers)
|
||||
csv-rows (drop 1 raw-csv)
|
||||
csv-map (map #(zipmap all-headers %) csv-rows)]
|
||||
(filter required-values-fn csv-map)))
|
||||
22
src/clj/org/parkerici/sample_tracking/utils/date_time.clj
Normal file
22
src/clj/org/parkerici/sample_tracking/utils/date_time.clj
Normal file
@@ -0,0 +1,22 @@
|
||||
(ns org.parkerici.sample-tracking.utils.date-time
|
||||
(:require [java-time :as time]
|
||||
[org.parkerici.sample-tracking.utils.str :as str]))
|
||||
|
||||
(defn parse-zoned-date-time
|
||||
[date-time-string timezone-string]
|
||||
(let [timezone-id (time/zone-id timezone-string)]
|
||||
(time/zoned-date-time (time/java-date date-time-string) timezone-id)))
|
||||
|
||||
(defn timestamp-parsable
|
||||
[timestamp]
|
||||
(and (some? timestamp) (if (string? timestamp) (str/not-blank? timestamp) true)))
|
||||
|
||||
(defn generate-date-string
|
||||
[timestamp timezone]
|
||||
(when (timestamp-parsable timestamp)
|
||||
(time/format "MM/dd/yyyy" (parse-zoned-date-time timestamp timezone))))
|
||||
|
||||
(defn generate-time-string
|
||||
[timestamp timezone]
|
||||
(when (timestamp-parsable timestamp)
|
||||
(time/format "HH:mm" (parse-zoned-date-time timestamp timezone))))
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user