Repository: CSCfi/rems
Pull request #1689 (2019-10-07 13:59:26)

Revoke action: backend
#1661


# Definition of Done / Review checklist

## Reviewability
- [x] link to issue
- [ ] note if PR is on top of other PR
- [ ] note if related change in rems-deploy repo
- [ ] consider adding screenshots for ease of review

## API
- [x] API is documented and shows up in Swagger UI
- [x] API is backwards compatible or completely new
- [x] Events are backwards compatible

## Documentation
- [ ] update changelog if necessary
- [ ] add or update docstrings for namespaces and functions
- [ ] components are added to guide page
- [ ] documentation _at least_ for config options (i.e. docs folder)
- [ ] ADR for major architectural decisions or experiments

## Different installations
- [ ] new configuration options added to rems-deploy repository
- [ ] instance specific translations (i.e. LBR kielivara)

## Testing
- [x] complex logic is unit tested
- [ ] valuable features are integration / browser / acceptance tested automatically

## Accessibility
- [ ] all icons have the aria-label attribute
- [ ] all fields have a label
- [ ] errors are linked to fields with aria-describedby
- [ ] contrast is checked
- [ ] conscious decision about where to move focus after an action

## Follow-up
- [ ] new tasks are created for pending or remaining tasks
- [ ] no critical TODOs left to implement



Patch:
diff --git a/resources/translations/en.edn b/resources/translations/en.edn
index 8f91efa3a..73e8b23f5 100644
--- a/resources/translations/en.edn
+++ b/resources/translations/en.edn
@@ -132,6 +132,7 @@
                           :remarked "Remarked"
                           :resources-changed "Resources changed"
                           :returned "Changes requested"
+                          :revoked "Revoked"
                           :submitted "Applied"
                           :unknown "Unknown"}
                  :id "Id"
@@ -146,6 +147,7 @@
                           :draft "Draft"
                           :rejected "Rejected"
                           :returned "Returned"
+                          :revoked "Revoked"
                           :submitted "Applied"
                           :unknown "Unknown"}
                  :submitted "Sent"
@@ -238,6 +240,10 @@
                                  :message-to-applicant "Dear %1,\n\nYour application %3 has been returned for your consideration. Please, amend according to requests and resubmit.\n\nYou can review the application at %6"
                                  :subject-to-handler "(%3) Application has been returned to applicant"
                                  :message-to-handler "Dear %1,\n\n%2 has returned the application %3 to the applicant %4 for modifications.\n\nYou can view the application at %6"}
+          :application-revoked {:subject-to-applicant "Your application %3 has been revoked"
+                                :message-to-applicant "Dear %1,\n\nYour application %3 has been revoked.\n\nYou can view the application at %6"
+                                :subject-to-handler "(%3) Application has been revoked"
+                                :message-to-handler "Dear %1,\n\n%2 has revoked the application %3 from %4.\n\nYou can view the application at %6"}
           :application-licenses-added {:subject "Your application's %3 terms of use have changed"
                                        :message "Dear %1,\n\n%2 has requested your approval for changed terms of use to application %3.\n\nYou can review the application and approve the changed the terms of use at %6"}
           :application-resubmitted {:subject "(%3) Application has been resubmitted"
diff --git a/resources/translations/fi.edn b/resources/translations/fi.edn
index e6b7fb5bf..ea6fb80cc 100644
--- a/resources/translations/fi.edn
+++ b/resources/translations/fi.edn
@@ -130,6 +130,7 @@
                           :remarked "Huomio kirjattu"
                           :resources-changed "Resursseja muutettu"
                           :returned "Palautettu muokattavaksi"
+                          :revoked "Peruttu"
                           :submitted "Haettu"
                           :unknown "Tuntematon"}
                  :id "Tunniste"
@@ -144,6 +145,7 @@
                           :draft "Luonnos"
                           :rejected "Hylätty"
                           :returned "Palautettu"
+                          :revoked "Peruttu"
                           :submitted "Haettu"
                           :unknown "Tuntematon"}
                  :submitted "Lähetetty"
@@ -236,6 +238,10 @@
                                  :message-to-applicant "Hyvä %1,\n\nHakemuksesi %3 on palautettu muokattavaksesi. Ole hyvä ja täydennä hakemusta kommenttien mukaan.\n\nVoit tarkastella hakemusta osoitteessa %6"
                                  :subject-to-handler "(%3) Hakemus on palautettu"
                                  :message-to-handler "Hyvä %1,\n\n%2 on palauttanut käyttäjän %4 hakemuksen %3.\n\nVoit tarkastella hakemusta osoitteessa %6"}
