Source file token.ml

(*********************************************************************************)
(*                OCaml-ActivityPub                                              *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public License          *)
(*    along with this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: maxence.guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Creating and storing named tokens used for authentication. *)

let () = Random.self_init ()

type key = string
type t = {
    name : string [@ocf Ocf.Wrapper.string, "name"] ;
    key : key [@ocf Ocf.Wrapper.string, ""] ;
  }
  [@@ocf]

let random_key =
  let hash = Cryptokit.Hash.sha256 () in
  fun () ->
    let str = Cryptokit.Random.(string secure_rng 256) in
    hash#add_string str ;
    let str = hash#result in
    hash#wipe ;
    Base64.encode_string str

let make name =
  let key = random_key () in
  { name ; key }

type auth_token = { actor : string ; key : key }

let string_of_auth_token t = Printf.sprintf "%s/%s" t.actor t.key
let auth_token_of_string str =
  match String.index_from_opt str 0 '/' with
  | None -> Error (Printf.sprintf "Invalid token %S" str)
  | Some p ->
      let len = String.length str in
      let actor = String.sub str 0 p in
      let key = String.sub str (p+1) (len - p - 1) in
      Ok { actor ; key }

let token_list_wrapper = Ocf.Wrapper.list t_wrapper

let tokens_of_file file =
  if%lwt Lwt_unix.file_exists file then
    (
     let%lwt str = Lwt_io.(with_file ~mode:Input file read) in
     let o = Ocf.option token_list_wrapper [] in
     let g = Ocf.as_group o in
     Ocf.from_string g str ;
     Lwt.return (Ocf.get o)
    )
  else
    Lwt.return []

let file_of_tokens tokens file =
  let o = Ocf.option token_list_wrapper tokens in
  let g = Ocf.as_group o in
  let str = Ocf.to_string g in
  Lwt_io.(with_file ~mode:Output file (fun oc -> write oc str))