on master help sign in
Add profile support: display names, bios, and photos shared via encrypted profile messages
4471c7eiko
client/App.fs+186−15
@@ -1,6 +1,7 @@
1namespace Skrepka
1namespace Skrepka
2
2
3open System
3open System
4+open System.IO
4open System.Text.Json
5open System.Text.Json
5open System.Text.Json.Serialization
6open System.Text.Json.Serialization
6open Fabulous
7open Fabulous
@@ -23,6 +24,7 @@ module App =
23 | Chat of pubkey: string * compose: string
24 | Chat of pubkey: string * compose: string
24 | AddContact of pubkey: string * nickname: string
25 | AddContact of pubkey: string * nickname: string
25 | Settings
26 | Settings
27+ | EditProfile of displayName: string * bio: string * photo: string option
26
28
27 type Session = { Url: string; Token: string; Identity: Identity }
29 type Session = { Url: string; Token: string; Identity: Identity }
28
30
@@ -40,6 +42,7 @@ module App =
40 type DecryptedEvent =
42 type DecryptedEvent =
41 | IncomingChat of IncomingMessage
43 | IncomingChat of IncomingMessage
42 | IncomingDeliveryAck of senderPubkey: string * ackIds: string list
44 | IncomingDeliveryAck of senderPubkey: string * ackIds: string list
45+ | IncomingProfile of senderPubkey: string * displayName: string * bio: string * photo: string option
43
46
44 type PollReceived = { Events: int; Messages: int; Errors: int; FirstError: string option }
47 type PollReceived = { Events: int; Messages: int; Errors: int; FirstError: string option }
45
48
@@ -59,13 +62,14 @@ module App =
59 PollStatus: PollStatus
62 PollStatus: PollStatus
60 Messages: Map<string, ChatMessage list>
63 Messages: Map<string, ChatMessage list>
61 Error: string option
64 Error: string option
62− PollCursor: int64 }
65+ PollCursor: int64
66+ Profile: Profile option }
63
67
64 // ── Msg ──
68 // ── Msg ──
65
69
66 type StateLoadResult =
70 type StateLoadResult =
67− | IdentityAndData of Identity * Data
71+ | IdentityAndData of Identity * Data * Profile option
68− | IdentityOnly of Identity
72+ | IdentityOnly of Identity * Profile option
69 | NothingSaved
73 | NothingSaved
70
74
71 type Msg =
75 type Msg =
@@ -87,6 +91,11 @@ module App =
87 | CopyPubKey
91 | CopyPubKey
88 | DismissError
92 | DismissError
89 | StateLoaded of StateLoadResult
93 | StateLoaded of StateLoadResult
94+ | SetProfileDisplayName of string
95+ | SetProfileBio of string
96+ | DoPickPhoto
97+ | PhotoPicked of string option
98+ | DoSaveProfile
90
99
91 // ── CmdMsg ──
100 // ── CmdMsg ──
92
101
@@ -98,6 +107,9 @@ module App =
98 | CmdLoadState
107 | CmdLoadState
99 | CmdSaveIdentity of Identity
108 | CmdSaveIdentity of Identity
100 | CmdSaveData of Data
109 | CmdSaveData of Data
110+ | CmdPickPhoto
111+ | CmdSaveProfile of Profile
112+ | CmdSendProfileToAll of session: Session * Profile * recipientHexes: string list
101
113
102 // ── Helpers ──
114 // ── Helpers ──
103
115
@@ -121,10 +133,14 @@ module App =
121 |> Option.filter (fun bytes -> bytes.Length = 32)
133 |> Option.filter (fun bytes -> bytes.Length = 32)
122
134
123 let private contactName (contacts: Contact list) (pk: string) =
135 let private contactName (contacts: Contact list) (pk: string) =
136+ let fallback = truncKey pk
124 contacts
137 contacts
125 |> List.tryFind (fun c -> c.Pubkey = pk)
138 |> List.tryFind (fun c -> c.Pubkey = pk)
126− |> Option.map _.Nickname
139+ |> Option.map (fun c ->
140+ if c.Nickname <> fallback then c.Nickname
141+ elif not (String.IsNullOrEmpty c.DisplayName) then c.DisplayName
142+ else c.Nickname)
127− |> Option.defaultValue (truncKey pk)
143+ |> Option.defaultValue fallback
128
144
129 let private messagesFor (pk: string) (messages: Map<string, ChatMessage list>) =
145 let private messagesFor (pk: string) (messages: Map<string, ChatMessage list>) =
130 messages |> Map.tryFind pk |> Option.defaultValue []
146 messages |> Map.tryFind pk |> Option.defaultValue []
@@ -179,7 +195,8 @@ module App =
179 Contacts = []
195 Contacts = []
180 Messages = Map.empty
196 Messages = Map.empty
181 Error = None
197 Error = None
182− PollCursor = 0L },
198+ PollCursor = 0L
199+ Profile = None },
183 [ CmdLoadState ]
200 [ CmdLoadState ]
184
201
185 // ── Update ──
202 // ── Update ──
@@ -237,12 +254,20 @@ module App =
237 IsOutgoing = true
254 IsOutgoing = true
238 Status = DeliveryStatus.Sent }
255 Status = DeliveryStatus.Sent }
239
256
257+ let isFirstInteraction = model.Messages |> messagesFor pk |> List.isEmpty
258+
240 let model' =
259 let model' =
241 { model with
260 { model with
242 Page = Chat(pk, "")
261 Page = Chat(pk, "")
243 Messages = model.Messages |> appendMessage pk outMsg }
262 Messages = model.Messages |> appendMessage pk outMsg }
244
263
245− model', [ CmdSend(session, pk, compose, id); saveCmdMsg model' ]
264+ let cmds = [ CmdSend(session, pk, compose, id); saveCmdMsg model' ]
265+ let cmds =
266+ match model.Profile, isFirstInteraction with
267+ | Some profile, true -> cmds @ [ CmdSendProfileToAll(session, profile, [ pk ]) ]
268+ | _ -> cmds
269+
270+ model', cmds
246 | _ -> model, []
271 | _ -> model, []
247
272
248 | SendFailed err -> { model with Error = Some err }, []
273 | SendFailed err -> { model with Error = Some err }, []
@@ -256,10 +281,18 @@ module App =
256 match evt with
281 match evt with
257 | IncomingChat msg ->
282 | IncomingChat msg ->
258 { m with
283 { m with
259− Contacts = m.Contacts |> addContactIfNew { Pubkey = msg.SenderPubkey; Nickname = truncKey msg.SenderPubkey }
284+ Contacts = m.Contacts |> addContactIfNew { Pubkey = msg.SenderPubkey; Nickname = truncKey msg.SenderPubkey; DisplayName = null; Bio = null; PhotoBase64 = null }
260 Messages = m.Messages |> appendMessage msg.SenderPubkey msg.Message }
285 Messages = m.Messages |> appendMessage msg.SenderPubkey msg.Message }
261 | IncomingDeliveryAck(senderPubkey, ackIds) ->
286 | IncomingDeliveryAck(senderPubkey, ackIds) ->
262− { m with Messages = m.Messages |> markDelivered senderPubkey ackIds })
287+ { m with Messages = m.Messages |> markDelivered senderPubkey ackIds }
288+ | IncomingProfile(senderPubkey, displayName, bio, photo) ->
289+ { m with
290+ Contacts =
291+ m.Contacts
292+ |> List.map (fun c ->
293+ if c.Pubkey = senderPubkey then
294+ { c with DisplayName = displayName; Bio = bio; PhotoBase64 = photo |> Option.defaultValue null }
295+ else c) })
263 { model with PollStatus = status; PollCursor = newCursor }
296 { model with PollStatus = status; PollCursor = newCursor }
264
297
265 model',
298 model',
@@ -273,7 +306,12 @@ module App =
273 | AddContact(cpk, cnn) when cpk <> "" && cnn <> "" ->
306 | AddContact(cpk, cnn) when cpk <> "" && cnn <> "" ->
274 match tryParsePubkey cpk with
307 match tryParsePubkey cpk with
275 | Some bytes ->
308 | Some bytes ->
276− let contact: Contact = { Pubkey = Crypto.toHex bytes; Nickname = cnn }
309+ let hex = Crypto.toHex bytes
310+ let existing = model.Contacts |> List.tryFind (fun c -> c.Pubkey = hex)
311+ let contact: Contact =
312+ match existing with
313+ | Some e -> { e with Nickname = cnn }
314+ | None -> { Pubkey = hex; Nickname = cnn; DisplayName = null; Bio = null; PhotoBase64 = null }
277
315
278 let model' =
316 let model' =
279 { model with
317 { model with
@@ -291,7 +329,37 @@ module App =
291
329
292 | DismissError -> { model with Error = None }, []
330 | DismissError -> { model with Error = None }, []
293
331
332+ | SetProfileDisplayName name ->
333+ match model.Page with
334+ | EditProfile(_, bio, photo) -> { model with Page = EditProfile(name, bio, photo) }, []
335+ | _ -> model, []
336+
337+ | SetProfileBio bio ->
338+ match model.Page with
339+ | EditProfile(name, _, photo) -> { model with Page = EditProfile(name, bio, photo) }, []
340+ | _ -> model, []
341+
342+ | DoPickPhoto -> model, [ CmdPickPhoto ]
343+
344+ | PhotoPicked photo ->
345+ match model.Page with
346+ | EditProfile(name, bio, _) -> { model with Page = EditProfile(name, bio, photo) }, []
347+ | _ -> model, []
348+
349+ | DoSaveProfile ->
350+ match model.Page with
351+ | EditProfile(name, bio, photo) ->
352+ let profile: Profile = { DisplayName = name; Bio = bio; PhotoBase64 = photo }
353+ let cmds = [ CmdSaveProfile profile ]
354+ let cmds =
355+ match trySession model with
356+ | Some session ->
357+ cmds @ [ CmdSendProfileToAll(session, profile, model.Contacts |> List.map _.Pubkey) ]
358+ | None -> cmds
359+ { model with Profile = Some profile; Page = Settings }, cmds
360+ | _ -> model, []
361+
294− | StateLoaded(IdentityAndData(identity, data)) ->
362+ | StateLoaded(IdentityAndData(identity, data, profile)) ->
295 let model' =
363 let model' =
296 { model with
364 { model with
297 Auth = Identified(identity, Connecting)
365 Auth = Identified(identity, Connecting)
@@ -299,10 +367,11 @@ module App =
299 Messages = data.Messages
367 Messages = data.Messages
300 ServerUrl = data.ServerUrl |> Option.defaultValue model.ServerUrl
368 ServerUrl = data.ServerUrl |> Option.defaultValue model.ServerUrl
301 PollCursor = data.PollCursor
369 PollCursor = data.PollCursor
370+ Profile = profile
302 Page = Conversations }
371 Page = Conversations }
303 model', [ CmdConnect(model'.ServerUrl, identity) ]
372 model', [ CmdConnect(model'.ServerUrl, identity) ]
304− | StateLoaded(IdentityOnly identity) ->
373+ | StateLoaded(IdentityOnly(identity, profile)) ->
305− { model with Auth = Identified(identity, Offline); Page = Settings }, []
374+ { model with Auth = Identified(identity, Offline); Profile = profile; Page = Settings }, []
306 | StateLoaded NothingSaved -> model, []
375 | StateLoaded NothingSaved -> model, []
307
376
308 // ── mapCmd ──
377 // ── mapCmd ──
@@ -318,12 +387,15 @@ module App =
318 type private Envelope =
387 type private Envelope =
319 | TextMessage of id: string * body: string
388 | TextMessage of id: string * body: string
320 | DeliveryAck of id: string * ackIds: string list
389 | DeliveryAck of id: string * ackIds: string list
390+ | ProfileMessage of id: string * displayName: string * bio: string * photo: string option
321
391
322 let private serializeEnvelope = function
392 let private serializeEnvelope = function
323 | TextMessage(id, body) ->
393 | TextMessage(id, body) ->
324 JsonSerializer.Serialize({| ``type`` = "text"; id = id; body = body |})
394 JsonSerializer.Serialize({| ``type`` = "text"; id = id; body = body |})
325 | DeliveryAck(id, ackIds) ->
395 | DeliveryAck(id, ackIds) ->
326 JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = id; ack_ids = ackIds |})
396 JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = id; ack_ids = ackIds |})
397+ | ProfileMessage(id, displayName, bio, photo) ->
398+ JsonSerializer.Serialize({| ``type`` = "profile"; id = id; timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = displayName; bio = bio; photo = (photo |> Option.defaultValue null) |})
327
399
328 let private parseEnvelope (json: string) =
400 let private parseEnvelope (json: string) =
329 use doc = JsonDocument.Parse(json)
401 use doc = JsonDocument.Parse(json)
@@ -334,6 +406,17 @@ module App =
334 | "delivery.ack" ->
406 | "delivery.ack" ->
335 let ackIds = root.GetProperty("ack_ids").EnumerateArray() |> Seq.map _.GetString() |> Seq.toList
407 let ackIds = root.GetProperty("ack_ids").EnumerateArray() |> Seq.map _.GetString() |> Seq.toList
336 Some(DeliveryAck(root.GetProperty("id").GetString(), ackIds))
408 Some(DeliveryAck(root.GetProperty("id").GetString(), ackIds))
409+ | "profile" ->
410+ let displayName = root.GetProperty("display_name").GetString()
411+ let bio =
412+ match root.TryGetProperty("bio") with
413+ | true, el when el.ValueKind <> JsonValueKind.Null -> el.GetString()
414+ | _ -> ""
415+ let photo =
416+ match root.TryGetProperty("photo") with
417+ | true, el when el.ValueKind <> JsonValueKind.Null -> Some(el.GetString())
418+ | _ -> None
419+ Some(ProfileMessage(root.GetProperty("id").GetString(), displayName, bio, photo))
337 | _ -> None
420 | _ -> None
338
421
339 let private decryptEvent (privKey: byte[]) (payload: EventPayload) =
422 let private decryptEvent (privKey: byte[]) (payload: EventPayload) =
@@ -353,6 +436,8 @@ module App =
353 Status = DeliveryStatus.Delivered } })
436 Status = DeliveryStatus.Delivered } })
354 | Some(DeliveryAck(_, ackIds)) ->
437 | Some(DeliveryAck(_, ackIds)) ->
355 Ok(IncomingDeliveryAck(senderHex, ackIds))
438 Ok(IncomingDeliveryAck(senderHex, ackIds))
439+ | Some(ProfileMessage(_, displayName, bio, photo)) ->
440+ Ok(IncomingProfile(senderHex, displayName, bio, photo))
356 | None -> Error "unknown envelope type"
441 | None -> Error "unknown envelope type"
357 | None -> Error "decrypt failed"
442 | None -> Error "decrypt failed"
358 with ex ->
443 with ex ->
@@ -445,10 +530,11 @@ module App =
445 asyncCmd (async {
530 asyncCmd (async {
446 match! Store.loadIdentity () with
531 match! Store.loadIdentity () with
447 | Some id ->
532 | Some id ->
533+ let profile = Store.loadProfile ()
448 return StateLoaded(
534 return StateLoaded(
449 match Store.loadData () with
535 match Store.loadData () with
450− | Some data -> IdentityAndData(id, data)
536+ | Some data -> IdentityAndData(id, data, profile)
451− | None -> IdentityOnly id)
537+ | None -> IdentityOnly(id, profile))
452 | None -> return StateLoaded NothingSaved
538 | None -> return StateLoaded NothingSaved
453 })
539 })
454
540
@@ -458,6 +544,36 @@ module App =
458 | CmdSaveData data ->
544 | CmdSaveData data ->
459 Cmd.ofEffect (fun _ -> Store.saveData data)
545 Cmd.ofEffect (fun _ -> Store.saveData data)
460
546
547+ | CmdPickPhoto ->
548+ asyncCmd (async {
549+ try
550+ let! results = Microsoft.Maui.Media.MediaPicker.Default.PickPhotosAsync() |> Async.AwaitTask
551+ let file = results |> Seq.tryHead
552+ match file with
553+ | None -> return PhotoPicked None
554+ | Some file ->
555+ use! stream = file.OpenReadAsync() |> Async.AwaitTask
556+ use ms = new MemoryStream()
557+ do! stream.CopyToAsync(ms) |> Async.AwaitTask
558+ return PhotoPicked(Some(Convert.ToBase64String(ms.ToArray())))
559+ with _ ->
560+ return PhotoPicked None
561+ })
562+
563+ | CmdSaveProfile profile ->
564+ Cmd.ofEffect (fun _ -> Store.saveProfile profile)
565+
566+ | CmdSendProfileToAll(session, profile, recipientHexes) ->
567+ Cmd.ofEffect (fun _ ->
568+ async {
569+ for recipientHex in recipientHexes do
570+ try
571+ let payload = serializeEnvelope (ProfileMessage(Guid.NewGuid().ToString(), profile.DisplayName, profile.Bio, profile.PhotoBase64))
572+ let blob = Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex recipientHex) payload
573+ do! sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) (DateTimeOffset.UtcNow.ToUnixTimeSeconds()) |> Async.Ignore
574+ with _ -> ()
575+ } |> Async.Start)
576+
461 // ── View ──
577 // ── View ──
462
578
463 let private formatPollStatus = function
579 let private formatPollStatus = function
@@ -512,6 +628,21 @@ module App =
512
628
513 Button("Copy Public Key", CopyPubKey)
629 Button("Copy Public Key", CopyPubKey)
514
630
631+ Label("Profile:").font(size = 18.)
632+ match model.Profile with
633+ | Some profile when not (String.IsNullOrEmpty profile.DisplayName) ->
634+ Label($"Name: {profile.DisplayName}").font(size = 14.)
635+ | _ -> ()
636+ match model.Profile with
637+ | Some profile when not (String.IsNullOrEmpty profile.Bio) ->
638+ Label($"Bio: {profile.Bio}").font(size = 14.).textColor(Colors.DimGray)
639+ | _ -> ()
640+ let profilePage =
641+ match model.Profile with
642+ | Some p -> EditProfile(p.DisplayName, p.Bio, p.PhotoBase64)
643+ | None -> EditProfile("", "", None)
644+ Button("Edit Profile", SetPage profilePage)
645+
515 Label("Server:")
646 Label("Server:")
516
647
517 match conn with
648 match conn with
@@ -630,6 +761,45 @@ module App =
630 .padding(20.)
761 .padding(20.)
631 )
762 )
632
763
764+ let private viewEditProfile model displayName bio photo =
765+ ContentPage(
766+ ScrollView(
767+ (VStack(spacing = 16.) {
768+ HStack(spacing = 8.) {
769+ Button("< Back", SetPage Settings)
770+ Label("Edit Profile").font(size = 20.)
771+ }
772+
773+ viewErrorBanner model.Error
774+
775+ match photo with
776+ | Some p when not (String.IsNullOrEmpty p) ->
777+ Image(new MemoryStream(Convert.FromBase64String(p)) :> Stream)
778+ .width(120.)
779+ .height(120.)
780+ .centerHorizontal()
781+ | _ ->
782+ Label("No Photo")
783+ .font(size = 16.)
784+ .centerTextHorizontal()
785+ .textColor(Colors.Gray)
786+
787+ Button("Change Photo", DoPickPhoto).centerHorizontal()
788+
789+ Label("Display Name:")
790+ Entry(displayName, SetProfileDisplayName)
791+ .placeholder("Your name")
792+
793+ Label("Bio:")
794+ Entry(bio, SetProfileBio)
795+ .placeholder("Tell something about yourself")
796+
797+ Button("Save Profile", DoSaveProfile).centerHorizontal()
798+ })
799+ .padding(20.)
800+ )
801+ )
802+
633 let view model =
803 let view model =
634 let page =
804 let page =
635 match model.Page with
805 match model.Page with
@@ -638,6 +808,7 @@ module App =
638 | Conversations -> viewConversations model
808 | Conversations -> viewConversations model
639 | Chat(pk, compose) -> viewChat model pk compose
809 | Chat(pk, compose) -> viewChat model pk compose
640 | AddContact(pk, nn) -> viewAddContact model pk nn
810 | AddContact(pk, nn) -> viewAddContact model pk nn
811+ | EditProfile(displayName, bio, photo) -> viewEditProfile model displayName bio photo
641
812
642 Application() { Window(page) }
813 Application() { Window(page) }
643
814
client/Store.fs+38−1
@@ -10,7 +10,15 @@ module Store =
10 [<CLIMutable>]
10 [<CLIMutable>]
11 type Contact =
11 type Contact =
12 { [<BsonId>] Pubkey: string
12 { [<BsonId>] Pubkey: string
13− Nickname: string }
13+ Nickname: string
14+ DisplayName: string
15+ Bio: string
16+ PhotoBase64: string }
17+
18+ type Profile =
19+ { DisplayName: string
20+ Bio: string
21+ PhotoBase64: string option }
14
22
15 [<RequireQualifiedAccess>]
23 [<RequireQualifiedAccess>]
16 type DeliveryStatus = Sent | Delivered
24 type DeliveryStatus = Sent | Delivered
@@ -43,6 +51,13 @@ module Store =
43 ServerUrl: string
51 ServerUrl: string
44 PollCursor: int64 }
52 PollCursor: int64 }
45
53
54+ [<CLIMutable>]
55+ type private ProfileDoc =
56+ { [<BsonId>] Id: string
57+ DisplayName: string
58+ Bio: string
59+ PhotoBase64: string }
60+
46 let private toChatMessage (d: MessageDoc) : ChatMessage =
61 let private toChatMessage (d: MessageDoc) : ChatMessage =
47 { Id = d.Id; Body = d.Body; Timestamp = DateTimeOffset.FromUnixTimeSeconds d.TimestampUnix; IsOutgoing = d.IsOutgoing
62 { Id = d.Id; Body = d.Body; Timestamp = DateTimeOffset.FromUnixTimeSeconds d.TimestampUnix; IsOutgoing = d.IsOutgoing
48 Status = match d.Status with 0 -> DeliveryStatus.Sent | 1 -> DeliveryStatus.Delivered | n -> failwith $"Unknown delivery status: {n}" }
63 Status = match d.Status with 0 -> DeliveryStatus.Sent | 1 -> DeliveryStatus.Delivered | n -> failwith $"Unknown delivery status: {n}" }
@@ -70,6 +85,28 @@ module Store =
70 SecureStorage.Default.SetAsync("identity_privkey", Convert.ToBase64String identity.PrivKey)
85 SecureStorage.Default.SetAsync("identity_privkey", Convert.ToBase64String identity.PrivKey)
71 |> Async.AwaitTask
86 |> Async.AwaitTask
72
87
88+ let loadProfile () : Profile option =
89+ try
90+ use db = openDb ()
91+ db.GetCollection<ProfileDoc>("profile").FindById(BsonValue "me")
92+ |> Option.ofObj
93+ |> Option.map (fun p ->
94+ { DisplayName = p.DisplayName |> Option.ofObj |> Option.defaultValue ""
95+ Bio = p.Bio |> Option.ofObj |> Option.defaultValue ""
96+ PhotoBase64 = p.PhotoBase64 |> Option.ofObj })
97+ with _ -> None
98+
99+ let saveProfile (profile: Profile) =
100+ try
101+ use db = openDb ()
102+ db.GetCollection<ProfileDoc>("profile").Upsert
103+ { Id = "me"
104+ DisplayName = profile.DisplayName
105+ Bio = profile.Bio
106+ PhotoBase64 = profile.PhotoBase64 |> Option.defaultValue null }
107+ |> ignore
108+ with _ -> ()
109+
73 let loadData () : Data option =
110 let loadData () : Data option =
74 try
111 try
75 use db = openDb ()
112 use db = openDb ()
client/bin/Debug/net10.0-ios/iossimulator-arm64/Skrepka.app/Skrepka.dll

