feature: invalidate token

backend/src/swlkup/db/seed/example.edn

@@ -91,12 +91,20 @@
 
  {:xt/id :T0p53cret
   :xt/spec :swlkup.model.token/doc
-  :token "T0p53cret"
-  :ngo "seawatch"}
+  :ngo "seawatch"
+  :valid true
+  :token "T0p53cret"}
  {:xt/id :R4nd0m
   :xt/spec :swlkup.model.token/doc
-  :token "R4nd0m"
-  :ngo "lifeline"}
+  :ngo "lifeline"
+  :valid true
+  :token "R4nd0m"}
+ {:xt/id :InvalidateTest
+  :xt/spec :swlkup.model.token/doc
+  :ngo "example_ngo"
+  :valid true
+  :token "InvalidateTest"
+  :purpose "It is used in a testcase"}
 
  {:xt/id "MaxMüller"
   :xt/spec :swlkup.model.supervisor/doc

backend/src/swlkup/db/state.clj

@@ -38,6 +38,11 @@
                                    (println "synced" (xtdb/sync node))
                                    (println "awaited" (xtdb/await-tx node transaction))
                                    (xtdb/tx-committed? node transaction))
+                :tx-fn-put (fn [fn-name quoted-fn]
+                               ;; In future we may want add transaction functions only once (at startup)
+                               (xtdb/submit-tx node [[::xtdb/put {:xt/id fn-name :xt/fn quoted-fn}]]))
+                :tx-fn-call (fn [fn-name & args]
+                                (xtdb/submit-tx node [(concat [::xtdb/fn fn-name] args)]))
                 :sync (fn [] (xtdb/sync node))
                 :q (fn [& args]
                        (apply q node args))

backend/src/swlkup/model/token.clj

@@ -2,9 +2,10 @@
   (:require [clojure.spec.alpha :as s]
             [specialist-server.type :as t]))
 
+(s/def ::valid t/boolean)
 (s/def ::token (t/field t/string "The secret given to a group of users, allowing anonym access to the lookup"))
 (s/def ::purpose (s/nilable t/string))
 
-(s/def ::token_struct (s/keys :req-un [::token ::purpose]))
+(s/def ::token_struct (s/keys :req-un [::valid ::token ::purpose]))
 
 (s/def ::doc (s/keys :req-un [::token]))

backend/src/swlkup/resolver/core.clj

@@ -5,6 +5,7 @@
             [swlkup.resolver.root.ngo.registered-supervisor :refer [supervisors_registered]]
             [swlkup.resolver.root.ngo.create-token :refer [create_token]]
             [swlkup.resolver.root.ngo.created-tokens :refer [created_tokens]]
+            [swlkup.resolver.root.ngo.invalidate-token :refer [invalidate_token]]
             [swlkup.resolver.root.supervisor.get :refer [supervisor_get]]
             [swlkup.resolver.root.supervisor.update :refer [supervisor_update]]
             [swlkup.resolver.root.user.lookup :refer [lookup]]
