! Copyright (c) 2021 Approximatrix, LLC ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! The Software shall be used for Good, not Evil. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. module api_handling use iso_c_binding implicit none character(*), parameter::RESPONSE_JSON_IDLE = '{"status": "idle"}' character(*), parameter::RESPONSE_JSON_WORK_AVAILABLE = & '{"status": "pending",'//c_new_line//' "job": {job_number},'//c_new_line//' "instruction": "{instruction_name}"}' contains function build_job_available_json(job_id) result(json_text) use captain_db use utilities, only: replace_field implicit none integer, intent(in)::job_id character(len=:), pointer::json_text integer::instruction_id character(PLAYER_NAME_LENGTH)::instruction_name instruction_id = get_job_instruction(job_id) call get_instruction_name(instruction_id, instruction_name) allocate(character(len=(len(RESPONSE_JSON_WORK_AVAILABLE)+len_trim(instruction_name)+32)) :: json_text) json_text = RESPONSE_JSON_WORK_AVAILABLE call replace_field(json_text, "job_number", job_id) call replace_field(json_text, "instruction_name", instruction_name) end function build_job_available_json subroutine handle_task_request(req) use server_response use captain_db use logging implicit none class(request)::req integer::job_i, task_i character(len=:), pointer::status, task_type, attribute status => req%q%get_value("status") if(associated(status)) then job_i = req%path_component_int(5) task_i = req%path_component_int(7) call write_log("Task Update Is "//trim(status), LOG_DEBUG) if(status == "starting") then call write_log("Inserting task", LOG_DEBUG) call insert_task(job_i, task_i) call update_job_status(job_i, JOB_STATUS_WORKING) else if(status == "inprogress") then call update_task_status(job_i, task_i, JOB_STATUS_WORKING) call update_job_status(job_i, JOB_STATUS_WORKING) else if(status == "complete") then call update_task_status(job_i, task_i, JOB_STATUS_SUCCESS) else if(status == "failed") then call update_task_status(job_i, task_i, JOB_STATUS_FAILURE) end if task_type => req%q%get_value("type") if(associated(task_type)) then call write_log("Task Type Is "//trim(task_type), LOG_DEBUG) call update_task_type(job_i, task_i, task_type) end if end if end subroutine handle_task_request function api_request_gemini(req) result(resp) use server_response use captain_db use special_filenames use logging use security, only: validate_query_token use gemini_codes implicit none type(request), intent(in)::req type(response)::resp character(PLAYER_NAME_LENGTH)::player, instruction integer::job_i, player_i, qs_platform_index character(len=:), pointer::checkin_work_json ! Complete - "/api/player/{name}/job/{jobid}/complete" ! Failed - "/api/player/{name}/job/{jobid}/failed" ! Task - "/api/player/{name}/job/{jobid}/task/{task num}" if(trim(req%component(2)) == "player" .and. trim(req%component(4)) == "job") then if(validate_query_token(req%q%get_value("token"), req%component(3))) then job_i = req%path_component_int(5) call write_log("Job "//trim(req%component(5))//" update arrived", LOG_INFO) if(.not. is_final_job_status(job_i)) then if(trim(req%component(6)) == "complete") then call update_job_status(job_i, JOB_STATUS_SUCCESS) else if(trim(req%component(6)) == "failure") then call update_job_status(job_i, JOB_STATUS_FAILURE) end if end if if(trim(req%component(6)) == "task") then call write_log("Task update encountered", LOG_INFO) call handle_task_request(req) end if resp%code = GEMINI_CODE_SUCCESS call resp%set_body_contents(RESPONSE_JSON_OKAY) resp%body_mimetype = "text/plain" else resp%code = GEMINI_CODE_BAD_REQUEST end if ! Checkin - /api/player/{name}/checkin.json else if(trim(req%component(2)) == "player" .and. trim(req%component(4)) == "checkin.json") then if(validate_query_token(req%q%get_value("token"), req%component(3))) then ! Check for pending jobs call req%path_component(3, player) player_i = get_player_id(player) ! If we have a checkin, but the worker should have a job in progress, mark ! the jobs as failed. call mark_working_jobs_as_failed(player_i) ! Acknowledge the checkin in the database if(associated(req%query_string)) then if(associated(req%q%get_value("platform"))) then call acknowledge_checkin(player_i, req%q%get_value("platform")) else call acknowledge_checkin(player_i) end if else call acknowledge_checkin(player_i) end if job_i = get_pending_job_for_player(player_i) if(job_i < 0) then resp%code = GEMINI_CODE_SUCCESS call resp%set_body_contents(RESPONSE_JSON_IDLE) else checkin_work_json => build_job_available_json(job_i) if(associated(checkin_work_json)) then resp%code = GEMINI_CODE_SUCCESS call write_log("Sending: "//trim(checkin_work_json), LOG_DEBUG) call resp%set_body_contents(trim(checkin_work_json), "text/gemini") deallocate(checkin_work_json) else resp%code = GEMINI_CODE_PERMFAIL end if end if else resp%code = GEMINI_CODE_BAD_REQUEST end if ! Instruction - /api/instructions/{name} else if(trim(req%component(2)) == "instruction") then call req%path_component(3, instruction) resp%body_filename => get_special_full_filename("instructions", trim(instruction)//".json") if(associated(resp%body_filename)) then resp%temporary_file = .false. resp%code = GEMINI_CODE_SUCCESS resp%body_mimetype = "text/plain" else resp%code = GEMINI_CODE_PERMFAIL end if end if end function api_request_gemini function api_request_titan(req) result(resp) use server_response use special_filenames use logging use security, only: validate_token => validate_titan_token use gemini_codes implicit none type(titan_request), intent(in)::req type(response)::resp character(len=:), pointer::fullpath character(12)::job_text, task_text integer::job_id, task_num character(64)::msg fullpath => null() call write_log("Titan request encountered", LOG_INFO) ! Task - "/api/player/{name}/job/{jobid}/task/{task num}" if(trim(req%component(2)) == "player" .and. & trim(req%component(4)) == "job" .and. & trim(req%component(6)) == "task") & then if(validate_token(req%token, req%component(3))) then job_id = req%path_component_int(5) task_num = req%path_component_int(7) write(job_text, '(I6)') job_id write(task_text, '(I6)') task_num call write_log("Handling a task update for job "//trim(job_text)//" task "//trim(task_text), LOG_INFO) call handle_task_request(req) fullpath => get_task_result_static_filename(job_id, task_num) end if end if if(associated(fullpath)) then ! Write the file call write_log("Storing titan file to "//trim(fullpath), LOG_DEBUG) if(req%write_to(fullpath)) then resp%code = GEMINI_CODE_SUCCESS call resp%set_body_contents(RESPONSE_JSON_OKAY) resp%body_mimetype = "text/plain" else resp%code = GEMINI_CODE_TEMPFAIL end if else resp%code = GEMINI_CODE_PERMFAIL end if end function api_request_titan end module api_handling