Binary file not shown.

client/bin/Debug/net10.0-ios/iossimulator-arm64/Skrepka.app/Skrepka.pdb

Binary file not shown.

client/bin/Debug/net10.0-ios/iossimulator-arm64/Skrepka.app/_CodeSignature/CodeResources+4−4
@@ -166,11 +166,11 @@
166 </data>
166 </data>
167 <key>Skrepka.dll</key>
167 <key>Skrepka.dll</key>
168 <data>
168 <data>
169− ZSBquSe7af7XpQvv6oqXWEK9H74=
169+ u3/Jli23brn1acnURBDMHQ032EY=
170 </data>
170 </data>
171 <key>Skrepka.pdb</key>
171 <key>Skrepka.pdb</key>
172 <data>
172 <data>
173− VivAVxtEMi2FHBPFF09uQi1418U=
173+ m9G0IzQJO1xJObAyLl6iRTGfI4Q=
174 </data>
174 </data>
175 <key>Sodium.Core.dll</key>
175 <key>Sodium.Core.dll</key>
176 <data>
176 <data>
@@ -1393,14 +1393,14 @@
1393 <dict>
1393 <dict>
1394 <key>hash2</key>
1394 <key>hash2</key>
1395 <data>
1395 <data>
1396− Bd6/5/MU6L0SMz/GVfv2R6VSAXUbiQJI32j7+lnsJ4w=
1396+ N4S21qMsbcdZoPSka8wm/OYfeytcN6be2i+NeNshbkM=
1397 </data>
1397 </data>
1398 </dict>
1398 </dict>
1399 <key>Skrepka.pdb</key>
1399 <key>Skrepka.pdb</key>
1400 <dict>
1400 <dict>
1401 <key>hash2</key>
1401 <key>hash2</key>
1402 <data>
1402 <data>
1403− YuSpnbETdRksRCmKP9GMRFzwQi1n0Oc1JqlXdMOZiyE=
1403+ CZBydqM3QuDS2CPbFfJRWp0ybjMZr2cKEF/e4NllpY4=
1404 </data>
1404 </data>
1405 </dict>
1405 </dict>
1406 <key>Sodium.Core.dll</key>
1406 <key>Sodium.Core.dll</key>
client/bin/Debug/net10.0-ios/iossimulator-arm64/Skrepka.dll

