lib/as2.ml

   1 (*
   2  *    _  _   ____                         _
   3  *  _| || |_/ ___|  ___ _ __  _ __   ___ | |
   4  * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| |
   5  * |_      _|___) |  __/ |_) | |_) | (_) |_|
   6  *   |_||_| |____/ \___| .__/| .__/ \___/(_)
   7  *                     |_|   |_|
   8  *
   9  * Personal Social Web.
  10  *
  11  * Copyright (C) The #Seppo contributors. All rights reserved.
  12  *
  13  * This program is free software: you can redistribute it and/or modify
  14  * it under the terms of the GNU General Public License as published by
  15  * the Free Software Foundation, either version 3 of the License, or
  16  * (at your option) any later version.
  17  *
  18  * This program is distributed in the hope that it will be useful,
  19  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  20  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21  * GNU General Public License for more details.
  22  *
  23  * You should have received a copy of the GNU General Public License
  24  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25  *)
  26
  27 open Astring
  28
  29 (*
  30  * https://www.w3.org/TR/activitystreams-core/
  31  * https://www.w3.org/TR/activitystreams-core/#media-type
  32  *)
  33
  34 module No_p_yes = struct
  35   type t = No | Pending | Yes
  36   (** tristate with pending *)
  37   let to_string = function
  38     | No      -> "no"
  39     | Pending -> "pending"
  40     | Yes     -> "yes"
  41   let of_string = function
  42     | "no"      -> Some No
  43     | "pending" -> Some Pending
  44     | "yes"
  45     | "on"      -> Some Yes (* convenience for html form submit feedback *)
  46     | _         -> None
  47 end
  48
  49 let examine_response j =
  50   let ok = function
  51     | `O ["error", `String e] -> Error e
  52     | _ ->
  53       Logr.warn (fun m -> m "unknown response: %s" j);
  54       Error ("unknown response: " ^ j) in
  55   let error = function
  56     | `Error _ as e ->
  57       let e = e |> Ezjsonm.read_error_description in
  58       Logr.warn (fun m -> m "json parsing error: '%s' in '%s'" e j);
  59       Error ("json parsing error '" ^ e ^ "' in '" ^ j ^ "'")
  60     | `Unexpected _ ->
  61       Logr.warn (fun m -> m "unexpected json: '%s'" j);
  62       Error ("unexpected json '" ^ j ^ "'")
  63     | `End_of_input -> Error "end of input"
  64   in
  65   j
  66   |> Ezjsonm.value_from_string_result
  67   |> Result.fold ~ok ~error
  68 (*
  69 let ns_as  = As2_vocab.Constants.ActivityStreams.ns_as
  70 let ns_sec = As2_vocab.Constants.ActivityStreams.ns_sec
  71 let public = As2_vocab.Constants.ActivityStreams.public
  72 *)