Require an authorization token to use the api

Untested

TODO

@@ -12,10 +12,6 @@ TODO: Make server stop jobs that have been running too long
 
 TODO: Have worker upload bootstrapped compiler when a regression gets that far
 
-TODO: Add http (or other) authentication for using the API
-  This could also be used to tell out-of-date worker programs that they need to
-  be updated (because their auth token won't work any more)
-
 TODO: Show more information on directories in progress
   - Could display the time spent so far (i.e., now - start time)
   - Could display the average time spent on this directory in other running/stopped jobs

apiLib.sml

@@ -78,6 +78,7 @@ fun check_id f id =
 val host = "https://cakeml.org"
 val base_url = "/regression.cgi"
 val server = String.concat[host,base_url]
+val cakeml_token = until_space (file_to_string "cakeml-token")
 
 datatype api = Waiting | Refresh
              | Job of id | Claim of id * worker_name

server.sml

@@ -134,32 +134,40 @@ datatype request =
   | Post of id * string
   | Html of html_request
 
+fun check_auth auth =
+  if auth = SOME (String.concat["Bearer ",cakeml_token]) then ()
+  else cgi_die ["Unauthorized: ", Option.valOf auth handle Option => "got nothing"]
+
 fun get_api () =
   case (OS.Process.getEnv "PATH_INFO",
-        OS.Process.getEnv "REQUEST_METHOD") of
-    (SOME path_info, SOME "GET")
-      =>
-        if String.isPrefix "/api" path_info then
+        OS.Process.getEnv "REQUEST_METHOD",
+        OS.Process.getEnv "HTTP_AUTHORIZATION") of
+    (SOME path_info, SOME "GET", auth) =>
+      if String.isPrefix "/api" path_info then
+        let val () = check_auth auth in
           Option.map Get
             (api_from_string
               (String.extract(path_info,4,NONE))
               (OS.Process.getEnv "QUERY_STRING"))
-        else
-          (case String.tokens (equal #"/") path_info of
-            ["job",n] => Option.map (Html o DisplayJob) (id_from_string n)
-          | _ => SOME (Html Overview))
-  | (NONE, SOME "GET") => SOME (Html Overview)
-  | (SOME path_info, SOME "POST")
-      => (case String.tokens (equal #"/") path_info of
-            ["api","log",n] =>
-              (Option.mapPartial
-                (fn len =>
-                  Option.compose
-                    ((fn id => Post(id,TextIO.inputN(TextIO.stdIn,len))),
-                     id_from_string) n)
-                (Option.composePartial(Int.fromString,OS.Process.getEnv) "CONTENT_LENGTH"))
-          | ["api","refresh"] => SOME (Get Refresh) (* GitHub webhook requests this with POST *)
-          | _ => NONE)
+        end
+      else
+        (case String.tokens (equal #"/") path_info of
+          ["job",n] => Option.map (Html o DisplayJob) (id_from_string n)
+        | _ => SOME (Html Overview))
+  | (NONE, SOME "GET", _) => SOME (Html Overview)
+  | (SOME path_info, SOME "POST", auth) =>
+      let val () = check_auth auth in
+        case String.tokens (equal #"/") path_info of
+          ["api","log",n] =>
+            (Option.mapPartial
+              (fn len =>
+                Option.compose
+                  ((fn id => Post(id,TextIO.inputN(TextIO.stdIn,len))),
+                   id_from_string) n)
+              (Option.composePartial(Int.fromString,OS.Process.getEnv) "CONTENT_LENGTH"))
+        | ["api","refresh"] => SOME (Get Refresh) (* GitHub webhook requests this with POST *)
+        | _ => NONE
+      end
   | _ => NONE
 
 local

worker.sml

@@ -119,7 +119,10 @@ val poll_delay = Time.fromSeconds(60 * 30)
 structure API = struct
   val endpoint = String.concat[server,"/api"]
   fun curl_cmd api = (curl_path,
-    ["--silent","--show-error"] @ api_curl_args api @ [String.concat[endpoint,api_to_string api]])
+    ["--silent","--show-error",
+     "--header",String.concat["Authorization: Bearer ",cakeml_token]]
+    @ api_curl_args api
+    @ [String.concat[endpoint,api_to_string api]])
   val send = system_output o curl_cmd
   fun curl_log id file =
     (curl_path,["--silent","--show-error","--request","POST",