Binary file not shown.

client/bin/Debug/net10.0-ios/iossimulator-arm64/Skrepka.pdb

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.app/Contents/MonoBundle/Skrepka.dll

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.app/Contents/MonoBundle/Skrepka.pdb

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.app/Contents/_CodeSignature/CodeResources+2−2
@@ -251,14 +251,14 @@
251 <dict>
251 <dict>
252 <key>hash2</key>
252 <key>hash2</key>
253 <data>
253 <data>
254− F2ovogGs5gdnmuhl7I35TXBYBHvkWSc5l3Eb3dz5/Eo=
254+ bun2DyiQNygihIIRw+/9Fz9gKTvkJ8OKN160J0nU8T4=
255 </data>
255 </data>
256 </dict>
256 </dict>
257 <key>MonoBundle/Skrepka.pdb</key>
257 <key>MonoBundle/Skrepka.pdb</key>
258 <dict>
258 <dict>
259 <key>hash2</key>
259 <key>hash2</key>
260 <data>
260 <data>
261− LL4NPXSPKwyqo6TCZ4Xmt3aHdsBLcNeTGcuqqNI6GIA=
261+ o5yVSDk2KiZkgGHYl08aary/xPSlP2KvgKUPeV1GPE0=
262 </data>
262 </data>
263 </dict>
263 </dict>
264 <key>MonoBundle/Sodium.Core.dll</key>
264 <key>MonoBundle/Sodium.Core.dll</key>
client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.dll

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.pdb

