diff --git a/code/src/sixsq/nuvla/server/resources/common/event_config.clj b/code/src/sixsq/nuvla/server/resources/common/event_config.clj index 8d75b6db1..e8fba5470 100644 --- a/code/src/sixsq/nuvla/server/resources/common/event_config.clj +++ b/code/src/sixsq/nuvla/server/resources/common/event_config.clj @@ -53,13 +53,16 @@ (defmethod event-description :default - [{:keys [success authn-info category content] event-name :name :as _event}] + [{:keys [success authn-info category content] event-name :name :as _event} + & [{:keys [resource] :as _context}]] (if success (let [user-name-or-id (or (some-> authn-info :user-id crud/retrieve-by-id-as-admin1 :name) (:user-id authn-info)) resource-id (-> content :resource :href) resource-type (u/id->resource-type resource-id) - resource-name (:name (crud/retrieve-by-id-as-admin1 resource-id)) + resource (or resource + (crud/retrieve-by-id-as-admin1 resource-id)) + resource-name (:name resource) resource-name-or-id (or resource-name resource-id)] (case category ("add" "edit" "delete" "action") @@ -77,4 +80,3 @@ event-name)) (str event-name " attempt failed."))) - diff --git a/code/src/sixsq/nuvla/server/resources/common/event_config.clj.orig b/code/src/sixsq/nuvla/server/resources/common/event_config.clj.orig deleted file mode 100644 index 84c6846de..000000000 --- a/code/src/sixsq/nuvla/server/resources/common/event_config.clj.orig +++ /dev/null @@ -1,89 +0,0 @@ -(ns sixsq.nuvla.server.resources.common.event-config - (:require [sixsq.nuvla.server.resources.common.crud :as crud] - [sixsq.nuvla.server.resources.common.utils :as u])) - -;; -;; Dispatch functions -;; - -(defn resource-type-dispatch [resource-type] - resource-type) - - -<<<<<<< HEAD -(defn event-name-dispatch [{event-name :name :as _event} _response] - event-name) -======= -(defn event-type-dispatch [{:keys [event-type] :as _event} & _rest] - event-type) ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - - -;; -;; Enabled/disabled events -;; - -(defmulti events-enabled? - "Returns true if events should be logged for the given resource-type, false otherwise." - resource-type-dispatch) - - -(defmethod events-enabled? :default - [_resource-type] - false) - - -;; -;; Whitelist and blacklist event types per resource type -;; - -(defmulti log-event? - "Returns true if the event should be logged, false otherwise." - event-name-dispatch) - - -(defmethod log-event? :default - [{event-name :name :as _event} {:keys [status] :as _response}] - (and (not= 405 status) -<<<<<<< HEAD - (some? event-name))) -======= - (some? event-type))) - - -;; -;; Event human readable description -;; - -(defmulti event-description - "Returns a human-readable description of the event" - event-type-dispatch) - - -(defmethod event-description :default - [{:keys [success event-type authn-info category content] :as _event}] - (if success - (let [user-name-or-id (or (some-> authn-info :user-id crud/retrieve-by-id-as-admin1 :name) - (:user-id authn-info)) - resource-id (-> content :resource :href) - resource-type (u/id->resource-type resource-id) - resource-name (:name (crud/retrieve-by-id-as-admin1 resource-id)) - resource-name-or-id (or resource-name resource-id)] - (case category - ("add" "edit" "delete" "action") - (str (or user-name-or-id "An anonymous user") - (case category - "add" (str " added " resource-type " " resource-name-or-id) - "edit" (str " edited " resource-type " " resource-name-or-id) - "delete" (str " deleted " resource-type " " resource-name-or-id) - "action" (let [action (some->> event-type (re-matches #".*\.(.*)") second)] - (str " executed action " action " on " resource-type " " resource-name-or-id)) - nil) - ".") - ("state" "alarm" "email" "user") - event-type ;; FIXME: improve description in this case - event-type)) - (str event-type " attempt failed."))) - - ->>>>>>> bc60a2ab (use description field to provide human readable label for events) diff --git a/code/src/sixsq/nuvla/server/resources/deployment.clj b/code/src/sixsq/nuvla/server/resources/deployment.clj index d6a5a3000..168b2f044 100644 --- a/code/src/sixsq/nuvla/server/resources/deployment.clj +++ b/code/src/sixsq/nuvla/server/resources/deployment.clj @@ -245,6 +245,7 @@ a container orchestration engine. (a/throw-cannot-delete request) (db/delete request))] (ectx/add-to-context :acl (:acl deployment)) + (ectx/add-to-context :resource deployment) (utils/delete-all-child-resources deployment-id) delete-response) (catch Exception e @@ -565,7 +566,7 @@ a container orchestration engine. (defmethod ec/event-description "deployment.start" - [{:keys [success] {:keys [user-id]} :authn-info :as _event}] + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] (if success (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] (str user-name " started deployment.")) @@ -573,7 +574,7 @@ a container orchestration engine. (defmethod ec/event-description "deployment.stop" - [{:keys [success] {:keys [user-id]} :authn-info :as _event}] + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] (if success (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] (str user-name " stopped deployment.")) @@ -581,7 +582,7 @@ a container orchestration engine. (defmethod ec/event-description "deployment.clone" - [{:keys [success] {:keys [user-id]} :authn-info :as _event}] + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] (if success (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] (str user-name " cloned deployment.")) diff --git a/code/src/sixsq/nuvla/server/resources/event/utils.clj b/code/src/sixsq/nuvla/server/resources/event/utils.clj index 9fc6b3893..24c19c975 100644 --- a/code/src/sixsq/nuvla/server/resources/event/utils.clj +++ b/code/src/sixsq/nuvla/server/resources/event/utils.clj @@ -121,8 +121,8 @@ (defn set-description - [event] - (let [event-description (ec/event-description event)] + [event context] + (let [event-description (ec/event-description event context)] (cond-> event event-description (assoc :description event-description)))) @@ -130,7 +130,7 @@ (defn build-event [context request response] (-> {:resource-type event/resource-type - :name (get-event-name context request) + :name (get-event-name context request) :success (get-success response) :category (get-category context) :timestamp (get-timestamp context) @@ -139,7 +139,7 @@ :severity (get-severity context) :content {:resource (get-resource context response) :linked-identifiers (get-linked-identifiers context)}} - (set-description))) + (set-description context))) (defn add-event diff --git a/code/src/sixsq/nuvla/server/resources/event/utils.clj.orig b/code/src/sixsq/nuvla/server/resources/event/utils.clj.orig deleted file mode 100644 index 65d4e725e..000000000 --- a/code/src/sixsq/nuvla/server/resources/event/utils.clj.orig +++ /dev/null @@ -1,226 +0,0 @@ -(ns sixsq.nuvla.server.resources.event.utils - (:require - [clojure.string :as str] - [sixsq.nuvla.auth.utils :as auth] - [sixsq.nuvla.db.filter.parser :as parser] - [sixsq.nuvla.server.resources.common.crud :as crud] - [sixsq.nuvla.server.resources.common.event-config :as ec] - [sixsq.nuvla.server.resources.common.utils :as u] - [sixsq.nuvla.server.resources.event :as event] - [sixsq.nuvla.server.util.time :as t] - [sixsq.nuvla.server.util.time :as time])) - - -(defn request-event-name - "Returns a string of the form ." - [{{:keys [resource-name uuid action]} :params :as _context} - {:keys [request-method] :as _request}] - (if uuid - (if action - (some->> action (str resource-name ".")) - (case request-method - :put (str resource-name ".edit") - :delete (str resource-name ".delete") - nil)) - (case request-method - :post (str resource-name ".add") - :delete (str resource-name ".bulk.delete") - :patch (some->> action (str resource-name ".bulk.")) - nil))) - - -(defn get-success - [{:keys [status] :as _response}] - (<= 200 status 399)) - - -(defn get-event-name - [{:keys [event-name] :as context} request] - (or event-name - (request-event-name context request))) - - -(defn get-category - [{:keys [category] :as _context}] - (or category "action")) - - -(defn get-timestamp - [{:keys [timestamp] :as _context}] - (or timestamp (t/now-str))) - - -(defn retrieve-by-id - [id] - (try - (:body (crud/retrieve {:params (u/id->request-params id) - :request-method :get - :nuvla/authn auth/internal-identity})) - (catch Exception _ex - nil))) - - -(defn get-resource-href - [{{:keys [resource-name uuid]} :params :as _context} response] - (or (some->> uuid (str resource-name "/")) - (-> response :body :resource-id))) - - -(defn transform-acl - [acl] - (when acl - {:owners (vec (concat (:edit-data acl) (:owners acl)))})) - -(defn derive-acl-from-resource - [context response] - (when-let [acl (some-> (get-resource-href context response) - retrieve-by-id - :acl)] - (transform-acl acl))) - - -(defn get-acl - [{:keys [visible-to acl] :as context} response] - (let [visible-to (remove nil? visible-to)] - (or (when (seq visible-to) - {:owners (-> visible-to (conj "group/nuvla-admin") distinct vec)}) - (transform-acl acl) - (derive-acl-from-resource context response) - {:owners ["group/nuvla-admin"]}))) - - -(defn get-severity - [{:keys [severity] :as _context}] - (or severity "medium")) - - -(defn get-resource - [context response] - {:href (get-resource-href context response)}) - - -(defn get-linked-identifiers - [{:keys [linked-identifiers] :or {linked-identifiers []} :as _context}] - linked-identifiers) - - -(defn get-linked-resource-ids - [{{:keys [linked-identifiers]} :content :as _event} resource-type] - (->> linked-identifiers - (filter (comp #(= resource-type %) u/id->resource-type)))) - - -(defn get-linked-resources - ([{{:keys [linked-identifiers]} :content :as _event}] - (->> linked-identifiers - (keep crud/retrieve-by-id-as-admin1))) - ([{{:keys [linked-identifiers]} :content :as _event} resource-type] - (->> linked-identifiers - (filter (comp #(= resource-type %) u/id->resource-type)) - (keep crud/retrieve-by-id-as-admin1)))) - - -(defn set-description - [event] - (let [event-description (ec/event-description event)] - (cond-> event - event-description (assoc :description event-description)))) - - -(defn build-event - [context request response] -<<<<<<< HEAD - {:resource-type event/resource-type - :name (get-event-name context request) - :success (get-success response) - :category (get-category context) - :timestamp (get-timestamp context) - :authn-info (auth/current-authentication request) - :acl (get-acl context response) - :severity (get-severity context) - :content {:resource (get-resource context response) - :linked-identifiers (get-linked-identifiers context)}}) -======= - (-> {:resource-type event/resource-type - :event-type (get-event-type context request) - :success (get-success response) - :category (get-category context) - :timestamp (get-timestamp context) - :authn-info (auth/current-authentication request) - :acl (get-acl context response) - :severity (get-severity context) - :content {:resource (get-resource context response) - :linked-identifiers (get-linked-identifiers context)}} - (set-description))) ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - - -(defn add-event - [event] - (let [create-request {:params {:resource-name event/resource-type} - :body event - :nuvla/authn auth/internal-identity}] - (crud/add create-request))) - - -(def topic event/resource-type) - - -;; FIXME: duplicated -(defn create-event - [resource-href state acl & {:keys [severity category timestamp] - :or {severity "medium" - category "action"}}] - (let [event-map {:name "legacy" - :success true - :resource-type event/resource-type - :content {:resource {:href resource-href} - :state state} - :severity severity - :category category - :timestamp (or timestamp (time/now-str)) - :acl acl - :authn-info {}} - create-request {:params {:resource-name event/resource-type} - :body event-map - :nuvla/authn auth/internal-identity}] - (crud/add create-request))) - - -(defn query-events - ([resource-href opts] - (query-events (assoc opts :resource-href resource-href))) - ([{:keys [resource-href linked-identifier category state start end orderby last] event-name :name :as opts}] - (some-> event/resource-type - (crud/query-as-admin - {:cimi-params - (cond-> - {:filter (parser/parse-cimi-filter - (str/join " and " - (cond-> [] - resource-href (conj (str "content/resource/href='" resource-href "'")) - (and (contains? opts :resource-href) (nil? resource-href)) (conj (str "content/resource/href=null")) - event-name (conj (str "name='" event-name "'")) - category (conj (str "category='" category "'")) - state (conj (str "content/state='" state "'")) - linked-identifier (conj (str "content/linked-identifiers='" linked-identifier "'")) - start (conj (str "timestamp>='" start "'")) - end (conj (str "timestamp<'" end "'")))))} - orderby (assoc :orderby orderby) - last (assoc :last last))}) - second))) - -;; FIXME: duplicated -(defn search-event - [resource-href {:keys [category state start end]}] - (some-> event/resource-type - (crud/query-as-admin - {:cimi-params - {:filter (parser/parse-cimi-filter - (str/join " and " - (cond-> [(str "content/resource/href='" resource-href "'")] - category (conj (str "category='" category "'")) - state (conj (str "content/state='" state "'")) - start (conj (str "timestamp>='" start "'")) - end (conj (str "timestamp<'" end "'")))))}}) - second)) diff --git a/code/src/sixsq/nuvla/server/resources/infrastructure_service.clj b/code/src/sixsq/nuvla/server/resources/infrastructure_service.clj index 8779eb0e9..6fd96ba91 100644 --- a/code/src/sixsq/nuvla/server/resources/infrastructure_service.clj +++ b/code/src/sixsq/nuvla/server/resources/infrastructure_service.clj @@ -15,9 +15,10 @@ existing `infrastructure-service-template` resource. [sixsq.nuvla.auth.utils :as auth] [sixsq.nuvla.db.impl :as db] [sixsq.nuvla.server.resources.common.crud :as crud] + [sixsq.nuvla.server.resources.common.event-config :as ec] + [sixsq.nuvla.server.resources.common.event-context :as ectx] [sixsq.nuvla.server.resources.common.std-crud :as std-crud] [sixsq.nuvla.server.resources.common.utils :as u] - [sixsq.nuvla.server.resources.event.utils :as event-utils] [sixsq.nuvla.server.resources.resource-metadata :as md] [sixsq.nuvla.server.resources.spec.infrastructure-service :as infra-service] [sixsq.nuvla.server.resources.spec.infrastructure-service-template-generic :as infra-srvc-gen] @@ -36,6 +37,41 @@ existing `infrastructure-service-template` resource. (def collection-acl {:query ["group/nuvla-user"] :add ["group/nuvla-user"]}) + +;; +;; Events +;; + + +(defmethod ec/events-enabled? resource-type + [_resource-type] + true) + + +(defmethod ec/event-description "infrastructure-service.start" + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] + (if success + (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] + (str user-name " started infrastructure service.")) + "Infrastructure service start attempt failed.")) + + +(defmethod ec/event-description "infrastructure-service.stop" + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] + (if success + (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] + (str user-name " stopped infrastructure service.")) + "Infrastructure service stop attempt failed.")) + + +(defmethod ec/event-description "infrastructure-service.terminate" + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] + (if success + (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] + (str user-name " terminated infrastructure service.")) + "Infrastructure service terminate attempt failed.")) + + ;; ;; initialization ;; @@ -237,12 +273,13 @@ existing `infrastructure-service-template` resource. (defn event-state-change - [{current-state :state id :id} {{new-state :state} :body :as request}] - (when (and new-state (not (= current-state new-state))) - (event-utils/create-event id new-state - (a/default-acl (auth/current-authentication request)) - :severity "low" - :category "state"))) + [{_current-state :state _id :id} {{_new-state :state} :body :as _request}] + ;; legacy events + #_(when (and new-state (not (= current-state new-state))) + (event-utils/create-event id new-state + (a/default-acl (auth/current-authentication request)) + :severity "low" + :category "state"))) (def edit-impl (std-crud/edit-fn resource-type)) @@ -275,18 +312,21 @@ existing `infrastructure-service-template` resource. (defn post-delete-hooks - [{{uuid :uuid} :params :as request} delete-resp] - (let [id (str resource-type "/" uuid)] - (when (= 200 (:status delete-resp)) - (event-utils/create-event id "DELETED" - (a/default-acl (auth/current-authentication request)) - :severity "low" - :category "state")))) + [{{_uuid :uuid} :params :as _request} _delete-resp] + ;; legacy events + #_(let [id (str resource-type "/" uuid)] + (when (= 200 (:status delete-resp)) + (event-utils/create-event id "DELETED" + (a/default-acl (auth/current-authentication request)) + :severity "low" + :category "state")))) (defmethod crud/delete resource-type [{{uuid :uuid} :params :as request}] (let [resource (db/retrieve (str resource-type "/" uuid) request) delete-resp (delete resource request)] + (ectx/add-to-context :resource resource) + (ectx/add-to-context :acl (:acl resource)) (post-delete-hooks request delete-resp) delete-resp)) diff --git a/code/src/sixsq/nuvla/server/resources/infrastructure_service_coe.clj b/code/src/sixsq/nuvla/server/resources/infrastructure_service_coe.clj index f6fcb83ea..f63f95f4a 100644 --- a/code/src/sixsq/nuvla/server/resources/infrastructure_service_coe.clj +++ b/code/src/sixsq/nuvla/server/resources/infrastructure_service_coe.clj @@ -8,8 +8,8 @@ manage it. [sixsq.nuvla.auth.utils :as auth] [sixsq.nuvla.db.impl :as db] [sixsq.nuvla.server.resources.common.crud :as crud] + [sixsq.nuvla.server.resources.common.event-context :as ec] [sixsq.nuvla.server.resources.common.utils :as u] - [sixsq.nuvla.server.resources.event.utils :as event-utils] [sixsq.nuvla.server.resources.infrastructure-service :as infra-service] [sixsq.nuvla.server.resources.job :as job] [sixsq.nuvla.server.resources.spec.infrastructure-service-coe :as infra-service-coe] @@ -81,8 +81,10 @@ manage it. (if (= 201 status) (let [job-msg (format "created job %s with id %s" job-name job-id)] (edit-infra-service resource request #(assoc % :state new-state)) - (infra-service/event-state-change resource (assoc-in request [:body :state] new-state)) - (event-utils/create-event resource-id job-msg (a/default-acl (auth/current-authentication request))) + (ec/add-linked-identifier job-id) + ;; legacy events + #_(infra-service/event-state-change resource (assoc-in request [:body :state] new-state)) + #_(event-utils/create-event resource-id job-msg (a/default-acl (auth/current-authentication request))) (r/map-response job-msg 202 resource-id job-id)) (throw (r/ex-response (format "unable to create job %s" job-name) 500 resource-id)))) (catch Exception e @@ -180,9 +182,10 @@ manage it. (u/update-timestamps) (u/set-updated-by request) (db/edit request)) - (event-utils/create-event id "STARTING" (a/default-acl (auth/current-authentication request)) - :severity "low" - :category "state") + ;; Legacy events + #_(event-utils/create-event id "STARTING" (a/default-acl (auth/current-authentication request)) + :severity "low" + :category "state") (r/map-response job-msg 202 id job-id)) (catch Exception e (or (ex-data e) (throw e))))) diff --git a/code/src/sixsq/nuvla/server/resources/infrastructure_service_generic.clj b/code/src/sixsq/nuvla/server/resources/infrastructure_service_generic.clj index d22b2574b..929f9abc5 100644 --- a/code/src/sixsq/nuvla/server/resources/infrastructure_service_generic.clj +++ b/code/src/sixsq/nuvla/server/resources/infrastructure_service_generic.clj @@ -38,8 +38,9 @@ an endpoint. (defmethod infra-service/post-add-hook method - [service request] - (try + [_service _request] + ;; legacy events + #_(try (let [id (:id service) category "state"] (event-utils/create-event id diff --git a/code/src/sixsq/nuvla/server/resources/session.clj b/code/src/sixsq/nuvla/server/resources/session.clj index 5b17e3173..f2c5c3cc4 100644 --- a/code/src/sixsq/nuvla/server/resources/session.clj +++ b/code/src/sixsq/nuvla/server/resources/session.clj @@ -537,7 +537,7 @@ status, a 'set-cookie' header, and a 'location' header with the created (defmethod ec/event-description "session.add" - [{:keys [success] :as event}] + [{:keys [success] :as event} & _] (if success (when-let [user-name-or-credential (or (some-> (eu/get-linked-resources event "user") first :name) (some-> (eu/get-linked-resource-ids event "user") first) @@ -548,7 +548,7 @@ status, a 'set-cookie' header, and a 'location' header with the created (defmethod ec/event-description "session.delete" - [{:keys [success] {:keys [user-id]} :authn-info :as _event}] + [{:keys [success] {:keys [user-id]} :authn-info :as _event} & _] (if success (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] (str user-name " logged out.")) @@ -556,7 +556,7 @@ status, a 'set-cookie' header, and a 'location' header with the created (defmethod ec/event-description "session.switch-group" - [{:keys [success] {:keys [user-id]} :authn-info {:keys [linked-identifiers]} :content :as event}] + [{:keys [success] {:keys [user-id]} :authn-info {:keys [linked-identifiers]} :content :as event} & _] (if success (when-let [user-name (or (some-> user-id crud/retrieve-by-id-as-admin1 :name) user-id)] (str user-name " switched to group " diff --git a/code/test/sixsq/nuvla/server/resources/common/event_config_test.clj.orig b/code/test/sixsq/nuvla/server/resources/common/event_config_test.clj.orig deleted file mode 100644 index 27dcdbf17..000000000 --- a/code/test/sixsq/nuvla/server/resources/common/event_config_test.clj.orig +++ /dev/null @@ -1,57 +0,0 @@ -(ns sixsq.nuvla.server.resources.common.event-config-test - (:require [clojure.test :refer [deftest is]] - [sixsq.nuvla.server.resources.common.crud :as crud] - [sixsq.nuvla.server.resources.common.event-config :as t])) - - -<<<<<<< HEAD -(def logged-event {:name "resource.add"}) -======= -(def logged-event {:event-type "resource.add" - :category "add" - :success true - :authn-info {:user-id "user/12345"} - :content {:resource {:href "resource/12345"}}}) ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - - -(def not-logged-event {}) - - -(def disabled-event {:name "resource.validate"}) - - -(def anon-event {:event-type "resource.add" - :category "add" - :success true - :authn-info {:claims ["group/nuvla-anon"]} - :content {:resource {:href "resource/12345"}}}) - - -(def failure-event {:event-type "resource.add" - :success false}) - - - -(defmethod t/log-event? - "resource.validate" - [_event _response] - false) - - -(deftest log-event - (is (true? (t/log-event? logged-event {}))) - (is (false? (t/log-event? not-logged-event {}))) - (is (false? (t/log-event? disabled-event {}))) - (is (false? (t/log-event? logged-event {:status 405})))) - - -(deftest event-description - (with-redefs [crud/retrieve-by-id-as-admin - #(case % - "user/12345" {:name "TestUser"} - "resource/12345" {:resource-type "resource" - :name "TestResource"})] - (is (= "TestUser added resource TestResource." (t/event-description logged-event))) - (is (= "An anonymous user added resource TestResource." (t/event-description anon-event))) - (is (= "resource.add attempt failed." (t/event-description failure-event))))) diff --git a/code/test/sixsq/nuvla/server/resources/event_utils_test.clj.orig b/code/test/sixsq/nuvla/server/resources/event_utils_test.clj.orig deleted file mode 100644 index 510562023..000000000 --- a/code/test/sixsq/nuvla/server/resources/event_utils_test.clj.orig +++ /dev/null @@ -1,98 +0,0 @@ -(ns sixsq.nuvla.server.resources.event-utils-test - (:require - [clojure.test :refer [deftest is testing use-fixtures]] - [sixsq.nuvla.server.resources.common.utils :as u] - [sixsq.nuvla.server.resources.event.utils :as t] - [sixsq.nuvla.server.resources.lifecycle-test-utils :as ltu] - [sixsq.nuvla.server.util.time :as time])) - - -(use-fixtures :each ltu/with-test-server-fixture) - - -(defn req - [{:keys [nuvla-authn-info method body]}] - {:request-method method - :params {:resource-name "resource" - :uuid "12345"} - :headers {"nuvla-authn-info" nuvla-authn-info} - :body body}) - - -;; TODO: test getters in sixsq.nuvla.server.resources.event.utils - - -(deftest build-event - (with-redefs [time/now-str (constantly "2023-08-17T07:25:57.259Z")] - (let [context {:category "add" - :params {:resource-name "resource"}} - request (req {:nuvla-authn-info "super super group/nuvla-admin" - :method :post - :body {:k "v"}})] - (testing "success" - (let [uuid (u/random-uuid) - id (str "resource/" uuid) - event (t/build-event context request {:status 201 :body {:resource-id id}})] -<<<<<<< HEAD - (is (= {:name "resource.add" - :category "action" -======= - (is (= {:event-type "resource.add" - :category "add" - :description (str "An anonymous user added resource " id ".") ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :content {:resource {:href id} - :linked-identifiers []} - :authn-info {} - :success true - :severity "medium" - :resource-type "event" - :acl {:owners ["group/nuvla-admin"]} - :timestamp "2023-08-17T07:25:57.259Z"} - event)))) - (testing "failure" - (let [event (t/build-event context request {:status 400})] -<<<<<<< HEAD - (is (= {:name "resource.add" - :category "action" -======= - (is (= {:event-type "resource.add" - :category "add" - :description "resource.add attempt failed." ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :content {:resource {:href nil} - :linked-identifiers []} - :authn-info {} - :success false - :severity "medium" - :resource-type "event" - :acl {:owners ["group/nuvla-admin"]} - :timestamp "2023-08-17T07:25:57.259Z"} - event))))))) - - -(deftest add-event - (let [context {:category "action" - :params {:resource-name "resource"}} - request (req {:nuvla-authn-info "super super group/nuvla-admin" - :method :post - :body {:k "v"}}) - event (t/build-event context request {:status 200})] - (let [{:keys [status]} (t/add-event event)] - (is (= 201 status))))) - - -(deftest search-event - (doseq [category ["action" "add"] - timestamp ["2015-01-16T08:05:00.000Z" "2015-01-17T08:05:00.000Z" (time/now-str)]] - (t/create-event "user/1" "hello" {:owners ["group/nuvla-admin"]} - :category category - :timestamp timestamp)) - (is (= 6 (count (t/search-event "user/1" {})))) - (is (= 0 (count (t/search-event "user/2" {})))) - (is (= 3 (count (t/search-event "user/1" {:category "action"})))) - (is (= 6 (count (t/search-event "user/1" {:start "2015-01-16T08:05:00.000Z"})))) - (is (= 2 (count (t/search-event "user/1" {:end "2015-01-16T08:06:00.000Z"})))) - (is (= 1 (count (t/search-event "user/1" {:category "action" - :start "now/d" :end "now+1d/d"}))))) - diff --git a/code/test/sixsq/nuvla/server/resources/infrastructure_service_coe_lifecycle_test.clj b/code/test/sixsq/nuvla/server/resources/infrastructure_service_coe_lifecycle_test.clj index 69ede182d..89e2b0c49 100644 --- a/code/test/sixsq/nuvla/server/resources/infrastructure_service_coe_lifecycle_test.clj +++ b/code/test/sixsq/nuvla/server/resources/infrastructure_service_coe_lifecycle_test.clj @@ -56,7 +56,7 @@ session (content-type "application/json")) session-admin (header session-anon authn-info-header - "group/nuvla-admin group/nuvla-user group/nuvla-anon") + "group/nuvla-admin group/nuvla-admin group/nuvla-user group/nuvla-anon") session-user (header session-anon authn-info-header "user/jane user/jane group/nuvla-user group/nuvla-anon") ;; setup a service-group to act as parent for service @@ -101,7 +101,14 @@ :method infra-service-tpl-coe/method :parent service-group-id :subtype subtype - :management-credential credential-id}}] + :management-credential credential-id}} + authn-info-admin {:user-id "group/nuvla-admin" + :active-claim "group/nuvla-admin" + :claims ["group/nuvla-admin" "group/nuvla-anon" "group/nuvla-user"]} + authn-info-jane {:user-id "user/jane" + :active-claim "user/jane" + :claims ["group/nuvla-anon" "user/jane" "group/nuvla-user"]} + admin-group-name "Nuvla Administrator Group"] ;; anon create must fail (-> session-anon @@ -112,7 +119,9 @@ (ltu/is-status 400)) ;; check creation - (doseq [session [session-admin session-user]] + (doseq [[session event-owners authn-info user-name-or-id] + [[session-admin ["group/nuvla-admin"] authn-info-admin admin-group-name] + [session-user ["group/nuvla-admin" "user/jane"] authn-info-jane "user/jane"]]] (let [uri (-> session (request base-uri :request-method :post @@ -141,12 +150,30 @@ (is (= "STARTING" (:state service))) (is (= credential-id (:management-credential service)))) + (ltu/is-last-event uri + {:name "infrastructure-service.add" + :description (str user-name-or-id " added infrastructure-service " service-name ".") + :category "add" + :success true + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}}) + ;; can NOT delete resource in STARTING state (-> session (request abs-uri :request-method :delete) (ltu/body->edn) (ltu/is-status 409)) + (ltu/is-last-event uri + {:name "infrastructure-service.delete" + :description "infrastructure-service.delete attempt failed." + :category "delete" + :success false + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}}) + ;; set TERMINATED state (set-state-on-is abs-uri session "TERMINATED") @@ -154,7 +181,16 @@ (-> session (request abs-uri :request-method :delete) (ltu/body->edn) - (ltu/is-status 200))))))) + (ltu/is-status 200)) + + (ltu/is-last-event uri + {:name "infrastructure-service.delete" + :description (str user-name-or-id " deleted infrastructure-service " service-name ".") + :category "delete" + :success true + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}})))))) ;; Validate right CRUD operations and actions are available on resource in @@ -218,22 +254,27 @@ (ltu/is-status 201) (ltu/location)) abs-uri (str p/service-context uri) + event-owners ["group/nuvla-admin" "user/jane"] + authn-info {:user-id "user/jane" + :active-claim "user/jane" + :claims ["group/nuvla-anon" "user/jane" "group/nuvla-user"]} check-event (fn [exp-state] - (let [filter (format "category='state' and content/resource/href='%s' and content/state='%s'" uri exp-state) - state (-> session-user - (content-type "application/x-www-form-urlencoded") - (request "/api/event" - :request-method :put - :body (rc/form-encode {:filter filter})) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 1) - (ltu/body) - :resources - first - :content - :state)] - (is (= state exp-state))))] + ;; legacy events + #_(let [filter (format "category='state' and content/resource/href='%s' and content/state='%s'" uri exp-state) + state (-> session-user + (content-type "application/x-www-form-urlencoded") + (request "/api/event" + :request-method :put + :body (rc/form-encode {:filter filter})) + (ltu/body->edn) + (ltu/is-status 200) + (ltu/is-count 1) + (ltu/body) + :resources + first + :content + :state)] + (is (= state exp-state))))] ;; STARTING: edit (let [response (-> session-user @@ -271,15 +312,25 @@ (request abs-uri) (ltu/body->edn) (ltu/is-status 200) - (ltu/get-op-url "stop"))] - (-> session-user - (request op-uri - :request-method :post) - (ltu/is-status 202) - (ltu/body->edn))) + (ltu/get-op-url "stop")) + job-id (-> session-user + (request op-uri + :request-method :post) + (ltu/is-status 202) + (ltu/body->edn) + (ltu/location))] + + ;; check event for STOPPING was created + (check-event "STOPPING") - ;; check event for STOPPING was created - (check-event "STOPPING") + (ltu/is-last-event uri + {:name "infrastructure-service.stop" + :description (str "user/jane stopped infrastructure service.") + :category "action" + :success true + :linked-identifiers [job-id] + :authn-info authn-info + :acl {:owners event-owners}})) ;; STOPPING: edit (let [response (-> session-user @@ -314,15 +365,25 @@ (request abs-uri) (ltu/body->edn) (ltu/is-status 200) - (ltu/get-op-url "terminate"))] - (-> session-user - (request op-uri - :request-method :post) - (ltu/is-status 202) - (ltu/body->edn))) - - ;; check event for TERMINATING was created - (check-event "TERMINATING") + (ltu/get-op-url "terminate")) + job-id (-> session-user + (request op-uri + :request-method :post) + (ltu/is-status 202) + (ltu/body->edn) + (ltu/location))] + + ;; check event for TERMINATING was created + (check-event "TERMINATING") + + (ltu/is-last-event uri + {:name "infrastructure-service.terminate" + :description (str "user/jane terminated infrastructure service.") + :category "action" + :success true + :linked-identifiers [job-id] + :authn-info authn-info + :acl {:owners event-owners}})) ;; TERMINATING: edit (let [response (-> session-user diff --git a/code/test/sixsq/nuvla/server/resources/infrastructure_service_generic_lifecycle_test.clj b/code/test/sixsq/nuvla/server/resources/infrastructure_service_generic_lifecycle_test.clj index d0f939ae3..a71f24039 100644 --- a/code/test/sixsq/nuvla/server/resources/infrastructure_service_generic_lifecycle_test.clj +++ b/code/test/sixsq/nuvla/server/resources/infrastructure_service_generic_lifecycle_test.clj @@ -70,7 +70,14 @@ :acl valid-acl :template (merge {:href (str infra-service-tpl/resource-type "/" infra-service-tpl-generic/method)} - valid-service)}] + valid-service)} + authn-info-admin {:user-id "group/nuvla-admin" + :active-claim "group/nuvla-admin" + :claims ["group/nuvla-admin" "group/nuvla-anon" "group/nuvla-user"]} + authn-info-jane {:user-id "user/jane" + :active-claim "user/jane" + :claims ["group/nuvla-anon" "user/jane" "group/nuvla-user"]} + admin-group-name "Nuvla Administrator Group"] ;; admin query succeeds but is empty (-> session-admin @@ -107,7 +114,9 @@ (ltu/is-status 400)) ;; check creation - (doseq [session [session-admin session-user]] + (doseq [[session event-owners authn-info user-name-or-id] + [[session-admin ["group/nuvla-admin" "user/jane"] authn-info-admin admin-group-name] + [session-user ["group/nuvla-admin" "user/jane"] authn-info-jane "user/jane"]]] (let [uri (-> session (request base-uri :request-method :post @@ -136,8 +145,26 @@ (is (:endpoint service)) (is (= "STARTED" (:state service)))) + (ltu/is-last-event uri + {:name "infrastructure-service.add" + :description (str user-name-or-id " added infrastructure-service " service-name ".") + :category "add" + :success true + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}}) + ;; can delete resource (-> session (request abs-uri :request-method :delete) (ltu/body->edn) - (ltu/is-status 200)))))) + (ltu/is-status 200)) + + (ltu/is-last-event uri + {:name "infrastructure-service.delete" + :description (str user-name-or-id " deleted infrastructure-service " service-name ".") + :category "delete" + :success true + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}}))))) diff --git a/code/test/sixsq/nuvla/server/resources/infrastructure_service_vpn_lifecycle_test.clj b/code/test/sixsq/nuvla/server/resources/infrastructure_service_vpn_lifecycle_test.clj index e5e074e9c..49e4a6df7 100644 --- a/code/test/sixsq/nuvla/server/resources/infrastructure_service_vpn_lifecycle_test.clj +++ b/code/test/sixsq/nuvla/server/resources/infrastructure_service_vpn_lifecycle_test.clj @@ -40,7 +40,7 @@ session (content-type "application/json")) session-admin (header session-anon authn-info-header - "group/nuvla-admin group/nuvla-user group/nuvla-anon") + "group/nuvla-admin group/nuvla-admin group/nuvla-user group/nuvla-anon") session-user (header session-anon authn-info-header "user/jane user/jane group/nuvla-user group/nuvla-anon") ;; setup a service-group to act as parent for service @@ -65,7 +65,14 @@ :tags service-tags :template {:href (str infra-service-tpl/resource-type "/" infra-service-tpl-vpn/method) - :parent service-group-id}}] + :parent service-group-id}} + authn-info-admin {:user-id "group/nuvla-admin" + :active-claim "group/nuvla-admin" + :claims ["group/nuvla-admin" "group/nuvla-anon" "group/nuvla-user"]} + authn-info-jane {:user-id "user/jane" + :active-claim "user/jane" + :claims ["group/nuvla-anon" "user/jane" "group/nuvla-user"]} + admin-group-name "Nuvla Administrator Group"] ;; anon create must fail (-> session-anon @@ -76,7 +83,9 @@ (ltu/is-status 400)) ;; check creation - (doseq [session [session-admin session-user]] + (doseq [[session event-owners authn-info user-name-or-id] + [[session-admin ["group/nuvla-admin"] authn-info-admin admin-group-name] + [session-user ["group/nuvla-admin" "user/jane"] authn-info-jane "user/jane"]]] (let [uri (-> session (request base-uri :request-method :post @@ -101,8 +110,27 @@ (is (:subtype service)) (is (nil? (:endpoint service)))) + (ltu/is-last-event uri + {:name "infrastructure-service.add" + :description (str user-name-or-id " added infrastructure-service " service-name ".") + :category "add" + :success true + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}}) + ;; can delete resource (-> session (request abs-uri :request-method :delete) (ltu/body->edn) - (ltu/is-status 200)))))) + (ltu/is-status 200)) + + (ltu/is-last-event uri + {:name "infrastructure-service.delete" + :description (str user-name-or-id " deleted infrastructure-service " service-name ".") + :category "delete" + :success true + :linked-identifiers [] + :authn-info authn-info + :acl {:owners event-owners}}))))) + diff --git a/code/test/sixsq/nuvla/server/resources/lifecycle_test_utils.clj.orig b/code/test/sixsq/nuvla/server/resources/lifecycle_test_utils.clj.orig deleted file mode 100644 index 13e0829b6..000000000 --- a/code/test/sixsq/nuvla/server/resources/lifecycle_test_utils.clj.orig +++ /dev/null @@ -1,694 +0,0 @@ -(ns sixsq.nuvla.server.resources.lifecycle-test-utils - (:require - [clojure.data.json :as json] - [clojure.java.io :as io] - [clojure.pprint :refer [pprint]] - [clojure.string :as str] - [clojure.test :refer [is join-fixtures]] - [clojure.tools.logging :as log] - [compojure.core :as cc] - [kinsky.embedded-kraft :as ke] - [me.raynes.fs :as fs] - [peridot.core :refer [request session]] - [qbits.spandex :as spandex] - [ring.middleware.json :refer [wrap-json-body wrap-json-response]] - [ring.middleware.keyword-params :refer [wrap-keyword-params]] - [ring.middleware.nested-params :refer [wrap-nested-params]] - [ring.middleware.params :refer [wrap-params]] - [ring.util.codec :as codec] - [sixsq.nuvla.db.es.binding :as esb] - [sixsq.nuvla.db.es.utils :as esu] - [sixsq.nuvla.db.impl :as db] - [sixsq.nuvla.server.app.params :as p] - [sixsq.nuvla.server.app.routes :as routes] - [sixsq.nuvla.server.middleware.authn-info :refer [wrap-authn-info]] - [sixsq.nuvla.server.middleware.base-uri :refer [wrap-base-uri]] - [sixsq.nuvla.server.middleware.cimi-params :refer [wrap-cimi-params]] - [sixsq.nuvla.server.middleware.exception-handler :refer [wrap-exceptions]] - [sixsq.nuvla.server.middleware.eventer :refer [wrap-eventer]] - [sixsq.nuvla.server.middleware.logger :refer [wrap-logger]] - [sixsq.nuvla.server.resources.common.dynamic-load :as dyn] - [sixsq.nuvla.server.resources.event.utils :as event-utils] - [sixsq.nuvla.server.util.kafka :as ka] - [sixsq.nuvla.server.util.zookeeper :as uzk] - [zookeeper :as zk]) - (:import - (java.util UUID) - (org.apache.curator.test TestingServer) - (org.elasticsearch.common.logging LogConfigurator) - (org.elasticsearch.common.settings Settings) - (org.elasticsearch.index.reindex ReindexPlugin) - (org.elasticsearch.node MockNode) - (org.elasticsearch.painless PainlessPlugin) - (org.elasticsearch.transport Netty4Plugin))) - - -(defn random-string - "provides a random string with optional prefix" - [& [prefix]] - (apply str prefix (repeatedly 15 #(rand-nth "abcdefghijklmnopqrstuvwxyz")))) - - -(defn serialize-cookie-value - "replaces the map cookie value with a serialized string" - [{:keys [value] :as cookie}] - (if value - (assoc cookie :value (codec/form-encode value)) - cookie)) - - -(defmacro message-matches - [m re] - `((fn [m# re#] - (let [message# (get-in m# [:response :body :message])] - (if (string? re#) - (do - (is (.startsWith (or message# "") re#) (str "Message does not start with string. " (or message# "nil") " " re#)) - m#) - (do - (is (re-matches re# message#) (str "Message does not match pattern. " " " re#)) - m#)))) ~m ~re)) - - -(defmacro is-status - [m status] - `((fn [m# status#] - (let [actual# (get-in m# [:response :status])] - (is (= status# actual#) (str "Expecting status " status# " got " (or actual# "nil") ". Message: " - (get-in m# [:response :body :message]))) - m#)) ~m ~status)) - - -(defmacro is-key-value - ([m f k v] - `((fn [m# f# k# v#] - (let [actual# (-> m# :response :body k# f#)] - (is (= v# actual#) (str "Expecting " v# " got " (or actual# "nil") " for " k#)) - m#)) ~m ~f ~k ~v)) - ([m k v] - `(is-key-value ~m identity ~k ~v))) - - -(defmacro has-key - [m k] - `((fn [m# k#] - (is (get-in m# [:response :body k#]) (str "Map did not contain key " k#)) m#) - ~m ~k)) - - -(defmacro is-resource-uri - [m type-uri] - `(is-key-value ~m :resource-type ~type-uri)) - - -(defn href->url - [href] - (when href - (str p/service-context href))) - - -(defn get-op - [m op] - (->> (get-in m [:response :body :operations]) - (map (juxt :rel :href)) - (filter (fn [[rel _]] (= rel (name op)))) - first - second)) - - -(defn get-op-url - [m op] - (href->url (get-op m op))) - - -(defn select-op - [m op] - (let [op-list (get-in m [:response :body :operations]) - defined-ops (map :rel op-list)] - [(some #(= % (name op)) defined-ops) defined-ops])) - - -(defmacro is-operation-present - [m expected-op] - `((fn [m# expected-op#] - (let [[op# defined-ops#] (select-op m# expected-op#)] - (is op# (str "Missing " (name expected-op#) " in " defined-ops#)) - m#)) - ~m ~expected-op)) - - -(defmacro is-operation-absent [m absent-op] - `((fn [m# absent-op#] - (let [[op# defined-ops#] (select-op m# absent-op#)] - (is (nil? op#) (str "Unexpected op " absent-op# " in " defined-ops#))) - m#) - ~m ~absent-op)) - - -(defmacro is-id - [m id] - `(is-key-value ~m :id ~id)) - - -(defmacro is-count - [m f] - `((fn [m# f#] - (let [count# (get-in m# [:response :body :count])] - (is (number? count#) (str "Count is not a number: " count#)) - (when (number? count#) - (if (fn? f#) - (is (f# count#) "Function of count did not return truthy value") - (is (= f# count#) (str "Count wrong, expecting " f# ", got " (or count# "nil"))))) - m#)) ~m ~f)) - - -(defn does-body-contain - [m v] - `((fn [m# v#] - (let [body# (get-in m# [:response :body])] - (is (= (merge body# v#) body#)))) - ~m ~v)) - - -(defmacro is-set-cookie - [m] - `((fn [m#] - (let [cookies# (get-in m# [:response :cookies]) - n# (count cookies#) - token# (-> (vals cookies#) - first - serialize-cookie-value - :value)] - (is (= 1 n#) "incorrect number of cookies") - (is (not= "INVALID" token#) "expecting valid token but got INVALID") - (is (not (str/blank? token#)) "got blank token") - m#)) ~m)) - - -(defmacro is-unset-cookie - [m] - `((fn [m#] - (let [cookies# (get-in m# [:response :cookies]) - n# (count cookies#) - token# (-> (vals cookies#) - first - serialize-cookie-value - :value)] - (is (= 1 n#) "incorrect number of cookies") - (is (= "INVALID" token#) "expecting INVALID but got different value") - (is (not (str/blank? token#)) "got blank token") - m#)) ~m)) - - -(defmacro is-location - [m] - `((fn [m#] - (let [uri-header# (get-in m# [:response :headers "Location"]) - uri-body# (get-in m# [:response :body :resource-id])] - (is uri-header# "Location header was not set") - (is uri-body# "Location (resource-id) in body was not set") - (is (= uri-header# uri-body#) (str "!!!! Mismatch in locations, header=" uri-header# ", body=" uri-body#)) - m#)) ~m)) - - -(defn location - [m] - (let [uri (get-in m [:response :headers "Location"])] - (is uri "Location header missing from response") - uri)) - - -(defn location-url - [m] - (href->url (location m))) - - -(defmacro is-location-value - [m v] - `((fn [m# v#] - (let [location# (location m#)] - (is (= location# v#)))) - ~m ~v)) - - -(defn operations->map - [m] - (into {} (map (juxt :rel :href) (:operations m)))) - - -(defn body - [m] - (get-in m [:response :body])) - - -(defn body-resource-id - [m] - (get-in m [:response :body :resource-id])) - - -(defn body->edn - [m] - (if-let [body-content (body m)] - (let [updated-body (if (string? body-content) - (json/read-str body-content :key-fn keyword :eof-error? false :eof-value {}) - (json/read (io/reader body-content) :key-fn keyword :eof-error? false :eof-value {}))] - (update-in m [:response :body] (constantly updated-body))) - m)) - - -(defn entries - [m] - (some-> m :response :body :resources)) - - -(defn concat-routes - [rs] - (apply cc/routes rs)) - - -(defn dump - [response] - (pprint response) - response) - - -(defn dump-m - [response message] - (println "-->>" message) - (pprint response) - (println message "<<--") - response) - - -(defn refresh-es-indices - [] - (let [client (spandex/client {:hosts ["localhost:9200"]})] - (spandex/request client {:url [:_refresh], :method :post}) - (spandex/close! client))) - - -(defn strip-unwanted-attrs - "Strips common attributes that are not interesting when comparing - versions of a resource." - [m] - (let [unwanted #{:id :resource-type :acl :operations - :created :updated :name :description :tags}] - (into {} (remove #(unwanted (first %)) m)))) - - -;; -;; Handling of Zookeeper server and client -;; - -(defn create-zk-client-server - [] - (let [port 21810] - (log/info "creating zookeeper server on port" port) - (let [server (TestingServer. port) - client (zk/connect (str "127.0.0.1:" port))] - (uzk/set-client! client) - [client server]))) - - -(defonce ^:private zk-client-server-cache (atom nil)) - - -(defn set-zk-client-server-cache - "Sets the value of the cached Elasticsearch node and client. If the current - value is nil, then a new node and a new client are created and cached. If - the value is not nil, then the cache is set to the same value. This returns - the tuple with the node and client, which should never be nil." - [] - ;; Implementation note: It is unfortunate that the atom will constantly be - ;; reset to the current value because swap! is used. Unfortunately, - ;; compare-and-set! can't be used because we want to avoid unnecessary - ;; creation of ring application instances. - (swap! zk-client-server-cache (fn [current] (or current (create-zk-client-server))))) - - -;(defn clear-zk-client-server-cache -; "Unconditionally clears the cached Elasticsearch node and client. Can be -; used to force the re-initialization of the node and client. If the current -; values are not nil, then the node and client will be closed, with errors -; silently ignored." -; [] -; (let [[[client server] _] (swap-vals! zk-client-server-cache (constantly nil))] -; (when client -; (try -; (.close client) -; (catch Exception _))) -; (when server -; (try -; (.close server) -; (catch Exception _))))) - - -;; -;; Handling of Elasticsearch node and client for tests -;; - - -(defn create-test-node - "Creates a local elasticsearch node that holds data that can be access - through the native or HTTP protocols." - ([] - (create-test-node (str (UUID/randomUUID)))) - ([^String cluster-name] - (let [tempDir (str (fs/temp-dir "es-data-")) - settings (.. (Settings/builder) - (put "cluster.name" cluster-name) - (put "action.auto_create_index" true) - (put "path.home" tempDir) - (put "transport.netty.worker_count" 3) - (put "node.data" true) - (put "logger.level" "ERROR") - (put "cluster.routing.allocation.disk.watermark.low" "1gb") - (put "cluster.routing.allocation.disk.watermark.high" "500mb") - (put "cluster.routing.allocation.disk.watermark.flood_stage" "100mb") - (put "http.type" "netty4") - (put "http.port" "9200") - (put "transport.type" "netty4") - (put "network.host" "127.0.0.1") - (build)) - plugins [Netty4Plugin - ReindexPlugin - PainlessPlugin]] - - (LogConfigurator/configureWithoutConfig settings) - (.. (MockNode. ^Settings settings plugins) - (start))))) - - -(defn create-es-node-client - [] - (log/info "creating elasticsearch node and client") - (let [node (create-test-node) - client (-> (esu/create-es-client) - esu/wait-for-cluster) - sniffer (esu/create-es-sniffer client)] - [node client sniffer])) - - -(defonce ^:private es-node-client-cache (atom nil)) - -(defn es-node - [] - (first @es-node-client-cache)) - -(defn es-client - [] - (second @es-node-client-cache)) - -(defn es-sniffer - [] - (nth @es-node-client-cache 2)) - - -(defn set-es-node-client-cache - "Sets the value of the cached Elasticsearch node and client. If the current - value is nil, then a new node and a new client are created and cached. If - the value is not nil, then the cache is set to the same value. This returns - the tuple with the node and client, which should never be nil." - [] - ;; Implementation note: It is unfortunate that the atom will constantly be - ;; reset to the current value because swap! is used. Unfortunately, - ;; compare-and-set! can't be used because we want to avoid unnecessary - ;; creation of ring application instances. - (swap! es-node-client-cache (fn [current] (or current (create-es-node-client))))) - - -(defn clear-es-node-client-cache - "Unconditionally clears the cached Elasticsearch node and client. Can be - used to force the re-initialization of the node and client. If the current - values are not nil, then the node and client will be closed, with errors - silently ignored." - [] - (let [[[node client sniffer] _] (swap-vals! es-node-client-cache (constantly nil))] - (when client - (try - (.close client) - (catch Exception _))) - (when sniffer - (try - (.close sniffer) - (catch Exception _))) - (when node - (try - (.close node) - (catch Exception _))))) - - -(defn profile - [msg f & rest] - (let [ts (System/currentTimeMillis)] - (log/debug (str "--->: " msg)) - (let [res (if rest - (apply f rest) - (f))] - (log/debug (str "--->: " msg " done in: " (- (System/currentTimeMillis) ts))) - res))) - - -(defmacro with-test-es-client - "Creates an Elasticsearch test client, executes the body with the created - client bound to the Elasticsearch client binding, and then clean up the - allocated resources by closing both the client and the node." - [& body] - `(let [[_# client# sniffer#] - (profile "setting es node client cache" set-es-node-client-cache)] - (db/set-impl! (esb/->ElasticsearchRestBinding client# sniffer#)) - ~@body)) - -;; -;; Ring Application Management -;; - -(defn make-ring-app [resource-routes] - (log/info "creating ring application") - (-> resource-routes - wrap-cimi-params - wrap-keyword-params - wrap-nested-params - wrap-params - wrap-base-uri - wrap-exceptions - (wrap-json-body {:keywords? true}) - wrap-eventer - wrap-authn-info - (wrap-json-response {:pretty true :escape-non-ascii true}) - wrap-logger)) - - -(defonce ^:private ring-app-cache (atom nil)) - -(defn set-ring-app-cache - "Sets the value of the cached ring application. If the current value is nil, - then a new ring application is created and cached. If the value is not nil, - then the cache is set to the same value. This returns the ring application - value, which should never be nil." - [] - ;; Implementation note: It is unfortunate that the atom will constantly be - ;; reset to the current value because swap! is used. Unfortunately, - ;; compare-and-set! can't be used because we want to avoid unnecessary - ;; creation of ring application instances. - (swap! ring-app-cache (fn [current] (or current - (make-ring-app (concat-routes [(routes/get-main-routes)])))))) - - -(defn clear-ring-app-cache - "Unconditionally clears the cached ring application instance. Can be used - to force the re-initialization of the ring application." - [] - (reset! ring-app-cache (constantly nil))) - - -(defn ring-app - "Returns a standard ring application with the CIMI server routes. By - default, only a single instance will be created and cached. The cache can be - cleared with the `clean-ring-app-cache` function." - [] - (set-ring-app-cache)) - - -(def kafka-host "127.0.0.1") -(def kafka-port 9093) - - -(defn with-test-kafka-fixture - [f] - (log/debug "executing with-test-kafka-fixture") - (let [log-dir (ke/create-tmp-dir "kraft-combined-logs")] - (let [kafka (profile "start kafka" - ke/start-embedded-kafka - {::ke/host kafka-host - ::ke/port kafka-port - ::ke/log-dirs (str log-dir) - ::ke/server-config {"auto.create.topics.enable" "true" - "transaction.timeout.ms" "5000"}})] - (try - (when (= 0 (count @ka/producers!)) - (profile "create kafka producers" - ka/create-producers! (format "%s:%s" kafka-host kafka-port))) - (profile "run supplied function" f) - (catch Throwable t - (throw t)) - (finally - (ka/close-producers!) - (log/debug "finalising with-test-kafka-fixture") - ;; FIXME: Closing Kafka server takes ~6 sec. Instead of closing Kafka - ;; server, delete all the topics. In case of the last test, the server - ;; will just go down with the JVM. - (let [ts (System/currentTimeMillis)] - (.close kafka) - (log/debug (str "--->: close kafka done in: " - (- (System/currentTimeMillis) ts)))) - (ke/delete-dir log-dir)))))) - - -(def ^:private resources-initialised (atom false)) - - -(defn initialize-indices - [] - (if @resources-initialised - (dyn/initialize-data) - (do - (dyn/initialize) - (reset! resources-initialised true)))) - - -;; -;; test fixture that starts the following parts of the test server: -;; elasticsearch, zookeeper, ring application -;; - -(defn with-test-server-fixture - "This fixture will ensure that Elasticsearch and zookeeper instances are - running. It will also create a ring application and initialize it. The - servers and application are cached to eliminate unnecessary instance - creation for the subsequent tests." - [f] - (log/debug "executing with-test-server-fixture") - (profile "start zookeeper" set-zk-client-server-cache) - (with-test-es-client - (profile "start ring app" ring-app) - (profile "cleanup indices" esu/cleanup-index (es-client) "nuvla-*") - (profile "initialize indices" initialize-indices) - (profile "run supplied function" f))) - - -;; -;; test fixture that starts all parts of the test server including kafka -;; - -(def with-test-server-kafka-fixture (join-fixtures [with-test-server-fixture - with-test-kafka-fixture])) - -;; -;; miscellaneous utilities -;; - -(defn verify-405-status - "The url-methods parameter must be a list of URL/method tuples. It is - expected that any request with the method to the URL will return a 405 - status." - [url-methods] - (doall - (for [[uri method] url-methods] - (-> (ring-app) - session - (request uri - :request-method method - :body (json/write-str {:dummy "value"})) - (is-status 405))))) - -;; -;; ACL -;; - -(defmacro is-acl - [expected-acl actual-acl] - `(do - (when (:owners ~expected-acl) - (is (= (set (:owners ~expected-acl)) (set (:owners ~actual-acl))))) - (when (:edit-acl ~expected-acl) - (is (= (set (:edit-acl ~expected-acl)) (set (:edit-acl ~actual-acl))))) - (when (:edit-data ~expected-acl) - (is (= (set (:edit-data ~expected-acl)) (set (:edit-data ~actual-acl))))) - (when (:edit-meta ~expected-acl) - (is (= (set (:edit-meta ~expected-acl)) (set (:edit-meta ~actual-acl))))) - (when (:view-acl ~expected-acl) - (is (= (set (:view-acl ~expected-acl)) (set (:view-acl ~actual-acl))))) - (when (:view-data ~expected-acl) - (is (= (set (:view-data ~expected-acl)) (set (:view-data ~actual-acl))))) - (when (:view-meta ~expected-acl) - (is (= (set (:view-meta ~expected-acl)) (set (:view-meta ~actual-acl))))) - (when (:manage ~expected-acl) - (is (= (set (:manage ~expected-acl)) (set (:manage ~actual-acl))))) - (when (:delete ~expected-acl) - (is (= (set (:delete ~expected-acl)) (set (:delete ~actual-acl))))))) - - -;; -;; events -;; - -<<<<<<< HEAD -(defmacro is-last-event - [resource-id {:keys [description category authn-info linked-identifiers success acl] event-name :name}] - `(let [event# (last (event-utils/query-events ~resource-id {:orderby [["timestamp" :desc]] :last 1})) - authn-info# (:authn-info event#)] - (is (some? event#)) - (when ~event-name - (is (= ~event-name (:name event#)))) - (when ~description - (is (= ~description (:description event#)))) - (when ~category - (is (= ~category (:category event#)))) - (when ~authn-info - (is (= (:user-id ~authn-info) (:user-id authn-info#))) - (is (= (:active-claim ~authn-info) (:active-claim authn-info#))) - (is (= (set (:claims ~authn-info)) (set (:claims authn-info#))))) - (when ~linked-identifiers - (is (= (set ~linked-identifiers) (set (get-in event# [:content :linked-identifiers]))))) - (when (some? ~success) - (is (= ~success (:success event#)))) - (when (some? ~acl) - (is (= ~acl (:acl event#)))))) -======= -(defmacro is-event - [expected-event actual-event] - `(let [expected-authn-info# (:authn-info ~expected-event) - authn-info# (:authn-info ~actual-event)] - (is (some? ~actual-event)) - (when (:event-type ~expected-event) - (is (= (:event-type ~expected-event) (:event-type ~actual-event)))) - (when (:category ~expected-event) - (is (= (:category ~expected-event) (:category ~actual-event)))) - (when expected-authn-info# - (is (= (:user-id expected-authn-info#) (:user-id authn-info#))) - (is (= (:active-claim expected-authn-info#) (:active-claim authn-info#))) - (is (= (set (:claims expected-authn-info#)) (set (:claims authn-info#))))) - (when (:linked-identifiers ~expected-event) - (is (= (set (:linked-identifiers ~expected-event)) - (set (get-in ~actual-event [:content :linked-identifiers]))))) - (when (some? (:success ~expected-event)) - (is (= (:success ~expected-event) (:success ~actual-event)))) - (when (some? (:acl ~expected-event)) - (is-acl (:acl ~expected-event) (:acl ~actual-event))))) ->>>>>>> 2ab3edc8 (support for deployment) - -(defmacro is-last-event - [resource-id expected-event] - `(let [event# (last (event-utils/query-events ~resource-id {:orderby [["timestamp" :desc]] :last 1}))] - (is-event ~expected-event event#))) - -(defmacro are-last-events - [resource-id expected-events] - `(let [events# (take (count ~expected-events) (event-utils/query-events ~resource-id {:orderby [["timestamp" :desc]] - :last (count ~expected-events)}))] - (is (= (count ~expected-events) (count events#))) - (doall (map (fn [expected-event# actual-event#] - (is-event expected-event# actual-event#)) - ~expected-events - events#)))) diff --git a/code/test/sixsq/nuvla/server/resources/module_lifecycle_test.clj.orig b/code/test/sixsq/nuvla/server/resources/module_lifecycle_test.clj.orig deleted file mode 100644 index aacfd3127..000000000 --- a/code/test/sixsq/nuvla/server/resources/module_lifecycle_test.clj.orig +++ /dev/null @@ -1,1054 +0,0 @@ -(ns sixsq.nuvla.server.resources.module-lifecycle-test - (:require - [clojure.data.json :as json] - [clojure.string :as str] - [clojure.test :refer [deftest is testing use-fixtures]] - [peridot.core :refer [content-type header request session]] - [sixsq.nuvla.server.app.params :as p] - [sixsq.nuvla.server.middleware.authn-info :refer [authn-info-header]] - [sixsq.nuvla.server.resources.common.utils :as u] - [sixsq.nuvla.server.resources.lifecycle-test-utils :as ltu] - [sixsq.nuvla.server.resources.module :as module] - [sixsq.nuvla.server.resources.module.utils :as utils])) - -(use-fixtures :each ltu/with-test-server-fixture) - -(def base-uri (str p/service-context module/resource-type)) - -(def timestamp "1964-08-25T10:00:00.00Z") - -(defn- get-path-segments - [path] - (reduce - (fn [acu cur] - (conj acu (if (seq acu) - (str (last acu) "/" cur) - cur))) - [] - (str/split path #"/"))) - -(defn create-parent-projects [path user] - (let [paths (get-path-segments (utils/get-parent-path path))] - (run! - (fn [path-segment] - (-> user - (request base-uri - :request-method :post - :body (json/write-str {:subtype utils/subtype-project - :path path-segment - :parent-path (utils/get-parent-path path-segment)})) - ltu/body->edn - (ltu/is-status 201))) - paths))) - -(def session-anon - (-> (session (ltu/ring-app)) - (content-type "application/json"))) -(def session-admin - (header session-anon authn-info-header - "group/nuvla-admin group/nuvla-admin group/nuvla-user group/nuvla-anon")) -(def session-user - (header session-anon authn-info-header - "user/jane user/jane group/nuvla-user group/nuvla-anon")) - -(def authn-info-admin {:user-id "group/nuvla-admin" - :active-claim "group/nuvla-admin" - :claims ["group/nuvla-admin" "group/nuvla-anon" "group/nuvla-user"]}) -(def authn-info-jane {:user-id "user/jane" - :active-claim "user/jane" - :claims ["group/nuvla-anon" "user/jane" "group/nuvla-user"]}) -(def authn-info-anon {:claims ["group/nuvla-anon"]}) - -(defn build-valid-entry - [subtype valid-content] - {:parent-path "a/b" - :path "a/b/c" - :subtype subtype - - :compatibility "docker-compose" - - :logo-url "https://example.org/logo" - - :data-accept-content-types ["application/json" "application/x-something"] - :data-access-protocols ["http+s3" "posix+nfs"] - - :content valid-content}) - -<<<<<<< HEAD - :content valid-content} - authn-info-admin {:user-id "group/nuvla-admin" - :active-claim "group/nuvla-admin" - :claims ["group/nuvla-admin" "group/nuvla-anon" "group/nuvla-user"]} - authn-info-jane {:user-id "user/jane" - :active-claim "user/jane" - :claims ["group/nuvla-anon" "user/jane" "group/nuvla-user"]} - authn-info-anon {:claims ["group/nuvla-anon"]} - admin-group-name "Nuvla Administrator Group"] -======= -(defn create-module-nok - [valid-entry] - (let [] ->>>>>>> b3844f4f (Fix tests) - - ;; create: NOK for anon - (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 403)) - - (ltu/is-last-event nil - {:name "module.add" - :description "module.add attempt failed." - :category "add" - :success false - :linked-identifiers [] - :authn-info authn-info-anon - :acl {:owners ["group/nuvla-admin"]}}) - - ;; queries: NOK for anon - (-> session-anon - (request base-uri) - (ltu/body->edn) - (ltu/is-status 403)) - - (doseq [session [session-admin session-user]] - (-> session - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?))) - - ;; Creating editable parent project - (create-parent-projects (:path valid-entry) session-user) - - ;; invalid module subtype - (-> session-admin - (request base-uri - :request-method :post - :body (json/write-str (assoc valid-entry :subtype "bad-module-subtype"))) - (ltu/body->edn) - (ltu/is-status 400)) - - (ltu/is-last-event nil - {:name "module.add" - :description "module.add attempt failed." - :category "add" - :success false - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners ["group/nuvla-admin"]}}) - - (when (utils/is-application? valid-entry) - (testing "application should have compatibility attribute set" - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (dissoc valid-entry :compatibility))) - (ltu/body->edn) - (ltu/is-status 400) - (ltu/message-matches "Application subtype should have compatibility attribute set!")))))) - - -(defn create-module - [session valid-entry event-owners authn-info] - (let [uri (-> session - (request base-uri - :request-method :post - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location)) - - abs-uri (str p/service-context uri)] - - (ltu/is-last-event uri - {:event-type "module.add" - :category "add" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - ;; retrieve: NOK for anon - (-> session-anon - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 403)) - - uri)) - -(defn retrieve-module - [uri valid-entry valid-content] - (let [abs-uri (str p/service-context uri) - {:keys [content] :as module} (-> session-admin - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-key-value :compatibility "docker-compose") - (as-> m (if (utils/is-application? valid-entry) - (ltu/is-operation-present m :validate-docker-compose) - (ltu/is-operation-absent m :validate-docker-compose))) - (ltu/body))] - (is (= valid-content (select-keys content (keys valid-content)))) - module)) - - -(defn edit-module - [uri valid-entry event-owners] - (let [abs-uri (str p/service-context uri)] - ;; edit: NOK for anon - (-> session-anon - (request abs-uri - :request-method :put - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 403)) - - (ltu/is-last-event uri - {:event-type "module.edit" - :category "edit" - :success false - :linked-identifiers [] - :authn-info authn-info-anon - :acl {:owners event-owners}}) - - ;; insert 5 more versions - (doseq [_ (range 5)] - (-> session-admin - (request abs-uri - :request-method :put - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 200)) - - (ltu/is-last-event uri - {:event-type "module.edit" - :category "edit" - :success true - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners event-owners}})) - - (let [versions (-> session-admin - (request abs-uri - :request-method :put - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :versions)] - (is (= 7 (count versions))) - - ;; extract by indexes or last - (doseq [[i n] [["_0" 0] ["_1" 1] ["" 6]]] - (let [content-id (-> session-admin - (request (str abs-uri i)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :content - :id)] - (is (= (-> versions (nth n) :href) content-id)) - (is (= (-> versions (nth n) :author) "someone")) - (is (= (-> versions (nth n) :commit) "wip"))))))) - - -(defn publish-unpublish - [session uri event-owners authn-info] - ;; publish - (let [abs-uri (str p/service-context uri) - publish-url (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/get-op-url :publish))] - - (testing "publish last version" - (-> session - (request publish-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "published successfully")) - - (ltu/is-last-event uri - {:event-type "module.publish" - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}})) - - (testing "operation urls of specific version" - (let [abs-uri-v2 (str abs-uri "_2") - resp (-> session - (request (str abs-uri "_2")) - (ltu/body->edn) - (ltu/is-status 200)) - publish-url (ltu/get-op-url resp :publish) - unpublish-url (ltu/get-op-url resp :unpublish) - edit-url (ltu/get-op-url resp :edit) - delete-url (ltu/get-op-url resp :delete) - delete-version-url (ltu/get-op-url resp :delete-version)] - (is (= publish-url (str abs-uri-v2 "/publish"))) - (is (= unpublish-url (str abs-uri-v2 "/unpublish"))) - (is (= delete-version-url (str abs-uri-v2 "/delete-version"))) - (is (= delete-url abs-uri)) - (is (= edit-url abs-uri)))) - - (testing "publish specific version" - (-> session - (request (str abs-uri "_2/publish")) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "published successfully")) - - (ltu/is-last-event (str uri "_2") - {:event-type "module.publish" - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}})) - - (let [unpublish-url (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/is-key-value #(-> % last :published) :versions true) - (ltu/is-key-value #(-> % (nth 2) :published) :versions true) - (ltu/is-key-value :published true) - (ltu/get-op-url :unpublish))] - - (-> session - (request unpublish-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "unpublished successfully"))) - - (ltu/is-last-event uri - {:event-type "module.unpublish" - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - ; publish is idempotent - (-> session - (request (str abs-uri "_2/publish")) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "published successfully")) - - (ltu/is-last-event (str uri "_2") - {:event-type "module.publish" - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/is-key-value #(-> % last :published) :versions false) - (ltu/is-key-value :published true) - (ltu/get-op-url :unpublish)) - - (-> session - (request (str abs-uri "_2/unpublish")) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "unpublished successfully")) - - (ltu/is-last-event (str uri "_2") - {:event-type "module.unpublish" - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/is-key-value #(-> % (nth 2) :published) :versions false) - (ltu/is-key-value :published false) - (ltu/get-op-url :unpublish)))) - - -(defn versions - [uri valid-entry event-owners] - (let [abs-uri (str p/service-context uri)] - (testing "edit module without putting the module-content should not create new version" - (is (= 7 (-> session-admin - (request abs-uri - :request-method :put - :body (json/write-str (dissoc valid-entry :content :path))) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :versions - count)))) - - (doseq [i ["_0/delete-version" "_1/delete-version"]] - (-> session-admin - (request (str abs-uri i)) - (ltu/body->edn) - (ltu/is-status 200)) - - - (-> session-admin - (request (str abs-uri i)) - (ltu/body->edn) - (ltu/is-status 404))) - - - (testing "delete latest version without specifying version" - (-> session-admin - (request (str abs-uri "/delete-version")) - (ltu/body->edn) - (ltu/is-status 200))) - - - (ltu/is-last-event uri - {:event-type "module.delete-version" - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners event-owners}}) - - - (testing "delete out of bound index should return 404" - (-> session-admin - (request (str abs-uri "_50/delete-version")) - (ltu/body->edn) - (ltu/is-status 404))) - - (-> session-admin - (request (str abs-uri "_50")) - (ltu/body->edn) - (ltu/is-status 404)))) - - -(defn delete-module - [uri event-owners] - (let [abs-uri (str p/service-context uri)] - ;; delete: NOK for anon - (-> session-anon - (request abs-uri - :request-method :delete) - (ltu/body->edn) - (ltu/is-status 403)) - - (-> session-admin - (request abs-uri - :request-method :delete) - (ltu/body->edn) - (ltu/is-status 200)) - - - (ltu/is-last-event uri - {:event-type "module.delete" - :category "delete" - :success true - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners event-owners}}) - - ;; verify that the resource was deleted. - (-> session-admin - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 404)))) - - -(defn lifecycle-test-module - [subtype valid-content] - (let [valid-entry (build-valid-entry subtype valid-content)] - (create-module-nok valid-entry) - ;; adding, retrieving and deleting entry as user should succeed -<<<<<<< HEAD - (doseq [[session event-owners authn-info user-name-or-id] - [[session-admin ["group/nuvla-admin"] authn-info-admin admin-group-name] - [session-user ["group/nuvla-admin" "user/jane"] authn-info-jane "user/jane"]]] - (let [uri (-> session - (request base-uri - :request-method :post - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location)) - - abs-uri (str p/service-context uri)] - - (ltu/is-last-event uri - {:name "module.add" - :description (str user-name-or-id " added module " uri ".") - :category "add" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - ;; retrieve: NOK for anon - (-> session-anon - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 403)) - - (let [{:keys [content acl]} (-> session-admin - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-key-value :compatibility "docker-compose") - (as-> m (if (utils/is-application? valid-entry) - (ltu/is-operation-present m :validate-docker-compose) - (ltu/is-operation-absent m :validate-docker-compose))) - (ltu/body))] - (is (= valid-content (select-keys content (keys valid-content))))) - - ;; edit: NOK for anon - (-> session-anon - (request abs-uri - :request-method :put - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 403)) - - (ltu/is-last-event uri - {:name "module.edit" - :description "module.edit attempt failed." - :category "edit" - :success false - :linked-identifiers [] - :authn-info authn-info-anon - :acl {:owners event-owners}}) - - ;; insert 5 more versions - (doseq [_ (range 5)] - (-> session-admin - (request abs-uri - :request-method :put - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 200)) - - (ltu/is-last-event uri - {:name "module.edit" - :description (str admin-group-name " edited module " uri ".") - :category "edit" - :success true - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners event-owners}})) - - (let [versions (-> session-admin - (request abs-uri - :request-method :put - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :versions)] - (is (= 7 (count versions))) - - ;; extract by indexes or last - (doseq [[i n] [["_0" 0] ["_1" 1] ["" 6]]] - (let [content-id (-> session-admin - (request (str abs-uri i)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :content - :id)] - (is (= (-> versions (nth n) :href) content-id)) - (is (= (-> versions (nth n) :author) "someone")) - (is (= (-> versions (nth n) :commit) "wip"))))) - - ;; publish - (let [publish-url (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/get-op-url :publish))] - - (testing "publish last version" - (-> session - (request publish-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "published successfully")) - - (ltu/is-last-event uri - {:name "module.publish" - :description (str user-name-or-id " executed action publish on module " uri ".") - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}})) - - (testing "operation urls of specific version" - (let [abs-uri-v2 (str abs-uri "_2") - resp (-> session - (request (str abs-uri "_2")) - (ltu/body->edn) - (ltu/is-status 200)) - publish-url (ltu/get-op-url resp :publish) - unpublish-url (ltu/get-op-url resp :unpublish) - edit-url (ltu/get-op-url resp :edit) - delete-url (ltu/get-op-url resp :delete) - delete-version-url (ltu/get-op-url resp :delete-version)] - (is (= publish-url (str abs-uri-v2 "/publish"))) - (is (= unpublish-url (str abs-uri-v2 "/unpublish"))) - (is (= delete-version-url (str abs-uri-v2 "/delete-version"))) - (is (= delete-url abs-uri)) - (is (= edit-url abs-uri)))) - - (testing "publish specific version" - (-> session - (request (str abs-uri "_2/publish")) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "published successfully")) - - (ltu/is-last-event (str uri "_2") - {:name "module.publish" - :description (str user-name-or-id " executed action publish on module " uri "_2.") - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}})) - - (let [unpublish-url (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/is-key-value #(-> % last :published) :versions true) - (ltu/is-key-value #(-> % (nth 2) :published) :versions true) - (ltu/is-key-value :published true) - (ltu/get-op-url :unpublish))] - - (-> session - (request unpublish-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "unpublished successfully"))) - - (ltu/is-last-event uri - {:name "module.unpublish" - :description (str user-name-or-id " executed action unpublish on module " uri ".") - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - ; publish is idempotent - (-> session - (request (str abs-uri "_2/publish")) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "published successfully")) - - (ltu/is-last-event (str uri "_2") - {:name "module.publish" - :description (str user-name-or-id " executed action publish on module " uri "_2.") - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/is-key-value #(-> % last :published) :versions false) - (ltu/is-key-value :published true) - (ltu/get-op-url :unpublish)) - - (-> session - (request (str abs-uri "_2/unpublish")) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/message-matches "unpublished successfully")) - - (ltu/is-last-event (str uri "_2") - {:name "module.unpublish" - :description (str user-name-or-id " executed action unpublish on module " uri "_2.") - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info - :acl {:owners event-owners}}) - - (-> session - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-operation-present :publish) - (ltu/is-operation-present :unpublish) - (ltu/is-key-value #(-> % (nth 2) :published) :versions false) - (ltu/is-key-value :published false) - (ltu/get-op-url :unpublish))) - - (testing "edit module without putting the module-content should not create new version" - (is (= 7 (-> session-admin - (request abs-uri - :request-method :put - :body (json/write-str (dissoc valid-entry :content :path))) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :versions - count)))) - - (doseq [i ["_0/delete-version" "_1/delete-version"]] - (-> session-admin - (request (str abs-uri i)) - (ltu/body->edn) - (ltu/is-status 200)) - - - (-> session-admin - (request (str abs-uri i)) - (ltu/body->edn) - (ltu/is-status 404))) - - - (testing "delete latest version without specifying version" - (-> session-admin - (request (str abs-uri "/delete-version")) - (ltu/body->edn) - (ltu/is-status 200))) - - - (ltu/is-last-event uri - {:name "module.delete-version" - :description (str admin-group-name " executed action delete-version on module " uri ".") - :category "action" - :success true - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners event-owners}}) - - - (testing "delete out of bound index should return 404" - (-> session-admin - (request (str abs-uri "_50/delete-version")) - (ltu/body->edn) - (ltu/is-status 404))) - - (-> session-admin - (request (str abs-uri "_50")) - (ltu/body->edn) - (ltu/is-status 404)) - - ;; delete: NOK for anon - (-> session-anon - (request abs-uri - :request-method :delete) - (ltu/body->edn) - (ltu/is-status 403)) - - (-> session-admin - (request abs-uri - :request-method :delete) - (ltu/body->edn) - (ltu/is-status 200)) - - - (ltu/is-last-event uri - {:name "module.delete" - :description (str admin-group-name " deleted module " uri ".") - :category "delete" - :success true - :linked-identifiers [] - :authn-info authn-info-admin - :acl {:owners event-owners}}) - - ;; verify that the resource was deleted. - (-> session-admin - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 404)))))) -======= - (doseq [[session event-owners authn-info] - [[session-admin ["group/nuvla-admin"] authn-info-admin] - [session-user ["group/nuvla-admin" "user/jane"] authn-info-jane]]] - (let [uri (create-module session valid-entry event-owners authn-info) - module (retrieve-module uri valid-entry valid-content)] - (edit-module uri valid-entry event-owners) - (publish-unpublish session uri event-owners authn-info) - (versions uri valid-entry event-owners) - (delete-module uri event-owners))))) - ->>>>>>> b3844f4f (Fix tests) - -(deftest lifecycle-component - (let [valid-component {:author "someone" - :commit "wip" - - :architectures ["amd64" "arm/v6"] - :image {:image-name "ubuntu" - :tag "16.04"} - :ports [{:protocol "tcp" - :target-port 22 - :published-port 8022}]}] - (lifecycle-test-module utils/subtype-comp valid-component))) - - -(deftest lifecycle-application - (let [valid-application {:author "someone" - :commit "wip" - :docker-compose "version: \"3.6\"\n\nx-common: &common\n stop_grace_period: 4s\n logging:\n options:\n max-size: \"250k\"\n max-file: \"10\"\n labels:\n - \"nuvlabox.component=True\"\n - \"nuvlabox.deployment=production\"\n\nvolumes:\n nuvlabox-db:\n driver: local\n\nnetworks:\n nuvlabox-shared-network:\n driver: overlay\n name: nuvlabox-shared-network\n attachable: true\n\nservices:\n data-gateway:\n <<: *common\n image: traefik:2.1.1\n container_name: datagateway\n restart: on-failure\n command:\n - --entrypoints.mqtt.address=:1883\n - --entrypoints.web.address=:80\n - --providers.docker=true\n - --providers.docker.exposedbydefault=false\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n networks:\n - default\n - nuvlabox-shared-network\n\n nb-mosquitto:\n <<: *common\n image: eclipse-mosquitto:1.6.8\n container_name: nbmosquitto\n restart: on-failure\n labels:\n - \"traefik.enable=true\"\n - \"traefik.tcp.routers.mytcprouter.rule=HostSNI(`*`)\"\n - \"traefik.tcp.routers.mytcprouter.entrypoints=mqtt\"\n - \"traefik.tcp.routers.mytcprouter.service=mosquitto\"\n - \"traefik.tcp.services.mosquitto.loadbalancer.server.port=1883\"\n - \"nuvlabox.component=True\"\n - \"nuvlabox.deployment=production\"\n healthcheck:\n test: [\"CMD-SHELL\", \"timeout -t 5 mosquitto_sub -t '$$SYS/#' -C 1 | grep -v Error || exit 1\"]\n interval: 10s\n timeout: 10s\n start_period: 10s\n\n system-manager:\n <<: *common\n image: nuvlabox/system-manager:1.0.1\n restart: always\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n - nuvlabox-db:/srv/nuvlabox/shared\n ports:\n - 127.0.0.1:3636:3636\n healthcheck:\n test: [\"CMD\", \"curl\", \"-f\", \"http://localhost:3636\"]\n interval: 30s\n timeout: 10s\n retries: 4\n start_period: 10s\n\n agent:\n <<: *common\n image: nuvlabox/agent:1.3.2\n restart: on-failure\n environment:\n - NUVLABOX_UUID=${NUVLABOX_UUID}\n - NUVLA_ENDPOINT=${NUVLA_ENDPOINT:-nuvla.io}\n - NUVLA_ENDPOINT_INSECURE=${NUVLA_ENDPOINT_INSECURE:-False}\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n - nuvlabox-db:/srv/nuvlabox/shared\n - /:/rootfs:ro\n expose:\n - 5000\n depends_on:\n - system-manager\n - compute-api\n\n management-api:\n <<: *common\n image: nuvlabox/management-api:0.1.0\n restart: on-failure\n environment:\n - NUVLA_ENDPOINT=${NUVLA_ENDPOINT:-nuvla.io}\n - NUVLA_ENDPOINT_INSECURE=${NUVLA_ENDPOINT_INSECURE:-False}\n volumes:\n - /proc/sysrq-trigger:/sysrq\n - ${HOME}/.ssh/authorized_keys:/rootfs/.ssh/authorized_keys\n - nuvlabox-db:/srv/nuvlabox/shared\n - /var/run/docker.sock:/var/run/docker.sock\n ports:\n - 5001:5001\n healthcheck:\n test: curl -k https://localhost:5001 2>&1 | grep SSL\n interval: 20s\n timeout: 10s\n start_period: 30s\n\n compute-api:\n <<: *common\n image: nuvlabox/compute-api:0.2.5\n restart: on-failure\n pid: \"host\"\n environment:\n - HOST=${HOSTNAME:-nuvlabox}\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n - nuvlabox-db:/srv/nuvlabox/shared\n ports:\n - 5000:5000\n depends_on:\n - system-manager\n\n network-manager:\n <<: *common\n image: nuvlabox/network-manager:0.0.4\n restart: on-failure\n environment:\n - NUVLABOX_UUID=${NUVLABOX_UUID}\n - VPN_INTERFACE_NAME=${NUVLABOX_VPN_IFACE:-vpn}\n volumes:\n - nuvlabox-db:/srv/nuvlabox/shared\n depends_on:\n - system-manager\n\n vpn-client:\n <<: *common\n image: nuvlabox/vpn-client:0.0.4\n container_name: vpn-client\n restart: always\n network_mode: host\n cap_add:\n - NET_ADMIN\n devices:\n - /dev/net/tun\n environment:\n - NUVLABOX_UUID=${NUVLABOX_UUID}\n volumes:\n - nuvlabox-db:/srv/nuvlabox/shared\n depends_on:\n - network-manager"}] - - (lifecycle-test-module utils/subtype-app valid-application))) - -(deftest lifecycle-creating-applications - (let [session-anon (-> (session (ltu/ring-app)) - (content-type "application/json")) - session-admin (header session-anon authn-info-header - "group/nuvla-admin group/nuvla-admin group/nuvla-user group/nuvla-anon") - session-user (header session-anon authn-info-header - "user/jane user/jane group/nuvla-user group/nuvla-anon") - - project {:resource-type module/resource-type - :created timestamp - :updated timestamp - :parent-path "" - :path "example" - :subtype utils/subtype-project} - - valid-app {:parent-path "example" - :path "example/app" - :subtype utils/subtype-app - :compatibility "docker-compose" - :logo-url "https://example.org/logo" - :data-accept-content-types ["application/json" "application/x-something"] - :data-access-protocols ["http+s3" "posix+nfs"] - :content {:author "someone" - :commit "wip" - :docker-compose "version: \"3.6\"\n\nx-common: &common\n stop_grace_period: 4s\n logging:\n options:\n max-size: \"250k\"\n max-file: \"10\"\n labels:\n - \"nuvlabox.component=True\"\n - \"nuvlabox.deployment=production\"\n\nvolumes:\n nuvlabox-db:\n driver: local\n\nnetworks:\n nuvlabox-shared-network:\n driver: overlay\n name: nuvlabox-shared-network\n attachable: true\n\nservices:\n data-gateway:\n <<: *common\n image: traefik:2.1.1\n container_name: datagateway\n restart: on-failure\n command:\n - --entrypoints.mqtt.address=:1883\n - --entrypoints.web.address=:80\n - --providers.docker=true\n - --providers.docker.exposedbydefault=false\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n networks:\n - default\n - nuvlabox-shared-network\n\n nb-mosquitto:\n <<: *common\n image: eclipse-mosquitto:1.6.8\n container_name: nbmosquitto\n restart: on-failure\n labels:\n - \"traefik.enable=true\"\n - \"traefik.tcp.routers.mytcprouter.rule=HostSNI(`*`)\"\n - \"traefik.tcp.routers.mytcprouter.entrypoints=mqtt\"\n - \"traefik.tcp.routers.mytcprouter.service=mosquitto\"\n - \"traefik.tcp.services.mosquitto.loadbalancer.server.port=1883\"\n - \"nuvlabox.component=True\"\n - \"nuvlabox.deployment=production\"\n healthcheck:\n test: [\"CMD-SHELL\", \"timeout -t 5 mosquitto_sub -t '$$SYS/#' -C 1 | grep -v Error || exit 1\"]\n interval: 10s\n timeout: 10s\n start_period: 10s\n\n system-manager:\n <<: *common\n image: nuvlabox/system-manager:1.0.1\n restart: always\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n - nuvlabox-db:/srv/nuvlabox/shared\n ports:\n - 127.0.0.1:3636:3636\n healthcheck:\n test: [\"CMD\", \"curl\", \"-f\", \"http://localhost:3636\"]\n interval: 30s\n timeout: 10s\n retries: 4\n start_period: 10s\n\n agent:\n <<: *common\n image: nuvlabox/agent:1.3.2\n restart: on-failure\n environment:\n - NUVLABOX_UUID=${NUVLABOX_UUID}\n - NUVLA_ENDPOINT=${NUVLA_ENDPOINT:-nuvla.io}\n - NUVLA_ENDPOINT_INSECURE=${NUVLA_ENDPOINT_INSECURE:-False}\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n - nuvlabox-db:/srv/nuvlabox/shared\n - /:/rootfs:ro\n expose:\n - 5000\n depends_on:\n - system-manager\n - compute-api\n\n management-api:\n <<: *common\n image: nuvlabox/management-api:0.1.0\n restart: on-failure\n environment:\n - NUVLA_ENDPOINT=${NUVLA_ENDPOINT:-nuvla.io}\n - NUVLA_ENDPOINT_INSECURE=${NUVLA_ENDPOINT_INSECURE:-False}\n volumes:\n - /proc/sysrq-trigger:/sysrq\n - ${HOME}/.ssh/authorized_keys:/rootfs/.ssh/authorized_keys\n - nuvlabox-db:/srv/nuvlabox/shared\n - /var/run/docker.sock:/var/run/docker.sock\n ports:\n - 5001:5001\n healthcheck:\n test: curl -k https://localhost:5001 2>&1 | grep SSL\n interval: 20s\n timeout: 10s\n start_period: 30s\n\n compute-api:\n <<: *common\n image: nuvlabox/compute-api:0.2.5\n restart: on-failure\n pid: \"host\"\n environment:\n - HOST=${HOSTNAME:-nuvlabox}\n volumes:\n - /var/run/docker.sock:/var/run/docker.sock\n - nuvlabox-db:/srv/nuvlabox/shared\n ports:\n - 5000:5000\n depends_on:\n - system-manager\n\n network-manager:\n <<: *common\n image: nuvlabox/network-manager:0.0.4\n restart: on-failure\n environment:\n - NUVLABOX_UUID=${NUVLABOX_UUID}\n - VPN_INTERFACE_NAME=${NUVLABOX_VPN_IFACE:-vpn}\n volumes:\n - nuvlabox-db:/srv/nuvlabox/shared\n depends_on:\n - system-manager\n\n vpn-client:\n <<: *common\n image: nuvlabox/vpn-client:0.0.4\n container_name: vpn-client\n restart: always\n network_mode: host\n cap_add:\n - NET_ADMIN\n devices:\n - /dev/net/tun\n environment:\n - NUVLABOX_UUID=${NUVLABOX_UUID}\n volumes:\n - nuvlabox-db:/srv/nuvlabox/shared\n depends_on:\n - network-manager"}}] - - (testing "Failure creating application 1: no parent project is specified" - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (-> valid-app - (assoc :parent-path "") - (assoc :path "app")))) - ltu/body->edn - (ltu/is-status 400) - (ltu/message-matches "Application subtype must have a parent project!"))) - - (testing "Failure creating application 2: specified parent project does not exist" - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc valid-app :path "non-existent-parent/path"))) - ltu/body->edn - (ltu/is-status 400) - (ltu/message-matches "No parent project found for path: non-existent-parent"))) - - (testing "Failure creating application 3: user does not have edit rights in parent project" - ;; Creating a parent project with nuvla-admin as owner - (let [uri (-> session-admin - (request base-uri - :request-method :post - :body (json/write-str project)) - ltu/body->edn - (ltu/is-status 201) - ltu/location-url)] - - ;; If user has no view rights, failure message says that parent project does not exist. - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str valid-app)) - ltu/body->edn - (ltu/is-status 400) - (ltu/message-matches "No parent project found for path: example")) - - ;; Adding view rights for user - (-> session-admin - (request uri - :request-method :put - :body (json/write-str - (assoc project - :acl {:owners ["group/nuvla-admin"] - :view-meta ["user/jane"] - :view-data ["user/jane"] - :view-acl ["user/jane"]}))) - ltu/body->edn - (ltu/is-status 200))) - - ;; If user has view rights, message says user lacks edit rights for parent project. - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str valid-app)) - ltu/body->edn - (ltu/is-status 403) - (ltu/message-matches "You do not have edit rights for:"))) - - ;; Trying to add app to parent app should fail - (testing "Failure creating application 4: Parent is not a project." - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc project :path "example2"))) - ltu/body->edn - (ltu/is-status 201)) - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc valid-app :path "example2/app"))) - ltu/body->edn - (ltu/is-status 201)) - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc valid-app :path "example2/app/not-allowed"))) - ltu/body->edn - (ltu/is-status 403) - (ltu/message-matches "Parent must be a project!"))) - - (testing "new application can be in a project nested inside another project" - ;; Creating a parent project with wrong edit rights - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc project :path "grandparent"))) - ltu/body->edn - (ltu/is-status 201)) - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc project :path "grandparent/parent"))) - ltu/body->edn - (ltu/is-status 201)) - (-> session-user - (request base-uri - :request-method :post - :body (json/write-str (assoc valid-app :path "grandparent/parent/app"))) - ltu/body->edn - (ltu/is-status 201))) - - (testing "new application can not be top-level is also applied to admin-users" - (-> session-admin - (request base-uri - :request-method :post - :body (json/write-str (assoc valid-app :path "fails"))) - ltu/body->edn - (ltu/is-status 400) - (ltu/message-matches "Application subtype must have a parent project!"))))) - -(def valid-applications-sets-content - {:author "someone" - :commit "wip" - :applications-sets [{:name "x" - :applications [{:id "module/x" - :version 0}]}]}) - -(deftest lifecycle-applications-sets - (lifecycle-test-module utils/subtype-apps-sets valid-applications-sets-content)) - - -(deftest lifecycle-applications-sets-extended - (let [session-anon (-> (session (ltu/ring-app)) - (content-type "application/json")) - session-user (header session-anon authn-info-header - "user/jane user/jane group/nuvla-user group/nuvla-anon") - - valid-app-1 {:parent-path "a/b" - :path "clara/app-1" - :subtype utils/subtype-app - :compatibility "docker-compose" - :content {:author "someone" - :commit "initial" - :docker-compose "some content"}} - _project (create-parent-projects (:path valid-app-1) session-user) - app-1-create-resp (-> session-user - (request base-uri - :request-method :post - :body (json/write-str valid-app-1)) - (ltu/body->edn) - (ltu/is-status 201)) - app-1-uri (ltu/location-url app-1-create-resp) - app-1-id (ltu/location app-1-create-resp)] - - (let [valid-entry {:parent-path "a/b" - :path "a/b/c" - :subtype utils/subtype-apps-sets - :content (assoc-in valid-applications-sets-content - [:applications-sets 0 - :applications 0 :id] app-1-id)}] - - (-> session-user - (request app-1-uri - :request-method :put - :body (json/write-str - (update valid-app-1 :content assoc - :docker-compose "content changed" - :commit "second commit"))) - (ltu/body->edn) - (ltu/is-status 200)) - - (create-parent-projects (:path valid-entry) session-user) - (let [response (-> session-user - (request base-uri - :request-method :post - :body (json/write-str valid-entry)) - (ltu/body->edn) - (ltu/is-status 201)) - uri (ltu/location response) - abs-uri (ltu/location-url response) - deploy-uri (-> session-user - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/get-op-url :deploy))] - (-> session-user - (request deploy-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-key-value :application uri) - (ltu/is-key-value :version 0) - (ltu/is-key-value #(-> % - first - :applications - first - :resolved - :content - :docker-compose) - :applications-sets - "some content")))))) - - -(deftest bad-methods - (let [resource-uri (str p/service-context (u/new-resource-id module/resource-type))] - (ltu/verify-405-status [[base-uri :delete] - [resource-uri :post]]))) diff --git a/code/test/sixsq/nuvla/server/resources/session_api_key_lifecycle_test.clj.orig b/code/test/sixsq/nuvla/server/resources/session_api_key_lifecycle_test.clj.orig deleted file mode 100644 index 269d1a0b1..000000000 --- a/code/test/sixsq/nuvla/server/resources/session_api_key_lifecycle_test.clj.orig +++ /dev/null @@ -1,263 +0,0 @@ -(ns sixsq.nuvla.server.resources.session-api-key-lifecycle-test - (:require - [clojure.data.json :as json] - [clojure.string :as str] - [clojure.test :refer [are deftest is use-fixtures]] - [peridot.core :refer [content-type header request session]] - [sixsq.nuvla.auth.cookies :as cookies] - [sixsq.nuvla.auth.utils.sign :as sign] - [sixsq.nuvla.server.app.params :as p] - [sixsq.nuvla.server.middleware.authn-info :refer [authn-cookie authn-info-header]] - [sixsq.nuvla.server.resources.common.utils :as u] - [sixsq.nuvla.server.resources.credential-template-api-key :as api-key-tpl] - [sixsq.nuvla.server.resources.credential.key-utils :as key-utils] - [sixsq.nuvla.server.resources.lifecycle-test-utils :as ltu] - [sixsq.nuvla.server.resources.session :as session] - [sixsq.nuvla.server.resources.session-api-key :as t] - [sixsq.nuvla.server.resources.session-template :as st] - [sixsq.nuvla.server.resources.session-template-api-key :as api-key] - [sixsq.nuvla.server.util.time :as time])) - -(use-fixtures :once ltu/with-test-server-fixture) - -(def base-uri (str p/service-context session/resource-type)) - -(def session-template-base-uri (str p/service-context st/resource-type)) - - -(def session-template-api-key {:method api-key/authn-method - :instance api-key/authn-method - :name "API Key" - :description "Authentication with API Key and Secret" - :key "key" - :secret "secret" - :acl st/resource-acl}) - -(deftest check-uuid->id - (let [uuid (u/random-uuid) - correct-id (str "credential/" uuid)] - (is (= correct-id (t/uuid->id uuid))) - (is (= correct-id (t/uuid->id correct-id))))) - -(deftest check-valid-api-key - (let [subtype api-key-tpl/credential-subtype - expired (time/to-str (time/ago 10 :seconds)) - current (time/to-str (time/from-now 1 :hours)) - [secret digest] (key-utils/generate) - [_ bad-digest] (key-utils/generate) - valid-api-key {:subtype subtype - :expiry current - :digest digest}] - (is (true? (t/valid-api-key? valid-api-key secret))) - (are [v] (true? (t/valid-api-key? v secret)) - valid-api-key - (dissoc valid-api-key :expiry)) - (are [v] (false? (t/valid-api-key? v secret)) - {} - (dissoc valid-api-key :subtype) - (assoc valid-api-key :subtype "incorrect-subtype") - (assoc valid-api-key :expiry expired) - (assoc valid-api-key :digest bad-digest)) - (is (false? (t/valid-api-key? valid-api-key "bad-secret"))))) - -(deftest check-create-claims - (let [user-id "user/root" - server "nuvla.io" - headers {:nuvla-ssl-server-name server} - claims #{"user/root" "group/nuvla-user" "group/nuvla-anon"} - session-id "session/72e9f3d8-805a-421b-b3df-86f1af294233" - client-ip "127.0.0.1"] - (is (= {:client-ip "127.0.0.1" - :claims (str "group/nuvla-anon group/nuvla-user user/root " session-id) - :user-id "user/root" - :server "nuvla.io" - :session "session/72e9f3d8-805a-421b-b3df-86f1af294233"} - (cookies/create-cookie-info user-id - :claims claims - :headers headers - :session-id session-id - :client-ip client-ip))))) - - -(deftest lifecycle - - (let [[secret digest] (key-utils/generate) - [_ bad-digest] (key-utils/generate) - uuid (u/random-uuid) - valid-api-key {:id (str "credential/" uuid) - :subtype api-key-tpl/credential-subtype - :method api-key-tpl/method - :expiry (time/to-str (time/from-now 1 :hours)) - :digest digest - :claims {:identity "user/abcdef01-abcd-abcd-abcd-abcdef012345" - :roles ["group/nuvla-user" "group/nuvla-anon"]}} - mock-retrieve-by-id {(:id valid-api-key) valid-api-key - uuid valid-api-key}] - - (with-redefs [t/retrieve-credential-by-id mock-retrieve-by-id] - - ;; check that the mocking is working correctly - (is (= valid-api-key (t/retrieve-credential-by-id (:id valid-api-key)))) - (is (= valid-api-key (t/retrieve-credential-by-id uuid))) - - (let [app (ltu/ring-app) - session-json (content-type (session app) "application/json") - session-anon (header session-json authn-info-header "user/unknown user/unknown group/nuvla-anon") - session-user (header session-json authn-info-header "user/user group/nuvla-user group/nuvla-anon") - session-admin (header session-json authn-info-header - "group/nuvla-admin group/nuvla-user group/nuvla-anon") - - ;; - ;; create the session template to use for these tests - ;; - href (str st/resource-type "/api-key") - - name-attr "name" - description-attr "description" - tags-attr ["one", "two"] - - valid-create {:name name-attr - :description description-attr - :tags tags-attr - :template {:href href - :key uuid - :secret secret}} - unauthorized-create (update-in valid-create [:template :secret] (constantly bad-digest)) - invalid-create (assoc-in valid-create [:template :invalid] "BAD") - event-authn-info {:user-id "user/unknown" - :active-claim "user/unknown" - :claims ["user/unknown" "group/nuvla-anon"]}] - - ;; anonymous query should succeed but have no entries - (-> session-anon - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?)) - - ;; unauthorized create must return a 403 response - (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str unauthorized-create)) - (ltu/body->edn) - (ltu/is-status 403)) - -<<<<<<< HEAD - (ltu/is-last-event uuid {:name "session.add" -======= - (ltu/is-last-event uuid {:event-type "session.add" - :description "Login attempt failed." ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :category "add" - :success false - :linked-identifiers [(str "credential/" uuid)] - :authn-info event-authn-info - :acl {:owners ["group/nuvla-admin"]}}) - - ;; anonymous create must succeed; also with redirect - (let [resp (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str valid-create)) - (ltu/body->edn) - (ltu/is-set-cookie) - (ltu/is-status 201)) - id (ltu/body-resource-id resp) -<<<<<<< HEAD - _ (ltu/is-last-event id {:name "session.add" -======= - _ (ltu/is-last-event id {:event-type "session.add" - :description (str (:id valid-api-key) " logged in.") ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :category "add" - :success true - :linked-identifiers [(str "credential/" uuid)] - :authn-info event-authn-info - :acl {:owners ["group/nuvla-admin" id]}}) - - token (get-in resp [:response :cookies authn-cookie :value]) - cookie-info (if token (sign/unsign-cookie-info token) {}) - - uri (-> resp - (ltu/location)) - abs-uri (str p/service-context uri)] - - ;; check cookie-info in cookie - (is (= "user/abcdef01-abcd-abcd-abcd-abcdef012345" (:user-id cookie-info))) - (is (= (str/join " " ["group/nuvla-anon" "group/nuvla-user" uri]) (:claims cookie-info))) ;; uri is also session id - (is (= uri (:session cookie-info))) ;; uri is also session id - (is (not (nil? (:exp cookie-info)))) - - ;; user should not be able to see session without session role - (-> session-user - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 403)) - - ;; anonymous query should succeed but still have no entries - (-> session-anon - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?)) - - ;; user query should succeed but have no entries because of missing session role - (-> session-user - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?)) - - ;; admin query should succeed, but see no sessions without the correct session role - (-> session-admin - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 0)) - - ;; user should be able to see session with session role - (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-id id) - (ltu/is-operation-present :delete) - (ltu/is-operation-absent :edit)) - - ;; user query with session role should succeed but and have one entry - (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 1)) - - ;; check contents of session resource - (let [{:keys [name description tags]} (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request abs-uri) - (ltu/body->edn) - :response - :body)] - (is (= name name-attr)) - (is (= description description-attr)) - (is (= tags tags-attr))) - - ;; user with session role can delete resource - (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request abs-uri - :request-method :delete) - (ltu/is-unset-cookie) - (ltu/body->edn) - (ltu/is-status 200)) - - ;; create with invalid template fails - (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str invalid-create)) - (ltu/body->edn) - (ltu/is-status 400))))))) diff --git a/code/test/sixsq/nuvla/server/resources/session_password_lifecycle_test.clj.orig b/code/test/sixsq/nuvla/server/resources/session_password_lifecycle_test.clj.orig deleted file mode 100644 index 3a9d87b3a..000000000 --- a/code/test/sixsq/nuvla/server/resources/session_password_lifecycle_test.clj.orig +++ /dev/null @@ -1,784 +0,0 @@ -(ns sixsq.nuvla.server.resources.session-password-lifecycle-test - (:require - [clojure.data.json :as json] - [clojure.string :as str] - [clojure.test :refer [deftest is testing use-fixtures]] - [peridot.core :refer [content-type header request session]] - [postal.core :as postal] - [sixsq.nuvla.auth.password :as auth-password] - [sixsq.nuvla.auth.utils :as auth] - [sixsq.nuvla.auth.utils.sign :as sign] - [sixsq.nuvla.server.app.params :as p] - [sixsq.nuvla.server.middleware.authn-info - :refer [authn-cookie authn-info-header wrap-authn-info]] - [sixsq.nuvla.server.resources.configuration-nuvla :as config-nuvla] - [sixsq.nuvla.server.resources.email.sending :as email-sending] - [sixsq.nuvla.server.resources.group :as group] - [sixsq.nuvla.server.resources.group-template :as group-tpl] - [sixsq.nuvla.server.resources.lifecycle-test-utils :as ltu] - [sixsq.nuvla.server.resources.nuvlabox :as nuvlabox] - [sixsq.nuvla.server.resources.session :as session] - [sixsq.nuvla.server.resources.session-template :as st] - [sixsq.nuvla.server.resources.user :as user] - [sixsq.nuvla.server.resources.user-template :as user-tpl] - [sixsq.nuvla.server.resources.user-template-email-password :as email-password])) - - -(use-fixtures :once ltu/with-test-server-fixture) - - -(def base-uri (str p/service-context session/resource-type)) -(def grp-base-uri (str p/service-context group/resource-type)) -(def nb-base-uri (str p/service-context nuvlabox/resource-type)) - -(defn create-user - [session-admin & {:keys [username password email activated?]}] - (let [validation-link (atom nil) - href (str user-tpl/resource-type "/" email-password/registration-method) - href-create {:template {:href href - :password password - :username username - :email email}}] - - (with-redefs [email-sending/extract-smtp-cfg - (fn [_] {:host "smtp@example.com" - :port 465 - :ssl true - :user "admin" - :pass "password"}) - - ;; WARNING: This is a fragile! Regex matching to recover callback URL. - postal/send-message (fn [_ {:keys [body]}] - (let [url (->> body second :content - (re-matches #"(?s).*visit:\n\n\s+(.*?)\n.*") - second)] - (reset! validation-link url)) - {:code 0, :error :SUCCESS, :message "OK"})] - - (let [user-id (-> session-admin - (request (str p/service-context user/resource-type) - :request-method :post - :body (json/write-str href-create)) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location))] - - (when activated? - (is (re-matches #"^email.*successfully validated$" - (-> session-admin - (request @validation-link) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - :message)))) - user-id)))) - -(defn valid-create-grp - [group-id] - {:template {:href "group-template/generic" - :group-identifier group-id - :name (str "Group " group-id) - :description (str "Group " group-id " description")}}) - -(deftest lifecycle - - (let [app (ltu/ring-app) - session-json (content-type (session app) "application/json") - session-anon (header session-json authn-info-header "user/unknown user/unknown group/nuvla-anon") - session-user (header session-json authn-info-header "user group/nuvla-user") - session-admin (header session-json authn-info-header "group/nuvla-admin group/nuvla-admin group/nuvla-user group/nuvla-anon") - - href (str st/resource-type "/password") - - template-url (str p/service-context href) - - name-attr "name" - description-attr "description" - tags-attr ["one", "two"]] - - ;; password session template should exist - (-> session-anon - (request template-url) - (ltu/body->edn) - (ltu/is-status 200)) - - - ;; anon without valid user can not create session - (let [username "anon" - plaintext-password "anon" - - valid-create {:name name-attr - :description description-attr - :tags tags-attr - :template {:href href - :username username - :password plaintext-password}} - unauthorized-create (update-in valid-create [:template :password] (constantly "BAD"))] - - ; anonymous query should succeed but have no entries - (-> session-anon - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?)) - - ; unauthorized create must return a 403 response - (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str unauthorized-create)) - (ltu/body->edn) - (ltu/is-status 403)) - ) - - - ;; anon with valid activated user can create session - (let [username "user/jane" - plaintext-password "JaneJane-0" - - valid-create {:name name-attr - :description description-attr - :tags tags-attr - :template {:href href - :username username - :password plaintext-password}} - - invalid-create (assoc-in valid-create [:template :invalid] "BAD") - jane-user-id (create-user session-admin - :username username - :password plaintext-password - :activated? true - :email "jane@example.org")] - - ; anonymous create must succeed - (let [resp (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str valid-create)) - (ltu/body->edn) - (ltu/is-set-cookie) - (ltu/is-status 201)) - id (ltu/body-resource-id resp) - - token (get-in resp [:response :cookies authn-cookie :value]) - authn-info (if token (sign/unsign-cookie-info token) {}) - event-authn-info {:user-id "user/user" - :active-claim "group/nuvla-user" - :claims ["group/nuvla-anon" id "user/user"]} - - uri (ltu/location resp) - abs-uri (str p/service-context uri)] - - ; check claims in cookie - (is (= jane-user-id (:user-id authn-info))) - (is (= #{"group/nuvla-user" - "group/nuvla-anon" - uri - jane-user-id} - (some-> authn-info - :claims - (str/split #"\s") - set))) - (is (= uri (:session authn-info))) - (is (not (nil? (:exp authn-info)))) - - ; user should not be able to see session without session role - (-> session-user - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 403)) - - ; anonymous query should succeed but still have no entries - (-> session-anon - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?)) - - ; user query should succeed but have no entries because of missing session role - (-> session-user - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count zero?)) - - ; admin query should succeed, but see no sessions without the correct session role - (-> session-admin - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 0)) - - ; user should be able to see session with session role - (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-id id) - (ltu/is-operation-present :delete) - (ltu/is-operation-absent :edit) - (ltu/is-operation-present :switch-group)) - - ; check contents of session - (let [{:keys [name description tags]} (-> session-user - (header authn-info-header (str "user/user group/nuvla-user group/nuvla-anon " id)) - (request abs-uri) - (ltu/body->edn) - :response - :body)] - (is (= name name-attr)) - (is (= description description-attr)) - (is (= tags tags-attr))) - - ; user query with session role should succeed but and have one entry - (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request base-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 1)) - - ; user with session role can delete resource - (-> (session app) - (header authn-info-header (str "user/user group/nuvla-user " id)) - (request abs-uri - :request-method :delete) - (ltu/is-unset-cookie) - (ltu/body->edn) - (ltu/is-status 200)) - - (ltu/is-last-event id -<<<<<<< HEAD - {:name "session.delete" -======= - {:event-type "session.delete" - :description (str "user/user logged out.") ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :category "delete" - :success true - :linked-identifiers [] - :authn-info event-authn-info - :acl {:owners ["group/nuvla-admin" - "user/user"]}}) - - - - ; create with invalid template fails - (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str invalid-create)) - (ltu/body->edn) - (ltu/is-status 400))) - - ;; admin create with invalid template fails - (-> session-admin - (request base-uri - :request-method :post - :body (json/write-str invalid-create)) - (ltu/body->edn) - (ltu/is-status 400))) - - ;; anon with valid non activated user cannot create session - (let [username "alex" - plaintext-password "AlexAlex-0" - - valid-create {:name name-attr - :description description-attr - :tags tags-attr - :template {:href href - :username username - :password plaintext-password}}] - - (create-user session-admin - :username username - :password plaintext-password - :activated? false - :email "alex@example.org") - - ; unauthorized create must return a 403 response - (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str valid-create)) - (ltu/body->edn) - (ltu/is-status 403))))) - - -(deftest switch-group-lifecycle-test - (let [app (ltu/ring-app) - session-json (content-type (session app) "application/json") - session-anon (header session-json authn-info-header "user/unknown user/unknown group/nuvla-anon") - session-admin (header session-json authn-info-header "user/super group/nuvla-admin group/nuvla-user group/nuvla-anon group/nuvla-admin") - - href (str st/resource-type "/password") - - username "user/bob" - plaintext-password "BobBob-0" - user-id (create-user session-admin - :username username - :password plaintext-password - :activated? true - :email "bob@example.org") - - valid-create {:template {:href href - :username username - :password plaintext-password}} - session-user (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str valid-create)) - (ltu/body->edn) - (ltu/is-set-cookie) - (ltu/is-status 201)) - session-user-id (ltu/body-resource-id session-user) - sesssion-user-url (ltu/location-url session-user) - credential-id (:credential-password (auth-password/user-id->user user-id)) - _ (ltu/is-last-event session-user-id -<<<<<<< HEAD - {:name "session.add" -======= - {:event-type "session.add" - :description (str username " logged in.") ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :category "add" - :success true - :linked-identifiers [user-id credential-id] - :authn-info {:user-id "user/unknown" - :active-claim "user/unknown" - :claims ["user/unknown" "group/nuvla-anon"]} - :acl {:owners ["group/nuvla-admin" user-id]}}) - handler (wrap-authn-info identity) - authn-session-user (-> session-user - :response - (select-keys [:cookies]) - handler - seq - flatten) - group-a-identifier "switch-test-a" - group-a (str group/resource-type "/" group-a-identifier) - group-b-identifier "switch-test-b" - group-b (str group/resource-type "/" group-b-identifier) - switch-op-url (-> (apply request session-json (concat [sesssion-user-url] authn-session-user)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/get-op-url :switch-group)) - event-authn-info {:user-id user-id - :active-claim user-id - :claims ["group/nuvla-anon" "group/nuvla-user" session-user-id user-id]}] - - (testing "User cannot switch to a group that he is not part of." - (-> (apply request session-json - (concat [switch-op-url :body (json/write-str {:claim group-b}) - :request-method :post] authn-session-user)) - (ltu/body->edn) - (ltu/is-status 403) - (ltu/message-matches #"Switch group cannot be done to requested group:.*")) - -<<<<<<< HEAD - (ltu/is-last-event session-user-id {:name "session.switch-group" -======= - (ltu/is-last-event session-user-id {:event-type "session.switch-group" - :description "Switch group attempt failed." ->>>>>>> bc60a2ab (use description field to provide human readable label for events) - :category "action" - :success false - :linked-identifiers [group-b] - :authn-info event-authn-info - :acl {:owners ["group/nuvla-admin" group-b]}})) - - (testing "User can switch to a group that he is part of." - (-> session-admin - (request (-> session-admin - (request (str p/service-context group/resource-type) - :request-method :post - :body (json/write-str - {:template - {:href (str group-tpl/resource-type "/generic") - :group-identifier group-a-identifier}})) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location-url)) - :request-method :put - :body (json/write-str {:users [user-id]})) - (ltu/body->edn) - (ltu/is-status 200)) - (let [response (-> (apply request session-json - (concat [switch-op-url :body (json/write-str {:claim group-a}) - :request-method :post] authn-session-user)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-set-cookie) - :response) - authn-session-group-a (-> response - (select-keys [:cookies]) - handler - seq - flatten)] - (testing "Cookie is set and claims correspond to group a" - (is (= {:active-claim group-a - :claims #{"group/nuvla-anon" - "group/nuvla-user" - session-user-id - group-a} - :user-id user-id} - (-> response - handler - auth/current-authentication)))) - - (testing "Nuvlabox owner is set correctly to the active-claim" - (binding [config-nuvla/*stripe-api-key* nil] - (let [nuvlabox-url (-> (apply request session-json - (concat [nb-base-uri - :body (json/write-str {}) - :request-method :post] authn-session-group-a)) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location-url))] - - (-> (apply request session-json (concat [nuvlabox-url] authn-session-group-a)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-key-value :owner group-a))))) - - (testing "switch back to user is possible" - (is (= user-id - (-> (apply request session-json - (concat [switch-op-url :body (json/write-str {:claim user-id}) - :request-method :post] authn-session-group-a)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-set-cookie) - :response - (select-keys [:cookies]) - handler - auth/current-authentication - :active-claim)))) - - (testing "switch to subgroup is possible" - (-> (header session-json authn-info-header (str "user/x " group-a " user/x group/nuvla-user group/nuvla-anon " group-a)) - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "switch-test-b"))) - (ltu/body->edn) - (ltu/is-status 201)) - - (let [response (-> (apply request session-json - (concat [switch-op-url :body (json/write-str {:claim "group/switch-test-b"}) - :request-method :post] authn-session-user)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-set-cookie) - :response) - authn-session-group-b (-> response - (select-keys [:cookies]) - handler - seq - flatten)] - (is (= "group/switch-test-b" - (-> response - (select-keys [:cookies]) - handler - auth/current-authentication - :active-claim))) - - (-> (apply request session-json (concat [(str p/service-context nuvlabox/resource-type)] authn-session-group-b)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 0)) - - (-> (apply request session-json - (concat [nb-base-uri - :body (json/write-str {}) - :request-method :post] authn-session-group-b)) - (ltu/body->edn) - (ltu/is-status 201))))) - (testing "switch to subgroup with extended claims" - (let [response (-> (apply request session-json - (concat [switch-op-url :body (json/write-str {:claim group-a :extended true}) - :request-method :post] authn-session-user)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-set-cookie) - :response) - authn-session-group-a-ext (-> response - (select-keys [:cookies]) - handler - seq - flatten)] - (testing "Cookie is set and claims correspond to group a but claims are extended" - (is (= {:active-claim group-a - :claims #{"group/nuvla-anon" - "group/nuvla-user" - session-user-id - group-a - group-b} - :user-id user-id} - (-> response - handler - auth/current-authentication)))) - - (testing "NuvlaEdge of group b are visible for group a" - (-> (apply request session-json - (concat [nb-base-uri] authn-session-group-a-ext)) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-count 2)))))))) - - -(deftest get-groups-lifecycle-test - (let [app (ltu/ring-app) - session-json (content-type (session app) "application/json") - session-anon (header session-json authn-info-header "user/unknown user/unknown group/nuvla-anon") - session-admin (header session-json authn-info-header "user/super group/nuvla-admin group/nuvla-user group/nuvla-anon group/nuvla-admin") - user-id (create-user session-admin - :username "tarzan" - :password "TarzanTarzan-0" - :activated? true - :email "tarzan@example.org") - session-user (header session-json authn-info-header (str user-id user-id " group/nuvla-user group/nuvla-anon")) - session-group-a (header session-json authn-info-header "user/x group/a user/x group/nuvla-user group/nuvla-anon group/a") - session-group-b (header session-json authn-info-header "user/x group/b user/x group/nuvla-user group/nuvla-anon group/b") - href (str st/resource-type "/password")] - - (-> session-admin - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "a"))) - (ltu/body->edn) - (ltu/is-status 201)) - (-> session-group-a - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "b"))) - (ltu/body->edn) - (ltu/is-status 201)) - (-> session-group-a - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "b1"))) - (ltu/body->edn) - (ltu/is-status 201)) - (-> session-group-b - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "c"))) - (ltu/body->edn) - (ltu/is-status 201)) - - (let [resp (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str {:template {:href href - :username "tarzan" - :password "TarzanTarzan-0"}})) - (ltu/body->edn) - (ltu/is-set-cookie) - (ltu/is-status 201)) - id (ltu/body-resource-id resp) - abs-uri (ltu/location-url resp) - session-with-id (header session-json authn-info-header (str user-id user-id " group/nuvla-user group/nuvla-anon " id))] - (testing "User should be able to see session with session role" - (-> session-with-id - (request abs-uri) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/is-id id) - (ltu/is-operation-present :delete) - (ltu/is-operation-absent :edit) - (ltu/is-operation-present :switch-group) - (ltu/is-operation-present :get-peers) - (ltu/is-operation-present :get-groups))) - - (let [get-groups-url (-> session-user - (header authn-info-header (str user-id " " user-id " group/nuvla-user group/nuvla-anon " id)) - (request abs-uri) - (ltu/body->edn) - (ltu/get-op-url :get-groups))] - - (testing "User who is not in any group should get empty list of groups" - (-> session-with-id - (request get-groups-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - (= []) - (is "Get groups body should have no childs"))) - - (testing "When user is part of a group, he should get subgroups" - (-> session-admin - (request (str p/service-context "group/b") - :request-method :put - :body (json/write-str {:users [user-id]})) - (ltu/body->edn) - (ltu/is-status 200)) - (-> session-with-id - (request get-groups-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - (= [{:children [{:description "Group c description" - :id "group/c" - :name "Group c"}] - :description "Group b description" - :id "group/b" - :name "Group b"}]) - (is "User get group/b and subgroup group/c"))) - - (testing "When user is part of a root group he should get - the full group hierarchy and group/b is not duplicated" - (-> session-admin - (request (str p/service-context "group/a") - :request-method :put - :body (json/write-str {:users [user-id]})) - (ltu/body->edn) - (ltu/is-status 200)) - (-> session-admin - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "z"))) - (ltu/body->edn) - (ltu/is-status 201)) - (-> session-admin - (request (str p/service-context "group/z") - :request-method :put - :body (json/write-str {:users [user-id]})) - (ltu/body->edn) - (ltu/is-status 200)) - (-> session-with-id - (request get-groups-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - (= [{:children [{:children [{:description "Group c description" - :id "group/c" - :name "Group c"}] - :description "Group b description" - :id "group/b" - :name "Group b"} - {:description "Group b1 description" - :id "group/b1" - :name "Group b1"}] - :description "Group a description" - :id "group/a" - :name "Group a"} - {:description "Group z description" - :id "group/z" - :name "Group z"}]) - (is "Get groups body should contain tree of groups"))))))) - - -(deftest get-peers-lifecycle-test - (let [app (ltu/ring-app) - session-json (content-type (session app) "application/json") - session-anon (header session-json authn-info-header "user/unknown user/unknown group/nuvla-anon") - session-admin (header session-json authn-info-header "user/super group/nuvla-admin group/nuvla-user group/nuvla-anon group/nuvla-admin") - user-id (create-user session-admin - :username "peer0" - :password "Peer0Peer-0" - :activated? true - :email "peer-0@example.org") - peer-1 (create-user session-admin - :username "peer1" - :password "Peer1Peer-1" - :activated? true - :email "peer-1@example.org") - peer-2 (create-user session-admin - :username "peer2" - :password "Peer2Peer-2" - :activated? false - :email "peer-2@example.org") - peer-3 (create-user session-admin - :username "peer3" - :password "Peer3Peer-3" - :activated? true - :email "peer-3@example.org") - session-user (header session-json authn-info-header (str user-id user-id " group/nuvla-user group/nuvla-anon")) - session-group-a (header session-json authn-info-header "user/x group/peers-test-a user/x group/nuvla-user group/nuvla-anon group/peers-test-a") - href (str st/resource-type "/password") - - resp (-> session-anon - (request base-uri - :request-method :post - :body (json/write-str {:template {:href href - :username "peer0" - :password "Peer0Peer-0"}})) - (ltu/body->edn) - (ltu/is-set-cookie) - (ltu/is-status 201)) - id (ltu/body-resource-id resp) - abs-uri (ltu/location-url resp) - session-with-id (header session-json authn-info-header (str user-id user-id " group/nuvla-user group/nuvla-anon " id)) - get-peers-url (-> session-user - (header authn-info-header (str user-id " " user-id " group/nuvla-user group/nuvla-anon " id)) - (request abs-uri) - (ltu/body->edn) - (ltu/get-op-url :get-peers))] - - (testing "admin should get all users with validated emails" - (-> session-admin - (request get-peers-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - vals - set - (= #{"peer-0@example.org" "peer-1@example.org" "peer-3@example.org"}) - (is "Get peers body should contain all users with validated emails"))) - - (testing "user who is not in any group should get empty map of peers" - (-> session-with-id - (request get-peers-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - (= {}) - (is "Get peers body should be empty"))) - - (-> session-admin - (request (-> session-admin - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "peers-test-a"))) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location-url)) - :request-method :put - :body (json/write-str {:users [peer-1 user-id peer-2]})) - (ltu/body->edn) - (ltu/is-status 200)) - - (testing "user should get peers of the group when email is validated only" - (-> session-with-id - (request get-peers-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - vals - set - (= #{"peer-0@example.org" "peer-1@example.org"}) - (is "Get peers body should be himself and peer-1"))) - - (testing "user should get peers of subgroup also" - (-> session-admin - (request (-> session-group-a - (request grp-base-uri - :request-method :post - :body (json/write-str (valid-create-grp "peers-test-b"))) - (ltu/body->edn) - (ltu/is-status 201) - (ltu/location-url)) - :request-method :put - :body (json/write-str {:users [peer-3 user-id peer-2]})) - (ltu/body->edn) - (ltu/is-status 200)) - (-> session-with-id - (request get-peers-url) - (ltu/body->edn) - (ltu/is-status 200) - (ltu/body) - vals - set - (= #{"peer-0@example.org" "peer-1@example.org" "peer-3@example.org"}) - (is "Get peers body should contain peer-3")))))