+          :application-revoked {:subject-to-applicant "Hakemuksesi %3 on peruttu"
+                                :message-to-applicant "Hyvä %1,\n\nHakemuksesi %3 on peruttu.\n\nVoit tarkastella hakemusta: %6"
+                                :subject-to-handler "(%3) Hakemus on peruttu"
+                                :message-to-handler "Hyvä %1,\n\n%2 on perunut käyttäjän %4 hakemuksen %3.\n\nVoit tarkastella hakemusta: %6"}
           :application-licenses-added {:subject "Hakemuksen %3 käyttöehdot ovat muuttuneet"
                                        :message "Hyvä %1,\n\n%2 pyytää hyväksyntääsi muuttuneille käyttöehdoille hakemukseen %3.\n\nVoit tarkastella hakemusta ja hyväksyä muuttuneet käyttöehdot osoitteessa %6"}
           :application-resubmitted {:subject "(%3) Hakemus lähetetty uudelleen"
diff --git a/src/clj/rems/api/applications.clj b/src/clj/rems/api/applications.clj
index 5d58f539a..59ba9c638 100644
--- a/src/clj/rems/api/applications.clj
+++ b/src/clj/rems/api/applications.clj
@@ -264,6 +264,7 @@
     (command-endpoint :application.command/request-decision commands/RequestDecisionCommand)
     (command-endpoint :application.command/remove-member commands/RemoveMemberCommand)
     (command-endpoint :application.command/return commands/ReturnCommand)
+    (command-endpoint :application.command/revoke commands/RevokeCommand)
     (command-endpoint :application.command/save-draft commands/SaveDraftCommand)
     (command-endpoint :application.command/submit commands/SubmitCommand)
     (command-endpoint :application.command/uninvite-member commands/UninviteMemberCommand)
diff --git a/src/clj/rems/application/commands.clj b/src/clj/rems/application/commands.clj
index 740b21fdb..eb28980f2 100644
--- a/src/clj/rems/application/commands.clj
+++ b/src/clj/rems/application/commands.clj
@@ -85,6 +85,9 @@
 (s/defschema ReturnCommand
   (assoc CommandBase
          :comment s/Str))
+(s/defschema RevokeCommand
+  (assoc CommandBase
+         :comment s/Str))
 (s/defschema SaveDraftCommand
   (assoc CommandBase
          ;; {s/Int s/Str} is what we want, but that isn't nicely representable as JSON
@@ -117,6 +120,7 @@
    :application.command/request-comment RequestCommentCommand
    :application.command/request-decision RequestDecisionCommand
    :application.command/return ReturnCommand
+   :application.command/revoke RevokeCommand
    :application.command/save-draft SaveDraftCommand
    :application.command/submit SubmitCommand
    :application.command/uninvite-member UninviteMemberCommand})
@@ -351,6 +355,11 @@
   (ok {:event/type :application.event/closed
        :application/comment (:comment cmd)}))
 
+(defmethod command-handler :application.command/revoke
+  [cmd _application _injections]
+  (ok {:event/type :application.event/revoked
+       :application/comment (:comment cmd)}))
+
 (defmethod command-handler :application.command/request-decision
   [cmd _application injections]
   (or (must-not-be-empty cmd :deciders)
diff --git a/src/clj/rems/application/events.clj b/src/clj/rems/application/events.clj
index 308e9829d..b4515ac15 100644
--- a/src/clj/rems/application/events.clj
+++ b/src/clj/rems/application/events.clj
@@ -128,6 +128,10 @@
   (assoc EventBase
          :event/type (s/enum :application.event/returned)
          :application/comment s/Str))
+(s/defschema RevokedEvent
+  (assoc EventBase
+         :event/type (s/enum :application.event/revoked)
+         :application/comment s/Str))
 (s/defschema SubmittedEvent
   (assoc EventBase
          :event/type (s/enum :application.event/submitted)))
@@ -154,6 +158,7 @@
    :application.event/remarked RemarkedEvent
    :application.event/resources-changed ResourcesChangedEvent
    :application.event/returned ReturnedEvent
+   :application.event/revoked RevokedEvent
    :application.event/submitted SubmittedEvent})
 
 (s/defschema Event
diff --git a/src/clj/rems/application/model.clj b/src/clj/rems/application/model.clj
index 603839066..3bfa02418 100644
--- a/src/clj/rems/application/model.clj
+++ b/src/clj/rems/application/model.clj
@@ -91,7 +91,8 @@
               :application.command/remove-member
               :application.command/invite-member
               :application.command/uninvite-member
-              :application.command/close}})
+              :application.command/close
+              :application.command/revoke}})
 
 (def ^:private closed-permissions
   {:applicant #{:application.command/copy-as-new}
@@ -178,6 +179,7 @@
     :application.state/draft
     :application.state/rejected
     :application.state/returned
+    :application.state/revoked
     :application.state/submitted})
 
 (defmulti ^:private event-type-specific-application-view
@@ -345,6 +347,12 @@
       (assoc :application/state :application.state/closed)
       (assoc :application/todo nil)))
 