Binary file not shown.

client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.AssemblyInfo.fs+1−1
@@ -10,7 +10,7 @@ open System.Reflection
10[<assembly: System.Reflection.AssemblyCompanyAttribute("Skrepka")>]
10[<assembly: System.Reflection.AssemblyCompanyAttribute("Skrepka")>]
11[<assembly: System.Reflection.AssemblyConfigurationAttribute("Debug")>]
11[<assembly: System.Reflection.AssemblyConfigurationAttribute("Debug")>]
12[<assembly: System.Reflection.AssemblyFileVersionAttribute("1.0.0.0")>]
12[<assembly: System.Reflection.AssemblyFileVersionAttribute("1.0.0.0")>]
13−[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+57cf03bb5cc8c778e01a2c8e1a8da7ec32e919da")>]
13+[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+fec9263421fbac32ef5f434448cbad4cca707ffa")>]
14[<assembly: System.Reflection.AssemblyProductAttribute("Skrepka")>]
14[<assembly: System.Reflection.AssemblyProductAttribute("Skrepka")>]
15[<assembly: System.Reflection.AssemblyTitleAttribute("Skrepka")>]
15[<assembly: System.Reflection.AssemblyTitleAttribute("Skrepka")>]
16[<assembly: System.Reflection.AssemblyVersionAttribute("1.0.0.0")>]
16[<assembly: System.Reflection.AssemblyVersionAttribute("1.0.0.0")>]
client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.AssemblyInfoInputs.cache+1−1
@@ -1 +1 @@
1−07f51a22ce67924703904ac63354f57452f4a0f68bfe8fef4528a96892e114a1
1+14d65e38515f6fe609282787e3a83911d7f49a251ce309da041cf4a647d7c78c
client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.fsproj.FileListAbsolute.txt−23
@@ -334,26 +334,3 @@
334/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.genruntimeconfig.cache
334/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.genruntimeconfig.cache
335/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/ref/Skrepka.dll
335/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/ref/Skrepka.dll
336/Users/iko/Developer/skrepka/client/bin/Debug/net10.0-ios/iossimulator-arm64/LiteDB.dll
336/Users/iko/Developer/skrepka/client/bin/Debug/net10.0-ios/iossimulator-arm64/LiteDB.dll
337−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Fabulous.stamp
338−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Fabulous.MauiControls.stamp
339−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/FSharp.Core.stamp
340−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/LiteDB.stamp
341−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Configuration.Abstractions.stamp
342−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Configuration.stamp
343−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.DependencyInjection.Abstractions.stamp
344−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.DependencyInjection.stamp
345−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Diagnostics.Abstractions.stamp
346−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.FileProviders.Abstractions.stamp
347−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Hosting.Abstractions.stamp
348−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Logging.Abstractions.stamp
349−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Logging.stamp
350−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Options.stamp
351−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Extensions.Primitives.stamp
352−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Maui.Controls.Compatibility.stamp
353−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Maui.Controls.stamp
354−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Maui.Controls.Xaml.stamp
355−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Maui.stamp
356−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Maui.Essentials.stamp
357−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Microsoft.Maui.Graphics.stamp
358−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/resourcestamps/Sodium.Core.stamp
359−/Users/iko/Developer/skrepka/client/obj/Debug/net10.0-ios/iossimulator-arm64/unpack/Microsoft.Maui.Essentials/BundleResource/xml/microsoft_maui_essentials_fileprovider_file_paths.xml
client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.pdb

Binary file not shown.

client/obj/Debug/net10.0-ios/iossimulator-arm64/Skrepka.sourcelink.json+1−1
@@ -1 +1 @@
1−{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/57cf03bb5cc8c778e01a2c8e1a8da7ec32e919da/*"}}
1+{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/fec9263421fbac32ef5f434448cbad4cca707ffa/*"}}
client/obj/Debug/net10.0-ios/iossimulator-arm64/ref/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-ios/iossimulator-arm64/refint/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfo.fs+1−1
@@ -10,7 +10,7 @@ open System.Reflection
10[<assembly: System.Reflection.AssemblyCompanyAttribute("Skrepka")>]
10[<assembly: System.Reflection.AssemblyCompanyAttribute("Skrepka")>]
11[<assembly: System.Reflection.AssemblyConfigurationAttribute("Debug")>]
11[<assembly: System.Reflection.AssemblyConfigurationAttribute("Debug")>]
12[<assembly: System.Reflection.AssemblyFileVersionAttribute("1.0.0.0")>]
12[<assembly: System.Reflection.AssemblyFileVersionAttribute("1.0.0.0")>]
13−[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+57cf03bb5cc8c778e01a2c8e1a8da7ec32e919da")>]
13+[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+fec9263421fbac32ef5f434448cbad4cca707ffa")>]
14[<assembly: System.Reflection.AssemblyProductAttribute("Skrepka")>]
14[<assembly: System.Reflection.AssemblyProductAttribute("Skrepka")>]
15[<assembly: System.Reflection.AssemblyTitleAttribute("Skrepka")>]
15[<assembly: System.Reflection.AssemblyTitleAttribute("Skrepka")>]
16[<assembly: System.Reflection.AssemblyVersionAttribute("1.0.0.0")>]
16[<assembly: System.Reflection.AssemblyVersionAttribute("1.0.0.0")>]
client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfoInputs.cache+1−1
@@ -1 +1 @@
1−034a8eb90add363ed97907a65fdd8257ea50d7e41bd6c1fea1e566215afb5a16
1+ffbafc0ee7b3b70864bc0f4e57e320aaf92479c321cb705524064b7744b15e7c
client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.pdb

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.sourcelink.json+1−1
@@ -1 +1 @@
1−{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/57cf03bb5cc8c778e01a2c8e1a8da7ec32e919da/*"}}
1+{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/fec9263421fbac32ef5f434448cbad4cca707ffa/*"}}
client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/ref/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/refint/Skrepka.dll

Binary file not shown.

server.knot+48−49
@@ -67,20 +67,21 @@ impl FromJSON GossipEventType where
67
67
68isGossipOnline = \et -> case et of GossipOnline {} -> True {}; _ -> False {}
68isGossipOnline = \et -> case et of GossipOnline {} -> True {}; _ -> False {}
69isGossipOffline = \et -> case et of GossipOffline {} -> True {}; _ -> False {}
69isGossipOffline = \et -> case et of GossipOffline {} -> True {}; _ -> False {}
70+isGossipUnknown = \et -> case et of GossipUnknown {} -> True {}; _ -> False {}
70
71
71type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}
72type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}
72
73
73type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
74type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
74
75
75−type MessageStatus = MsUnauthorized {} | MsRejected {} | MsDelivered {} | MsFederated {} | MsQueued {}
76+type MessageStatus = MsDelivered {} | MsFederated {} | MsQueued {}
77+
78+messageStatusText = \ms -> case ms of
79+ MsDelivered {} -> "delivered"
80+ MsFederated {} -> "federated"
81+ MsQueued {} -> "queued"
76
82
77impl ToJSON MessageStatus where
83impl ToJSON MessageStatus where
78− toJson ms = toJson (case ms of
84+ toJson ms = toJson (messageStatusText ms)
79− MsUnauthorized {} -> "unauthorized"
80− MsRejected {} -> "rejected"
81− MsDelivered {} -> "delivered"
82− MsFederated {} -> "federated"
83− MsQueued {} -> "queued")
84
85
85type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
86type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
86type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
87type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
@@ -90,14 +91,14 @@ type MessageIdHex = Text where isValidMessageId
90type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
91type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
91isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
92isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
92type ServerName = Text where isValidServerName
93type ServerName = Text where isValidServerName
93−type OptionalServerName = Text where \s -> s == "" || isValidServerName s
94+type MessageOrigin = LocalOrigin {} | FederatedOrigin {server: ServerName}
94type AnyServerName = Text where \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s
95type AnyServerName = Text where \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s
95
96
96type Timestamp = Int<Ms>
97type Timestamp = Int<Ms>
97
98
98type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp}
99type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp}
99type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp}
100type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp}
100−type Message = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: OptionalServerName, receivedAt: Timestamp}
101+type Message = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, origin: MessageOrigin, receivedAt: Timestamp}
101type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}
102type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}
102type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
103type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
103type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
104type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
@@ -149,13 +150,13 @@ route ClientApi where
149 = Poll
150 = Poll
150 /messages
151 /messages
151 POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp} / headers {authorization: Text}
152 POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp} / headers {authorization: Text}
152− -> {status: MessageStatus, messageId: OptionalMessageId}
153+ -> {status: Text, messageId: OptionalMessageId}
153 = SendMessage
154 = SendMessage
154 POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}
155 POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}
155 -> {ok: Bool}
156 -> {ok: Bool}
156 = AckMessages
157 = AckMessages
157 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}
158 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}
158− -> {online: Bool, server: AnyServerName, authorized: Bool}
159+ -> {server: AnyServerName, authorized: Bool}
159 = LookupPresence
160 = LookupPresence
160
161
161route FederationApi where
162route FederationApi where
@@ -385,7 +386,8 @@ clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp
385
386
386nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
387nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
387
388
388−isFederatedOrigin = \originServer -> originServer != "" && originServer != serverHostN
389+isFederatedOrigin = \origin -> case origin of FederatedOrigin _ -> True {}; _ -> False {}
390+originServerName = \origin -> case origin of FederatedOrigin {server} -> server; LocalOrigin {} -> ""
389
391
390takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items
392takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items
391
393
@@ -493,19 +495,19 @@ removeOffline = \presenceSet trustedOffline t ->
493 where samePubkeyServer p o && min o.timestamp t > p.timestamp
495 where samePubkeyServer p o && min o.timestamp t > p.timestamp
494 yield p)
496 yield p)
495
497
496−capGossipPresence = \afterOffline appliedOnline trustedDeduped presence trustedOffline t ->
498+capGossipPresence = \args ->
497− if count afterOffline <= maxPresenceEntries
499+ if count args.afterOffline <= maxPresenceEntries
498− then {finalPresence: afterOffline, appliedOnline: appliedOnline, withinCapacity: True {}}
500+ then {finalPresence: args.afterOffline, appliedOnline: args.appliedOnline, withinCapacity: True {}}
499 else
501 else
500− let updatesOnly = do e <- trustedDeduped; where any presence (\p -> samePubkeyServer p e); yield e in
502+ let updatesOnly = do e <- args.trustedDeduped; where any args.presence (\p -> samePubkeyServer p e); yield e in
501− let updatesOnlyMerged = mergeByPubkeyServer presence updatesOnly in
503+ let updatesOnlyMerged = mergeByPubkeyServer args.presence updatesOnly in
502− let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged trustedOffline t in
504+ let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged args.trustedOffline args.t in
503 let reclaimSlots = maxPresenceEntries - count updatesOnlyAfterOffline in
505 let reclaimSlots = maxPresenceEntries - count updatesOnlyAfterOffline in
504− let newEntries = do e <- trustedDeduped; where none presence (\p -> samePubkeyServer p e); yield e in
506+ let newEntries = do e <- args.trustedDeduped; where none args.presence (\p -> samePubkeyServer p e); yield e in
505 let reclaimedEntries = takeN newEntries reclaimSlots in
507 let reclaimedEntries = takeN newEntries reclaimSlots in
506 {finalPresence: union updatesOnlyAfterOffline reclaimedEntries,
508 {finalPresence: union updatesOnlyAfterOffline reclaimedEntries,
507 appliedOnline: union
509 appliedOnline: union
508− (do e <- updatesOnly; where none presence (\p -> samePubkeyServer p e && p.expiresAt >= e.expiresAt); yield (pubkeyServer e))
510+ (do e <- updatesOnly; where none args.presence (\p -> samePubkeyServer p e && p.expiresAt >= e.expiresAt); yield (pubkeyServer e))
509 (do e <- reclaimedEntries; yield (pubkeyServer e)),
511 (do e <- reclaimedEntries; yield (pubkeyServer e)),
510 withinCapacity: False {}}
512 withinCapacity: False {}}
511
513
@@ -516,6 +518,7 @@ countMessagesFor = \messages toKey t ->
516validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
518validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
517validGossipEvents = \events t -> do
519validGossipEvents = \events t -> do
518 e <- events
520 e <- events
521+ where not (isGossipUnknown e.eventType)
519 where e.server != serverHostN && e.timestamp <= t + clockSkewTolerance
522 where e.server != serverHostN && e.timestamp <= t + clockSkewTolerance
520 let ttl = clampTtl e.ttl
523 let ttl = clampTtl e.ttl
521 let expiresAt = e.timestamp + ttl * 1000
524 let expiresAt = e.timestamp + ttl * 1000
@@ -608,6 +611,10 @@ broadcastOfflineGossip = \t peerServers expiredLocal ->
608forkBroadcastOffline = \t result ->
611forkBroadcastOffline = \t result ->
609 fork (broadcastOfflineGossip t result.peerServers result.expiredLocal)
612 fork (broadcastOfflineGossip t result.peerServers result.expiredLocal)
610
613
614+rejectFederation = \t respond -> do
615+ maybePruneAndBroadcast t
616+ yield (respond {ok: False {}})
617+
611maybePruneAndBroadcast = \t -> do
618maybePruneAndBroadcast = \t -> do
612 pruneResult <- atomic do maybePrune t
619 pruneResult <- atomic do maybePrune t
613 forkBroadcastOffline t pruneResult
620 forkBroadcastOffline t pruneResult
@@ -693,7 +700,7 @@ pruneAndRetry = \t -> do
693 pr <- pruneExpired t
700 pr <- pruneExpired t
694 forwards <- *forwards
701 forwards <- *forwards
695 ackedIds <- *ackedIds
702 ackedIds <- *ackedIds
696− let pendingAcks = do a <- ackedIds; where isFederatedOrigin a.originServer; yield a
703+ let pendingAcks = do a <- ackedIds; where a.originServer != serverHostN; yield a
697 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: forwards, pendingAcks: pendingAcks}
704 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: forwards, pendingAcks: pendingAcks}
698 broadcastOfflineGossip t result.peerServers result.expiredLocal
705 broadcastOfflineGossip t result.peerServers result.expiredLocal
699 when federationEnabled (do
706 when federationEnabled (do
@@ -835,7 +842,7 @@ serve = \req -> case req of
835 set *seqCounter = seqTs
842 set *seqCounter = seqTs
836 set *messages = union messages
843 set *messages = union messages
837 [{messageId: msgId, toKey: to, fromKey: fromKey,
844 [{messageId: msgId, toKey: to, fromKey: fromKey,
838− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
845+ encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: LocalOrigin {}, receivedAt: seqTs}]
839 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p
846 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p
840 let localOnline = any toPresence (\p -> p.server == serverHostN)
847 let localOnline = any toPresence (\p -> p.server == serverHostN)
841 let remoteServers = do p <- toPresence; where p.server != serverHostN; yield p.server
848 let remoteServers = do p <- toPresence; where p.server != serverHostN; yield p.server
@@ -865,9 +872,9 @@ serve = \req -> case req of
865 _ -> yield {}
872 _ -> yield {}
866 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
873 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
867 yield (case result.send of
874 yield (case result.send of
868− SendUnauthorized {} -> respond {status: MsUnauthorized {}, messageId: ""}
875+ SendUnauthorized {} -> respond {status: "unauthorized", messageId: ""}
869− SendRejected {} -> respond {status: MsRejected {}, messageId: ""}
876+ SendRejected {} -> respond {status: "rejected", messageId: ""}
870− SendDone {status} -> respond {status: status, messageId: msgId})
877+ SendDone {status} -> respond {status: messageStatusText status, messageId: msgId})
871
878
872 AckMessages {messageIds, authorization, respond} -> do
879 AckMessages {messageIds, authorization, respond} -> do
873 t <- now
880 t <- now
@@ -887,26 +894,24 @@ serve = \req -> case req of
887 set *messages = diff messages ackedMessages
894 set *messages = diff messages ackedMessages
888 let ackedFederated = do
895 let ackedFederated = do
889 m <- ackedMessages
896 m <- ackedMessages
890− where isFederatedOrigin m.originServer
897+ where isFederatedOrigin m.origin
891− yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: m.originServer}
898+ yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: originServerName m.origin}
892 ackedIds <- *ackedIds
899 ackedIds <- *ackedIds
893 let combinedAckedIds = union ackedIds ackedFederated
900 let combinedAckedIds = union ackedIds ackedFederated
894 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
901 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
895 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
902 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
896 set *ackedIds = diff combinedAckedIds evictedEntries
903 set *ackedIds = diff combinedAckedIds evictedEntries
897 yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
904 yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
905+ fork (do
898− case result.ack of
906+ case result.ack of
899− AckDone {pendingAcks, evictedEntries} -> do
907+ AckDone {pendingAcks, evictedEntries} ->
900− fork (do
901 when federationEnabled (do
908 when federationEnabled (do
902 let originServers = collectPeerServers pendingAcks (\a -> a.originServer)
909 let originServers = collectPeerServers pendingAcks (\a -> a.originServer)
903 sendAcksAndClean pendingAcks originServers
910 sendAcksAndClean pendingAcks originServers
904 retryEvictedAcks evictedEntries pendingAcks)
911 retryEvictedAcks evictedEntries pendingAcks)
912+ _ -> yield {}
905− broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
913+ broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
906− yield (respond {ok: True {}})
914+ yield (respond {ok: case result.ack of AckDone _ -> True {}; _ -> False {}})
907− AckUnauthorized {} -> do
908− forkBroadcastOffline t result.pr
909− yield (respond {ok: False {}})
910
915
911 LookupPresence {pubkey, authorization, respond} -> do
916 LookupPresence {pubkey, authorization, respond} -> do
912 t <- now
917 t <- now
@@ -929,17 +934,15 @@ serve = \req -> case req of
929 yield {pr: pr, lookup: LookupDone {server: foundServer}}
934 yield {pr: pr, lookup: LookupDone {server: foundServer}}
930 forkBroadcastOffline t result.pr
935 forkBroadcastOffline t result.pr
931 yield (case result.lookup of
936 yield (case result.lookup of
932− LookupUnauthorized {} -> respond {online: False {}, server: "", authorized: False {}}
937+ LookupUnauthorized {} -> respond {server: "", authorized: False {}}
933− LookupDone {server} -> respond {online: server != "", server: server, authorized: True {}})
938+ LookupDone {server} -> respond {server: server, authorized: True {}})
934
939
935 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
940 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
936 t <- now
941 t <- now
937 let authorized = verifyFederationAuth authorization
942 let authorized = verifyFederationAuth authorization
938 let cappedHops = clamp 0 5 hopsRemaining
943 let cappedHops = clamp 0 5 hopsRemaining
939 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
944 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
940− then do
945+ then rejectFederation t respond
941− maybePruneAndBroadcast t
942− yield (respond {ok: False {}})
943 else do
946 else do
944 let allValidEntries = validGossipEvents events t
947 let allValidEntries = validGossipEvents events t
945 let onlineEntries = do e <- allValidEntries; where isGossipOnline e.eventType; yield e
948 let onlineEntries = do e <- allValidEntries; where isGossipOnline e.eventType; yield e
@@ -961,7 +964,7 @@ serve = \req -> case req of
961 let merged = mergeByPubkeyServer presence trustedDeduped
964 let merged = mergeByPubkeyServer presence trustedDeduped
962 let afterOffline = removeOffline merged trustedOffline t
965 let afterOffline = removeOffline merged trustedOffline t
963 let appliedOffline = do p <- diff merged afterOffline; yield (pubkeyServer p)
966 let appliedOffline = do p <- diff merged afterOffline; yield (pubkeyServer p)
964− let capResult = capGossipPresence afterOffline appliedOnline trustedDeduped presence trustedOffline t
967+ let capResult = capGossipPresence {afterOffline: afterOffline, appliedOnline: appliedOnline, trustedDeduped: trustedDeduped, presence: presence, trustedOffline: trustedOffline, t: t}
965 set *presence = capResult.finalPresence
968 set *presence = capResult.finalPresence
966 let gossipPeerServers = collectPeerServers capResult.finalPresence (\p -> p.server)
969 let gossipPeerServers = collectPeerServers capResult.finalPresence (\p -> p.server)
967 yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: capResult.withinCapacity}
970 yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: capResult.withinCapacity}
@@ -984,11 +987,9 @@ serve = \req -> case req of
984 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
987 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
985 t <- now
988 t <- now
986 let authorized = verifyFederationAuth authorization
989 let authorized = verifyFederationAuth authorization
987− let validOrigin = isFederatedOrigin originServer
990+ let validOrigin = originServer != serverHostN
988 if not authorized || not validOrigin
991 if not authorized || not validOrigin
989− then do
992+ then rejectFederation t respond
990− maybePruneAndBroadcast t
991− yield (respond {ok: False {}})
992 else do
993 else do
993 let clampedTs = clampTimestamp timestamp t
994 let clampedTs = clampTimestamp timestamp t
994 result <- atomic do
995 result <- atomic do
@@ -1006,7 +1007,7 @@ serve = \req -> case req of
1006 set *seqCounter = seqTs
1007 set *seqCounter = seqTs
1007 set *messages = union messages
1008 set *messages = union messages
1008 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
1009 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
1009− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]
1010+ encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: FederatedOrigin {server: originServer}, receivedAt: seqTs}]
1010 yield {pr: pr, forward: ForwardStored {}}
1011 yield {pr: pr, forward: ForwardStored {}}
1011 forkBroadcastOffline t result.pr
1012 forkBroadcastOffline t result.pr
1012 yield (respond {ok: case result.forward of ForwardFull {} -> False {}; _ -> True {}})
1013 yield (respond {ok: case result.forward of ForwardFull {} -> False {}; _ -> True {}})
@@ -1015,9 +1016,7 @@ serve = \req -> case req of
1015 t <- now
1016 t <- now
1016 let authorized = verifyFederationAuth authorization
1017 let authorized = verifyFederationAuth authorization
1017 if not authorized || originServer != serverHostN || fromServer == serverHostN
1018 if not authorized || originServer != serverHostN || fromServer == serverHostN
1018− then do
1019+ then rejectFederation t respond
1019− maybePruneAndBroadcast t
1020− yield (respond {ok: False {}})
1021 else do
1020 else do
1022 let dedupedIds = dedupMessageIds messageIds
1021 let dedupedIds = dedupMessageIds messageIds
1023 pruneResult <- atomic do
1022 pruneResult <- atomic do