Source file error.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
module Code = struct
  type t =
    | Parse_error
    | Invalid_request
    | Method_not_found
    | Invalid_params
    | Internal_error
    | Task_not_found
    | Task_not_cancelable
    | Push_notification_not_supported
    | Unsupported_operation
    | Content_type_not_supported
    | Invalid_agent_response
    | Extended_agent_card_not_configured
    | Extension_support_required
    | Version_not_supported
    | Other of int

  let of_int = function
    | -32700 -> Parse_error
    | -32600 -> Invalid_request
    | -32601 -> Method_not_found
    | -32602 -> Invalid_params
    | -32603 -> Internal_error
    | -32001 -> Task_not_found
    | -32002 -> Task_not_cancelable
    | -32003 -> Push_notification_not_supported
    | -32004 -> Unsupported_operation
    | -32005 -> Content_type_not_supported
    | -32006 -> Invalid_agent_response
    | -32007 -> Extended_agent_card_not_configured
    | -32008 -> Extension_support_required
    | -32009 -> Version_not_supported
    | n -> Other n

  let to_int = function
    | Parse_error -> -32700
    | Invalid_request -> -32600
    | Method_not_found -> -32601
    | Invalid_params -> -32602
    | Internal_error -> -32603
    | Task_not_found -> -32001
    | Task_not_cancelable -> -32002
    | Push_notification_not_supported -> -32003
    | Unsupported_operation -> -32004
    | Content_type_not_supported -> -32005
    | Invalid_agent_response -> -32006
    | Extended_agent_card_not_configured -> -32007
    | Extension_support_required -> -32008
    | Version_not_supported -> -32009
    | Other n -> n

  let to_string = function
    | Parse_error -> "JSONParseError"
    | Invalid_request -> "InvalidRequestError"
    | Method_not_found -> "MethodNotFoundError"
    | Invalid_params -> "InvalidParamsError"
    | Internal_error -> "InternalError"
    | Task_not_found -> "TaskNotFoundError"
    | Task_not_cancelable -> "TaskNotCancelableError"
    | Push_notification_not_supported -> "PushNotificationNotSupportedError"
    | Unsupported_operation -> "UnsupportedOperationError"
    | Content_type_not_supported -> "ContentTypeNotSupportedError"
    | Invalid_agent_response -> "InvalidAgentResponseError"
    | Extended_agent_card_not_configured -> "ExtendedAgentCardNotConfiguredError"
    | Extension_support_required -> "ExtensionSupportRequiredError"
    | Version_not_supported -> "VersionNotSupportedError"
    | Other n -> Printf.sprintf "error %d" n

  let reasons =
    [ (Parse_error, "PARSE_ERROR"); (Invalid_request, "INVALID_REQUEST");
      (Method_not_found, "METHOD_NOT_FOUND"); (Invalid_params, "INVALID_PARAMS");
      (Internal_error, "INTERNAL_ERROR"); (Task_not_found, "TASK_NOT_FOUND");
      (Task_not_cancelable, "TASK_NOT_CANCELABLE");
      (Push_notification_not_supported, "PUSH_NOTIFICATION_NOT_SUPPORTED");
      (Unsupported_operation, "UNSUPPORTED_OPERATION");
      (Content_type_not_supported, "CONTENT_TYPE_NOT_SUPPORTED");
      (Invalid_agent_response, "INVALID_AGENT_RESPONSE");
      (Extended_agent_card_not_configured, "EXTENDED_AGENT_CARD_NOT_CONFIGURED");
      (Extension_support_required, "EXTENSION_SUPPORT_REQUIRED");
      (Version_not_supported, "VERSION_NOT_SUPPORTED") ]

  let of_reason r = List.find_map (fun (c, s) -> if s = r then Some c else None) reasons
end

type error_info = {
  reason : string;
  domain : string;
  info_metadata : (string * string) list;
}

type rpc_error = {
  code : Code.t;
  message : string;
  details : Yojson.Safe.t list;
}

type t =
  | Rpc_error of rpc_error
  | Http_error of { status : int; body : string }
  | Transport_error of string
  | Timeout of string
  | Invalid_response of string
  | Stream_ended of { last_task : Types.Task.t option }
  | Poll_timeout of { last_task : Types.Task.t option }
  | No_compatible_interface of string
  | Unsupported_capability of string

let error_info e =
  List.find_map
    (function
      | `Assoc kvs when List.assoc_opt "@type" kvs
                        = Some (`String "type.googleapis.com/google.rpc.ErrorInfo") ->
          let str k = match List.assoc_opt k kvs with Some (`String s) -> s | _ -> "" in
          let info_metadata =
            match List.assoc_opt "metadata" kvs with
            | Some (`Assoc m) ->
                List.filter_map (function k, `String v -> Some (k, v) | _ -> None) m
            | _ -> []
          in
          Some { reason = str "reason"; domain = str "domain"; info_metadata }
      | _ -> None)
    e.details

let pp ppf = function
  | Rpc_error { code; message; _ } ->
      Format.fprintf ppf "%s (%d): %s" (Code.to_string code) (Code.to_int code) message
  | Http_error { status; body } ->
      Format.fprintf ppf "HTTP %d%s" status (if body = "" then "" else ": " ^ body)
  | Transport_error msg -> Format.fprintf ppf "transport error: %s" msg
  | Timeout what -> Format.fprintf ppf "timeout: %s" what
  | Invalid_response msg -> Format.fprintf ppf "invalid response: %s" msg
  | Stream_ended { last_task } ->
      Format.fprintf ppf "stream ended before the task settled%s"
        (match last_task with
         | Some t -> Printf.sprintf " (task %s, %s)" t.id (Types.Task_state.to_string t.status.state)
         | None -> "")
  | Poll_timeout { last_task } ->
      Format.fprintf ppf "gave up waiting for task%s"
        (match last_task with
         | Some t -> Printf.sprintf " %s (last state %s)" t.id (Types.Task_state.to_string t.status.state)
         | None -> "")
  | No_compatible_interface msg -> Format.fprintf ppf "no compatible interface: %s" msg
  | Unsupported_capability msg -> Format.fprintf ppf "unsupported capability: %s" msg

let to_string e = Format.asprintf "%a" pp e