+(defmethod event-type-specific-application-view :application.event/revoked
+  [application _event]
+  (-> application
+      (assoc :application/state :application.state/revoked)
+      (assoc :application/todo nil)))
+
 (defmethod event-type-specific-application-view :application.event/copied-from
   [application event]
   (-> application
diff --git a/src/clj/rems/db/entitlements.clj b/src/clj/rems/db/entitlements.clj
index 650e16977..098d4465d 100644
--- a/src/clj/rems/db/entitlements.clj
+++ b/src/clj/rems/db/entitlements.clj
@@ -94,41 +94,39 @@
   and call the entitlement REST callback (if defined). Likewise if a resource is removed, member left etc.
   then we end the entitlement and call the REST callback."
   [application]
-  (when (contains? #{:application.state/approved :application.state/closed}
-                   (:application/state application))
-    (let [application-id (:application/id application)
-          current-members (set (concat (map :userid (:application/members application))
-                                       [(:application/applicant application)]))
-          past-members (set (map :userid (:application/past-members application)))
-          application-state (:application/state application)
-          application-resources (->> application
-                                     :application/resources
-                                     (map :resource/id)
-                                     set)
-          application-entitlements (get-entitlements-by-user application-id)
-          is-entitled? (fn [userid resource-id]
-                         (and (= :application.state/approved application-state)
-                              (contains? current-members userid)
-                              (accepted-licenses? application userid)
-                              (contains? application-resources resource-id)))
-          entitlements-by-user (fn [userid] (or (application-entitlements userid) #{}))
-          entitlements-to-add (->> (for [userid (union current-members past-members)
-                                         :let [current-resource-ids (entitlements-by-user userid)]
-                                         resource-id application-resources
-                                         :when (is-entitled? userid resource-id)
-                                         :when (not (contains? current-resource-ids resource-id))]
-                                     {userid #{resource-id}})
-                                   (apply merge-with union))
-          entitlements-to-remove (->> (for [userid (union current-members past-members)
-                                            :let [resource-ids (entitlements-by-user userid)]
-                                            resource-id resource-ids
-                                            :when (not (is-entitled? userid resource-id))]
-                                        {userid #{resource-id}})
-                                      (apply merge-with union))
-          members-to-update (keys (merge entitlements-to-add entitlements-to-remove))]
-      (when (seq members-to-update)
-        (log/info "updating entitlements on application" application-id)
-        (doseq [[userid resource-ids] entitlements-to-add]
-          (grant-entitlements! application-id userid resource-ids))
-        (doseq [[userid resource-ids] entitlements-to-remove]
-          (revoke-entitlements! application-id userid resource-ids))))))
+  (let [application-id (:application/id application)
+        current-members (set (concat (map :userid (:application/members application))
+                                     [(:application/applicant application)]))
+        past-members (set (map :userid (:application/past-members application)))
+        application-state (:application/state application)
+        application-resources (->> application
+                                   :application/resources
+                                   (map :resource/id)
+                                   set)
+        application-entitlements (get-entitlements-by-user application-id)
+        is-entitled? (fn [userid resource-id]
+                       (and (= :application.state/approved application-state)
+                            (contains? current-members userid)
+                            (accepted-licenses? application userid)
+                            (contains? application-resources resource-id)))
+        entitlements-by-user (fn [userid] (or (application-entitlements userid) #{}))
+        entitlements-to-add (->> (for [userid (union current-members past-members)
+                                       :let [current-resource-ids (entitlements-by-user userid)]
+                                       resource-id application-resources
+                                       :when (is-entitled? userid resource-id)
+                                       :when (not (contains? current-resource-ids resource-id))]
+                                   {userid #{resource-id}})
+                                 (apply merge-with union))
+        entitlements-to-remove (->> (for [userid (union current-members past-members)
+                                          :let [resource-ids (entitlements-by-user userid)]
+                                          resource-id resource-ids
+                                          :when (not (is-entitled? userid resource-id))]
+                                      {userid #{resource-id}})
+                                    (apply merge-with union))
+        members-to-update (keys (merge entitlements-to-add entitlements-to-remove))]
+    (when (seq members-to-update)
+      (log/info "updating entitlements on application" application-id)
+      (doseq [[userid resource-ids] entitlements-to-add]
+        (grant-entitlements! application-id userid resource-ids))
+      (doseq [[userid resource-ids] entitlements-to-remove]
+        (revoke-entitlements! application-id userid resource-ids)))))
diff --git a/src/clj/rems/poller/email.clj b/src/clj/rems/poller/email.clj
index cd782e0c9..d85c8897e 100644
--- a/src/clj/rems/poller/email.clj
+++ b/src/clj/rems/poller/email.clj
@@ -112,6 +112,16 @@
                                 :t.email.application-rejected/subject-to-handler
                                 :t.email.application-rejected/message-to-handler)))
 
+(defmethod event-to-emails-impl :application.event/revoked [event application]
+  (concat (emails-to-recipients (applicant-and-members application)
+                                event application
+                                :t.email.application-revoked/subject-to-applicant
+                                :t.email.application-revoked/message-to-applicant)
+          (emails-to-recipients (other-handlers event application)
+                                event application
+                                :t.email.application-revoked/subject-to-handler
+                                :t.email.application-revoked/message-to-handler)))
+
 (defmethod event-to-emails-impl :application.event/closed [event application]
   (concat (emails-to-recipients (applicant-and-members application)
                                 event application
diff --git a/src/clj/rems/poller/entitlements.clj b/src/clj/rems/poller/entitlements.clj
index fea8cd558..7a65cd09a 100644
--- a/src/clj/rems/poller/entitlements.clj
+++ b/src/clj/rems/poller/entitlements.clj
@@ -10,13 +10,13 @@
   (:import [org.joda.time Duration]))
 
 (defn- entitlements-for-event [event]
-  ;; we filter by event here, and by state in update-entitlements-for.
-  ;; this is for performance reasons only
+  ;; performance improvement: filter events which may affect entitlements
   (when (contains? #{:application.event/approved
+                     :application.event/closed
                      :application.event/licenses-accepted
                      :application.event/member-removed
                      :application.event/resources-changed
-                     :application.event/closed}
+                     :application.event/revoked}
                    (:event/type event))
     (let [application (applications/get-unrestricted-application (:application/id event))]
       (entitlements/update-entitlements-for application))))
diff --git a/src/cljc/rems/text.cljc b/src/cljc/rems/text.cljc
index 2e14e6cf9..fa8edc37a 100644
--- a/src/cljc/rems/text.cljc
+++ b/src/cljc/rems/text.cljc
@@ -65,7 +65,8 @@
    :application.state/approved :t.applications.states/approved
    :application.state/rejected :t.applications.states/rejected
    :application.state/closed :t.applications.states/closed
-   :application.state/returned :t.applications.states/returned})
+   :application.state/returned :t.applications.states/returned
+   :application.state/revoked :t.applications.states/revoked})
 
 (defn localize-state [state]
   (text (get states state :t.applications.states/unknown)))
@@ -106,6 +107,7 @@
    :application.event/remarked :t.applications.events/remarked
    :application.event/resources-changed :t.applications.events/resources-changed
    :application.event/returned :t.applications.events/returned
+   :application.event/revoked :t.applications.events/revoked
    :application.event/submitted :t.applications.events/submitted})
 
 (defn localize-event [event-type]


Test patch:
diff --git a/test/clj/rems/application/test_commands.clj b/test/clj/rems/application/test_commands.clj
index 39c15637a..15e57bf22 100644
--- a/test/clj/rems/application/test_commands.clj
+++ b/test/clj/rems/application/test_commands.clj
@@ -621,6 +621,28 @@
                         :actor handler-user-id
                         :comment "outdated"})))))
 
