objective categorical abstract machine language personal data server
Repository load method
+53
-3
+6
-3
pegasus/lib/env.ml
+6
-3
pegasus/lib/env.ml
···
1
-
type env = {hostname: string; invite_required: bool}
1
+
type env = {database_dir: string; hostname: string; invite_required: bool}
2
2
3
-
let load () =
3
+
let load () : env =
4
+
let database_dir =
5
+
Option.value ~default:"./db" @@ Sys.getenv_opt "DATABASE_DIR"
6
+
in
4
7
let hostname = Sys.getenv "PDS_HOSTNAME" in
5
8
let invite_required = Sys.getenv "INVITE_CODE_REQUIRED" = "true" in
6
-
{hostname; invite_required}
9
+
{database_dir; hostname; invite_required}
+30
pegasus/lib/repository.ml
+30
pegasus/lib/repository.ml
···
136
136
; mutable block_map: Cid.t StringMap.t option
137
137
; mutable commit: Cid.t option }
138
138
139
+
let load did : t Lwt.t =
140
+
let%lwt actor_store_conn =
141
+
Util.connect_sqlite Util.Constants.pegasus_db_location
142
+
in
143
+
let%lwt db = Util.connect_sqlite (Util.Constants.user_db_location did) in
144
+
let%lwt {signing_key; _} =
145
+
match%lwt Actor_store.get_actor_by_identifier did actor_store_conn with
146
+
| Some actor ->
147
+
Lwt.return actor
148
+
| None ->
149
+
failwith ("failed to retrieve actor for " ^ did)
150
+
in
151
+
let key =
152
+
match Kleidos.parse_multikey_str signing_key with
153
+
| key, (module M) when M.name = "K256" ->
154
+
K256 key
155
+
| key, (module M) when M.name = "P256" ->
156
+
P256 key
157
+
| _ ->
158
+
failwith "unsupported key type"
159
+
in
160
+
let%lwt commit =
161
+
match%lwt User_store.get_commit db with
162
+
| Some (cid, _) ->
163
+
Lwt.return_some cid
164
+
| None ->
165
+
Lwt.return_none
166
+
in
167
+
Lwt.return {key; did; db; block_map= None; commit}
168
+
139
169
let get_map t : Cid.t StringMap.t Lwt.t =
140
170
let%lwt root, commit =
141
171
match%lwt User_store.get_commit t.db with
+17
pegasus/lib/util.ml
+17
pegasus/lib/util.ml
···
2
2
exception XrpcError of (string * string)
3
3
end
4
4
5
+
module Constants = struct
6
+
let pegasus_db_location =
7
+
Env.load ()
8
+
|> fun {database_dir; _} -> Filename.concat database_dir "pegasus.db"
9
+
10
+
let user_db_location did =
11
+
let rec last (lst : 'a list) : 'a option =
12
+
match lst with [] -> None | [x] -> Some x | _ :: xs -> last xs
13
+
in
14
+
let filename =
15
+
did |> String.split_on_char ':' |> last |> Option.get
16
+
|> Printf.sprintf "%s.db"
17
+
in
18
+
Env.load ()
19
+
|> fun {database_dir; _} -> Filename.concat database_dir filename
20
+
end
21
+
5
22
module Syntax = struct
6
23
(* unwraps an Lwt result, raising an exception if there's an error *)
7
24
let ( let$! ) m f =