type info_t = { version: int; name: string; archivists: string list } type text_t = { id: Msgpck.t; time: Msgpck.t; title: Msgpck.t; authors: Msgpck.t } type t = { info: info_t; fields: string list; texts: Msgpck.t; peers: Msgpck.t } let of_id id = Msgpck.Bytes (Id.to_bytes id) let to_id pck_id = Id.of_bytes Msgpck.(to_bytes pck_id) let person p = Msgpck.String (Person.to_string p) let persons ps = List.rev @@ Person.Set.fold (fun p a -> person p :: a) ps [] let of_set field t = List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) [] let date = function | None -> Int32.zero | Some date -> let days, ps = Ptime.Span.to_d_ps (Ptime.to_span date) in Int32.add Int32.(mul (of_int days) 86400l) Int64.(to_int32 (div ps 1000000000000L)) let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x let public_peers () = Peers.fold_file (fun x a -> Msgpck.String x :: a) [] Peers.public_fname let fields = Msgpck.(List [String "id"; String "time"; String "title"; String "authors"; String "topics"]) let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack) let to_pack a t = let open Text in Msgpck.(List [ Bytes (Id.to_bytes t.uuid); of_uint32 (date (Date.listing t.date)); String t.title; List (persons t.authors); List (of_set "topics" t) ]) :: a let pack_filename ?(filename="index.pck") archive = let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*) dir ^ "/" ^ filename let to_info = function | Msgpck.List (v::n::a::[]) -> let archivists = List.map Msgpck.to_string (Msgpck.to_list a) in Msgpck.({version = to_int v; name = to_string n; archivists}) | _ -> invalid_arg "Pack header" let unpack = function | Msgpck.List (i::f::texts::[]) -> Some { info = to_info i; fields = to_fields f; texts; peers = Msgpck.List [] } | Msgpck.List (i::f::texts::peers::[]) -> Some { info = to_info i; fields = to_fields f; texts; peers } | _ -> None let list filename = try let texts_list = function | Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts | _ -> prerr_endline "malformed feed"; [] in let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in Ok (texts_list data) with Not_found -> Error "unspecified export dir" let contains text = function | Msgpck.List (id::_time::title::_authors::_topics::[]) -> (match Id.of_bytes (Msgpck.to_bytes id) with | None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false | Some id -> text.Text.uuid = id) | _ -> prerr_endline ("Invalid record pattern"); false let pack archive records = let header_pack = List.fold_left to_pack [] records in let info = Msgpck.(List [Int 0; String archive.File_store.name; List (persons archive.archivists)]) in Bytes.to_string @@ Msgpck.Bytes.to_string (List [info; fields; Msgpck.List header_pack; Msgpck.List (public_peers ())]) let add archive records = let fname = pack_filename archive in let append published (t, _f) = if List.exists (contains t) published then published else to_pack published t in match list fname with Error e -> prerr_endline e | Ok published_list -> let header_pack = List.fold_left append published_list records in let archive = Msgpck.(List [Int 0; String archive.File_store.name; List (persons archive.archivists)]) in File_store.file fname @@ Bytes.to_string @@ Msgpck.Bytes.to_string (List [archive; fields; Msgpck.List header_pack]) let unpublish _archive _records = ()