+(deftest test-revoke
+  (let [application (apply-events nil
+                                  [dummy-created-event
+                                   {:event/type :application.event/submitted
+                                    :event/time test-time
+                                    :event/actor applicant-user-id
+                                    :application/id app-id}
+                                   {:event/type :application.event/approved
+                                    :event/time test-time
+                                    :event/actor handler-user-id
+                                    :application/id app-id
+                                    :application/comment ""}])]
+    (is (= {:event/type :application.event/revoked
+            :event/time test-time
+            :event/actor handler-user-id
+            :application/id app-id
+            :application/comment "license violated"}
+           (ok-command application
+                       {:type :application.command/revoke
+                        :actor handler-user-id
+                        :comment "license violated"})))))
+
 (deftest test-decision
   (let [application (apply-events nil
                                   [dummy-created-event
diff --git a/test/clj/rems/application/test_model.clj b/test/clj/rems/application/test_model.clj
index e1c5dd4ab..8f31fef94 100644
--- a/test/clj/rems/application/test_model.clj
+++ b/test/clj/rems/application/test_model.clj
@@ -695,6 +695,20 @@
                                                                      :application/events events
                                                                      :application/state :application.state/closed
                                                                      :application/todo nil})]
+                                    (is (= expected-application (apply-events events)))))
+
+                                (testing "> revoked"
+                                  (let [events (conj events
+                                                     {:event/type :application.event/revoked
+                                                      :event/time (DateTime. 5000)
+                                                      :event/actor "handler"
+                                                      :application/id 1
+                                                      :application/comment "license terms were violated"})
+                                        expected-application (merge expected-application
+                                                                    {:application/last-activity (DateTime. 5000)
+                                                                     :application/events events
+                                                                     :application/state :application.state/revoked
+                                                                     :application/todo nil})]
                                     (is (= expected-application (apply-events events)))))))))
 
                         (testing "> rejected"
diff --git a/test/clj/rems/db/test_entitlements.clj b/test/clj/rems/db/test_entitlements.clj
index 9e7bd0230..313d060ef 100644
--- a/test/clj/rems/db/test_entitlements.clj
+++ b/test/clj/rems/db/test_entitlements.clj
@@ -241,4 +241,35 @@
                   data (map #(assoc % :body (cheshire/parse-string (get-in % [:body "postData"]) keyword)) data)]
               (is (= [{:path "/remove" :body [{:resource "resource1" :application app-id :user "bob" :mail "b@o.b"}]}
                       {:path "/remove" :body [{:resource "resource3" :application app-id :user "bob" :mail "b@o.b"}]}]
+                     (map #(select-keys % [:path :body]) data))))))))
+
+    (let [app-id (test-data/create-application! {:actor applicant :catalogue-item-ids [item1]})]
+      (test-data/command! {:type :application.command/accept-licenses
+                           :application-id app-id
+                           :accepted-licenses [lic-id1 lic-id2]
+                           :actor applicant})
+      (test-data/command! {:type :application.command/submit
+                           :application-id app-id
+                           :actor applicant})
+      (test-data/command! {:type :application.command/approve
+                           :application-id app-id
+                           :actor admin
+                           :comment ""})
+      (entitlements-poller/run)
+
+      (testing "revoked application should end entitlements"
+        (with-stub-server server
+          (test-data/command! {:type :application.command/revoke
+                               :application-id app-id
+                               :actor admin
+                               :comment "Banned"})
+          (entitlements-poller/run)
+
+          (is (= 1 (count (stub/recorded-requests server))))
+          (testing "db"
+            (is (= [] (db/get-entitlements {:application app-id :is-active? true}))))
+          (testing "POST"
+            (let [data (stub/recorded-requests server)
+                  data (map #(assoc % :body (cheshire/parse-string (get-in % [:body "postData"]) keyword)) data)]
+              (is (= [{:path "/remove" :body [{:resource "resource1" :application app-id :user "bob" :mail "b@o.b"}]}]
                      (map #(select-keys % [:path :body]) data))))))))))
diff --git a/test/clj/rems/poller/test_email.clj b/test/clj/rems/poller/test_email.clj
index 536123007..71157043a 100644
--- a/test/clj/rems/poller/test_email.clj
+++ b/test/clj/rems/poller/test_email.clj
@@ -5,8 +5,7 @@
             [rems.config]
             [rems.db.user-settings :as user-settings]
             [rems.locales]
-            [rems.poller.email :refer :all]
-            [rems.text :as text]))
+            [rems.poller.email :refer :all]))
 
 (use-fixtures
   :once
@@ -276,6 +275,17 @@
                               :event/type :application.event/rejected
                               :event/actor "handler"}))))
 
+(deftest test-revoked
+  (is (= [{:to-user "applicant"
+           :subject "Your application 2001/3, \"Application title\" has been revoked",
+           :body "Dear Alice Applicant,\n\nYour application 2001/3, \"Application title\" has been revoked.\n\nYou can view the application at http://example.com/application/7\n\nPlease do not reply to this automatically generated message."}
+          {:to-user "assistant"
+           :subject "(2001/3, \"Application title\") Application has been revoked",
+           :body "Dear assistant,\n\nHannah Handler has revoked the application 2001/3, \"Application title\" from Alice Applicant.\n\nYou can view the application at http://example.com/application/7\n\nPlease do not reply to this automatically generated message."}]
+         (emails base-events {:application/id 7
+                              :event/type :application.event/revoked
+                              :event/actor "handler"}))))
+
 (deftest test-id-field
   (with-redefs [rems.config/env (assoc rems.config/env :application-id-column :id)]
     (is (= {:to-user "assistant"