CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-20 00:41:05 +03:00
Code Issues Projects Releases Wiki Activity

Legifrance API: better use of LWT, and retry token query

Browse Source
This commit is contained in:
Louis Gesbert 2023-01-26 17:14:46 +01:00
parent ac2f02b7e9
commit 07870eb2f6
3 changed files with 134 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
french_law/catala_legifrance/api.ml
View File

@ -14,13 +14,14 @@
License for the specific language governing permissions and limitations under
the License. *)
open Lwt
open Catala_utils
type access_token = string
let ( let* ) = Lwt.bind
let get_token_aux (client_id : string) (client_secret : string) :
(string * string t) t =
(Cohttp.Code.status_code * string) Lwt.t =
let site = "https://oauth.aife.economie.gouv.fr" in
let token_url = "/api/oauth/token" in
let uri = Uri.of_string (site ^ token_url) in
@ -39,32 +40,44 @@ let get_token_aux (client_id : string) (client_secret : string) :
|> Printf.sprintf "%s"
in
let body = body_string |> Cohttp_lwt.Body.of_string in
Cohttp_lwt_unix.Client.post ~headers ~body uri
>>= fun (resp, body) ->
( resp |> Cohttp_lwt.Response.status |> Cohttp.Code.string_of_status,
body |> Cohttp_lwt.Body.to_string )
|> return
let* resp, body = Cohttp_lwt_unix.Client.post ~headers ~body uri in
let status = resp |> Cohttp_lwt.Response.status in
let* body = body |> Cohttp_lwt.Body.to_string in
Lwt.return (status, body)
let get_token (client_id : string) (client_secret : string) : string =
let resp, body = Lwt_main.run (get_token_aux client_id client_secret) in
let body = Lwt_main.run body in
if resp = "200 OK" then begin
let token =
body
|> Yojson.Basic.from_string
|> Yojson.Basic.Util.member "access_token"
|> Yojson.Basic.Util.to_string
in
Cli.debug_format "The LegiFrance API access token is %s" token;
token
end
else begin
Cli.debug_format
"The API access token request went wrong ; status is %s and the body is\n\
%s"
resp body;
exit 1
end
let get_token (client_id : string) (client_secret : string) : string Lwt.t =
let rec retry count =
if count = 0 then (
Cli.debug_format "Too many retries, giving up\n";
exit 1)
else
let* resp, body = get_token_aux client_id client_secret in
if Cohttp.Code.code_of_status resp = 200 then begin
let token =
body
|> Yojson.Basic.from_string
|> Yojson.Basic.Util.member "access_token"
|> Yojson.Basic.Util.to_string
in
Cli.debug_format "The LegiFrance API access token is %s" token;
Lwt.return token
end
else if Cohttp.Code.code_of_status resp = 400 then begin
Cli.debug_format "The API access request returned code 400%s\n"
(if count > 1 then ", retrying..." else "");
retry (count - 1)
end
else begin
Cli.debug_format
"The API access token request went wrong ; status is %s and the body \
is\n\
%s"
(Cohttp.Code.string_of_status resp)
body;
exit 1
end
in
retry 10
let site = "https://api.aife.economie.gouv.fr"
let base_token_url = "/dila/legifrance-beta/lf-engine-app/"
@ -75,7 +88,8 @@ let api_timestamp_to_localtime (timestamp : int) : Unix.tm =
let make_request
(access_token : string)
(token_url : string)
(body_json : (string * string) list) : (string * string t) t =
(body_json : (string * string) list)
() : (string * string) Lwt.t =
let uri = Uri.of_string (site ^ base_token_url ^ token_url) in
let headers =
Cohttp.Header.init_with "Authorization"
@ -90,22 +104,19 @@ let make_request
|> Printf.sprintf "{%s}"
in
let body = body_string |> Cohttp_lwt.Body.of_string in
Cohttp_lwt_unix.Client.post ~headers ~body uri
>>= fun (resp, body) ->
( resp |> Cohttp_lwt.Response.status |> Cohttp.Code.string_of_status,
body |> Cohttp_lwt.Body.to_string )
|> return
let* resp, body = Cohttp_lwt_unix.Client.post ~headers ~body uri in
let resp =
resp |> Cohttp_lwt.Response.status |> Cohttp.Code.string_of_status
in
let* body = body |> Cohttp_lwt.Body.to_string in
Lwt.return (resp, body)
type article_type = LEGIARTI | CETATEXT | JORFARTI
type article_id = { id : string; typ : article_type }
type article = { content : Yojson.Basic.t; typ : article_type }
let run_request (request : (string * string t) t) : Yojson.Basic.t =
let try_once () =
let resp, body = Lwt_main.run request in
let body = Lwt_main.run body in
resp, body
in
let run_request (request : unit -> (string * string) Lwt.t) :
Yojson.Basic.t Lwt.t =
let handle_once resp body =
if resp = "200 OK" then
try body |> Yojson.Basic.from_string with
@ -124,8 +135,8 @@ let run_request (request : (string * string t) t) : Yojson.Basic.t =
else raise (Failure "")
in
let rec try_n_times (n : int) =
let resp, body = try_once () in
try handle_once resp body
let* resp, body = request () in
try Lwt.return (handle_once resp body)
with Failure _ ->
if n > 0 then (
Unix.sleep 2;
@ -161,20 +172,20 @@ let parse_id (id : string) : article_id =
in
{ id; typ }
let retrieve_article (access_token : string) (obj : article_id) : article =
let retrieve_article (access_token : string) (obj : article_id) : article Lwt.t
=
Cli.debug_format "Accessing article %s" obj.id;
{
content =
run_request
(make_request access_token
(match obj.typ with
| CETATEXT -> "consult/juri"
| LEGIARTI | JORFARTI -> "consult/getArticle")
(match obj.typ with
| CETATEXT -> ["textId", obj.id]
| LEGIARTI | JORFARTI -> ["id", obj.id]));
typ = obj.typ;
}
let* content =
run_request
(make_request access_token
(match obj.typ with
| CETATEXT -> "consult/juri"
| LEGIARTI | JORFARTI -> "consult/getArticle")
(match obj.typ with
| CETATEXT -> ["textId", obj.id]
| LEGIARTI | JORFARTI -> ["id", obj.id]))
in
Lwt.return { content; typ = obj.typ }
let raise_article_parsing_error
(json : Yojson.Basic.t)

4
french_law/catala_legifrance/api.mli
View File

@ -23,7 +23,7 @@ type access_token
(** The [access_token] is the OAuth token used in every API request for
authentication *)
val get_token : string -> string -> access_token
val get_token : string -> string -> access_token Lwt.t
(** [get_token cliend_id client_secret] retrieves the access token from the
LegiFrance API. You have to register on the
{{:https://developer.aife.economie.gouv.fr/} the official website of the
@ -38,7 +38,7 @@ val parse_id : string -> article_id
fetched from the API, checks its validity (for instance
["LEGIARTI000006307920"]) and returns an [object_id]*)
val retrieve_article : access_token -> article_id -> article
val retrieve_article : access_token -> article_id -> article Lwt.t
(** [retrieve_article token article_id] returns the article from the LegiFrance
API.*)

115
french_law/catala_legifrance/catala_legifrance.ml
View File

@ -16,6 +16,8 @@
open Catala_utils
let ( let* ) = Lwt.bind
(** Main logic for interacting with LégiFrance when traversing Catala source
files *)
@ -23,12 +25,12 @@ open Catala_utils
let check_article_expiration
(current_date : Unix.tm)
(law_heading : Surface.Ast.law_heading)
(access_token : Api.access_token) : string option =
(access_token : Api.access_token) : string option Lwt.t =
match law_heading.Surface.Ast.law_heading_id with
| None -> None
| None -> Lwt.return None
| Some heading_id ->
let article_id = Api.parse_id heading_id in
let article = Api.retrieve_article access_token article_id in
let* article = Api.retrieve_article access_token article_id in
let legifrance_expiration_date = Api.get_article_expiration_date article in
let is_archive = law_heading.Surface.Ast.law_heading_is_archive in
(* At this point we have two dates. [C] the current date, [L] the expiration
@ -59,8 +61,8 @@ let check_article_expiration
| None -> ""
| Some new_version ->
Format.asprintf " New version of the article: \"%s\"." new_version);
new_version)
else None
Lwt.return new_version)
else Lwt.return None
type law_article_text = {
article_title : string * Pos.t;
@ -79,8 +81,8 @@ module Diff = Diff.Make (String)
let compare_article_to_version
(access_token : Api.access_token)
(text : string)
(version : Api.article_id) : Diff.t option =
let new_article = Api.retrieve_article access_token version in
(version : Api.article_id) : Diff.t option Lwt.t =
let* new_article = Api.retrieve_article access_token version in
let new_article_text = Api.get_article_text new_article in
let text_to_list text =
List.map String.trim
@ -103,14 +105,14 @@ let compare_article_to_version
(fun chunk -> match chunk with Diff.Equal _ -> true | _ -> false)
diff
in
if not all_equal then Some diff else None
Lwt.return (if not all_equal then Some diff else None)
(** Compares [article_text_acc.current_version] and
[article_text_acc.new_version] by accessing LégiFrance and display
differences if any *)
let compare_to_versions
(law_article_text : law_article_text)
(access_token : Api.access_token) : unit =
(access_token : Api.access_token) : unit Lwt.t =
let print_diff msg diff =
Cli.warning_print "%s\n%s" msg
(String.concat "\n"
@ -118,7 +120,7 @@ let compare_to_versions
(fun chunk ->
match chunk with
| Diff.Equal words ->
ANSITerminal.sprintf [] "%s" (String.concat " " words)
ANSITerminal.sprintf [] " %s" (String.concat " " words)
| Diff.Added words ->
ANSITerminal.sprintf [ANSITerminal.green] "(+) %s"
(String.concat " " words)
@ -127,13 +129,14 @@ let compare_to_versions
(String.concat " " words))
diff))
in
begin
let* _checl =
match law_article_text.current_version with
| Some version -> (
match
let* comparison =
compare_article_to_version access_token law_article_text.text version
with
| None -> ()
in
match comparison with
| None -> Lwt.return_unit
| Some diff ->
print_diff
(Printf.sprintf
@ -141,15 +144,17 @@ let compare_to_versions
text stored on LégiFrance:\n"
(fst law_article_text.article_title)
(Pos.to_string (snd law_article_text.article_title)))
diff)
| None -> ()
end;
diff;
Lwt.return_unit)
| None -> Lwt.return_unit
in
match law_article_text.new_version with
| Some version -> (
match
let* comparison =
compare_article_to_version access_token law_article_text.text version
with
| None -> ()
in
match comparison with
| None -> Lwt.return_unit
| Some diff ->
print_diff
(Printf.sprintf
@ -157,17 +162,18 @@ let compare_to_versions
will become in the future:\n"
(fst law_article_text.article_title)
(Pos.to_string (snd law_article_text.article_title)))
diff)
| None -> ()
diff;
Lwt.return_unit)
| None -> Lwt.return_unit
(** Fill an [@@Include ...@@] tag inside the Catala source file with the
legislative contents retrieved from LégiFrance *)
let include_legislative_text
(id : string * Pos.t)
(access_token : Api.access_token) : string =
(access_token : Api.access_token) : string Lwt.t =
let pos = snd id in
let id = Api.parse_id (fst id) in
let article = Api.retrieve_article access_token id in
let* article = Api.retrieve_article access_token id in
let text_to_return = Api.get_article_text article in
let to_insert = text_to_return in
Cli.debug_format "Position: %s" (Pos.to_string_short pos);
@ -190,29 +196,30 @@ let include_legislative_text
with End_of_file ->
close_in ic;
close_out oc);
text_to_return
Lwt.return text_to_return
let rec traverse_source_code
~(current_date : Unix.tm)
~(diff : bool)
~(expiration : bool)
(access_token : Api.access_token)
(item : Surface.Ast.law_structure) : string =
(item : Surface.Ast.law_structure) : string Lwt.t =
match item with
| Surface.Ast.LawHeading (law_heading, children) ->
let children_text =
List.fold_left
let* children_text =
Lwt_list.fold_left_s
(fun acc child ->
acc
^ "\n\n"
^ traverse_source_code ~current_date ~diff ~expiration access_token
child)
let* traversal =
traverse_source_code ~current_date ~diff ~expiration access_token
child
in
Lwt.return (acc ^ "\n\n" ^ traversal))
"" children
in
let new_version =
let* new_version =
if expiration then
check_article_expiration current_date law_heading access_token
else None
else Lwt.return None
in
let law_article_text =
{
@ -225,12 +232,15 @@ let rec traverse_source_code
current_version = Option.map Api.parse_id law_heading.law_heading_id;
}
in
if diff then compare_to_versions law_article_text access_token;
children_text
| Surface.Ast.LawText art_text -> art_text
let* _cmp =
if diff then compare_to_versions law_article_text access_token
else Lwt.return_unit
in
Lwt.return children_text
| Surface.Ast.LawText art_text -> Lwt.return art_text
| Surface.Ast.LawInclude (Surface.Ast.LegislativeText id) ->
include_legislative_text id access_token
| _ -> ""
| _ -> Lwt.return ""
(** Parses the Catala master source file and checks each article:
@ -240,7 +250,7 @@ let rec traverse_source_code
current version of the article and the next one on LégiFrance;
- fill each [@@Include ...@@] tag with the contents retrieved from
LégiFrance *)
let driver
let driver_lwt
(file : string)
(debug : bool)
(diff : bool)
@ -254,7 +264,7 @@ let driver
Errors.raise_error
"You have to check at least something, see the list of options with \
--help";
let access_token = Api.get_token client_id client_secret in
let* access_token = Api.get_token client_id client_secret in
(* LégiFrance is only supported for French texts *)
let program =
Surface.Parser_driver.parse_top_level_file (FileName file) Fr
@ -264,18 +274,27 @@ let driver
| Some custom_date -> Date.parse_expiration_date ISO custom_date
| None -> Unix.localtime (Unix.time ())
in
List.iter
(fun item ->
ignore
(traverse_source_code ~current_date ~diff ~expiration access_token
item))
program.program_items;
0
let* () =
Lwt_list.iter_s
(fun item ->
let* _r =
traverse_source_code ~current_date ~diff ~expiration access_token
item
in
Lwt.return_unit)
program.program_items
in
prerr_endline "0";
Lwt.return 0
with Errors.StructuredError (msg, pos) ->
let bt = Printexc.get_raw_backtrace () in
Cli.error_print "%s" (Errors.print_structured_error msg pos);
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
-1
Lwt.return (-1)
let driver file debug diff expiration custom_date client_id client_secret =
Lwt_main.run
(driver_lwt file debug diff expiration custom_date client_id client_secret)
(** Hook for the executable *)
let _ =