@@ -25,7 +26,8 @@
                                  :created_tokens #'created_tokens}
                          :mutation {:supervisor_register #'supervisor_register
                                     :supervisor_update #'supervisor_update
-                                    :create_token #'create_token}}))
+                                    :create_token #'create_token
+                                    :invalidate_token #'invalidate_token}}))
 
 (defn ->graphql
   "Create a wrapped graphql-executor, that merges context into the request.

backend/src/swlkup/resolver/root/ngo/create_token.clj

@@ -20,6 +20,7 @@
          (let [token (generate-token)]
               (tx [[:xtdb.api/put {:xt/id (uuid)
                                   :xt/spec ::token/doc
+                                  :valid true
                                   :token token
                                   :ngo ngo:id
                                   :purpose (:purpose opt)}]])

backend/src/swlkup/resolver/root/ngo/created_tokens.clj

@@ -15,10 +15,11 @@
   (let [{:keys [q]} (:db_ctx ctx)
         [ngo:id] (auth+role->entity ctx (:auth opt) ::ngo/doc)]
        (when ngo:id
-         (let [tokens (q '{:find [?token ?purpose]
-                           :keys [token purpose]
+         (let [tokens (q '{:find [?valid ?token ?purpose]
+                           :keys [valid token purpose]
                            :where [[?t :xt/spec :swlkup.model.token/doc]
                                    [?t :ngo ->ngo:id]
+                                   [?t :valid ?valid]
                                    [?t :token ?token]
                                    [?t :purpose ?purpose]]
                            :in [->ngo:id]}

backend/src/swlkup/resolver/root/ngo/invalidate_token.clj

@@ -0,0 +1,35 @@
+(ns swlkup.resolver.root.ngo.invalidate-token
+  (:require [clojure.spec.alpha :as s]
+            [specialist-server.type :as t]
+            [swlkup.auth.core :refer [auth+role->entity]]
+            [swlkup.model.token :as token]
+            [swlkup.model.auth :as auth]
+            [swlkup.model.ngo :as ngo]
+            [xtdb.api :as xt]))
+
+(s/fdef invalidate_token
+        :args (s/tuple map? (s/keys :req-un [::auth/auth ::token/token]) map? map?)
+        :ret t/boolean)
+
+(defn invalidate_token
+  [_node opt ctx _info]
+  (let [{:keys [q_id_unary tx-fn-put tx-fn-call sync]} (:db_ctx ctx)
+        [ngo:id] (auth+role->entity ctx (:auth opt) ::ngo/doc)
+        token:id (q_id_unary '{:find [?id]
+                               :where [[?t :xt/spec :swlkup.model.token/doc]
+                                       [?t :ngo ->ngo:id]
+                                       [?t :token ->token]
+                                       [?t :xt/id ?id]]
+                               :in [[->ngo:id ->token]]}
+                             [ngo:id (:token opt)])  ;; Tuple binding
+        tx_result (when token:id
+                        (tx-fn-put :invalidate-token
+                                   '(fn [ctx eid]
+                                        (let [db (xtdb.api/db ctx)
+                                              entity (xtdb.api/entity db eid)]
+                                             [[::xt/put (assoc entity :valid false)]])))
+                        (tx-fn-call :invalidate-token token:id))]
+       (sync)
+       (boolean (:xtdb.api/tx-id tx_result))))
+
+(s/def ::invalidate_token (t/resolver #'invalidate_token))

backend/src/swlkup/resolver/root/user/lookup.clj

@@ -18,7 +18,9 @@
         token (:token opt)
         token-data (q_id_unary '{:find [(pull ?e [*])]
                                  :in [token]
-                                 :where [[?e :token token]]}
+                                 :where [[?e :xt/spec :swlkup.model.token/doc]
+                                         [?e :valid true]
+                                         [?e :token token]]}
                                token)]
        {:_ {::lookup token-data}
         :_cred {::token token-data}

backend/test/swlkup/resolver/token_invalidate_test.clj

@@ -0,0 +1,23 @@
+(ns swlkup.resolver.token-invalidate-test
+  (:require [clojure.test :refer [use-fixtures deftest is]]
+            [mount.core :as mount]
+            [swlkup.resolver.core :refer [graphql]]))
+
+(def mail "[email protected]")
+(def password "Vr(+cFtUG=rsj2:/]*uR")
+(def token "InvalidateTest")
+
+(use-fixtures :once (fn [testcases] (mount/stop) (mount/start) (testcases) (mount/stop)))
+
+(deftest invalidation
+
+  (is (= (graphql {:query (str "{lookup(token: \"" token "\") {ngo{name}}}")})
+         {:data {:lookup {:ngo {:name "Example NGO"}}}}))
+
+  (is (= (graphql {:query "mutation Invalidate($auth: Auth!, $token:String!) { invalidate_token(auth: $auth, token: $token) }"
+                   :variables {:auth {:mail mail :password password}
+                               :token token}})
+         {:data {:invalidate_token true}}))
+
+  (is (= (graphql {:query (str "{lookup(token: \"" token "\") {ngo{name}}}")})
+         {:data {:lookup {:ngo nil}}})))

frontend/codegen/generates.ts

@@ -56,6 +56,7 @@ export type LocationInput = {
 export type MutationType = {
   __typename?: 'MutationType';
   create_token: Scalars['String'];
+  invalidate_token: Scalars['Boolean'];
   /** Add a new supervisor account to the database and send a mail containing the password via mail */
   supervisor_register: Scalars['Boolean'];
   /** Update a supervisors data */
@@ -70,6 +71,13 @@ export type MutationTypeCreate_TokenArgs = {
 };
 
 
+/** If this server supports mutation, the type that mutation operations will be rooted at. */
+export type MutationTypeInvalidate_TokenArgs = {
+  auth: Auth;
+  token: Scalars['String'];
+};
+
+
 /** If this server supports mutation, the type that mutation operations will be rooted at. */
 export type MutationTypeSupervisor_RegisterArgs = {
   auth: Auth;
@@ -160,6 +168,8 @@ export type Created_Tokens = {
   purpose?: Maybe<Scalars['String']>;
   /** The secret given to a group of users, allowing anonym access to the lookup */
   token: Scalars['String'];
+  /** Self descriptive. */
+  valid: Scalars['Boolean'];
 };
 
 /** All languages */
@@ -295,7 +305,7 @@ export type NgoQueryVariables = Exact<{
 }>;
 
 
-export type NgoQuery = { __typename?: 'QueryType', created_tokens: Array<{ __typename?: 'created_tokens', token: string, purpose?: string | null | undefined }>, supervisors_registered: Array<{ __typename?: 'supervisors_registered', mail: string, name_full?: string | null | undefined }> };
+export type NgoQuery = { __typename?: 'QueryType', created_tokens: Array<{ __typename?: 'created_tokens', token: string, purpose?: string | null | undefined, valid: boolean }>, supervisors_registered: Array<{ __typename?: 'supervisors_registered', mail: string, name_full?: string | null | undefined }> };
 
 
 export const LoginDocument = `
@@ -439,6 +449,7 @@ export const NgoDocument = `
   created_tokens(auth: $auth) {
     token
     purpose
+    valid
   }
   supervisors_registered(auth: $auth) {
     mail

frontend/codegen/queries.ts

@@ -93,7 +93,6 @@ export const supervisor_get = gql`
 
 export const ngo = gql`
   query Ngo($auth: Auth!) {
-    created_tokens(auth: $auth) {token purpose}
+    created_tokens(auth: $auth) {token purpose valid}
     supervisors_registered(auth: $auth) {mail name_full}
-  }
-`
+  }`

frontend/components/CreateToken.tsx

@@ -6,14 +6,19 @@ import { useNgoQuery } from '../codegen/generates'
 import { useTranslation, Trans } from 'react-i18next';
 
 async function mutate(auth: AuthState, purpose: string) {
-  console.log(purpose)
   const result = await fetcher<any, any>(`mutation Create($auth: Auth!, $purpose: String) {
 					    create_token(auth: $auth, purpose: $purpose) }`,
                                          {auth, purpose})()
-  console.debug(result)
   return result.create_token
 }
 
+async function invalidate (auth: AuthState, token: string) {
+  const result = await fetcher<any, any>(`mutation InvalidateToken($auth: Auth!, $token:String!) {
+                                            invalidate_token(auth: $auth, token: $token) }`,
+					 {auth, token})()
+  return result.invalidate_token
+}
+
 export function CreateToken() {
   const {t} = useTranslation()
   useEffect( () => {fetch_config() }, [config])
@@ -48,8 +53,14 @@ export function CreateToken() {
 	<>
           <h4>{data?.created_tokens.length} { t('Created Tokens') }:</h4>
           <ul>
-          { data?.created_tokens.map(t =>
-              <li key={t.token}> <a href={config.base_url+"/token/"+t.token} style={{fontFamily: "monospace"}} className="token">{t.token}</a> {t.purpose && " - " + t.purpose}</li>
+          { data?.created_tokens.map(token =>
+              <li key={token.token} style={{textDecoration: token.valid ? "none" : "line-through"}}>
+                <a href={config.base_url+"/token/"+token.token} style={{fontFamily: "monospace"}} className="token">{token.token}</a>
+                {token.purpose && " - " + token.purpose}
+		&nbsp;
+		{/* TODO: ask for confirmation and show token_disable_recommendation */}
+		{token.valid && <input type="button" onClick={async () => await invalidate(auth, token.token) && refetch()} value={ t('Disable') as string } />}
+              </li>
             )
           }
           </ul>