@@ -37,9 +37,11 @@ module App =
37 | Identified of identity: Identity * conn: ConnStatus
37 | Identified of identity: Identity * conn: ConnStatus
39 type DecryptedEvent =
39 type DecryptedEvent =
40− | IncomingChat of senderPubkey: string * message: ChatMessage
40+ | ChatMsg of ChatMessage
41− | IncomingDeliveryAck of senderPubkey: string * ackIds: string list
41+ | DeliveryAck of ackIds: string list
42− | IncomingProfile of senderPubkey: string * profile: Profile
42+ | ProfileUpdate of Profile
44+ type IncomingEvent = { Sender: string; Event: DecryptedEvent }
44 type PollReceived = { Events: int; Messages: int; Errors: int; FirstError: string option }
46 type PollReceived = { Events: int; Messages: int; Errors: int; FirstError: string option }
@@ -83,7 +85,7 @@ module App =
83 | SendFailed of string
85 | SendFailed of string
85 | DoSaveContact
87 | DoSaveContact
86− | PollResult of events: DecryptedEvent list * status: PollStatus * cursor: int64
88+ | PollResult of events: IncomingEvent list * status: PollStatus * cursor: int64
87 | CopyPubKey
89 | CopyPubKey
88 | DismissError
90 | DismissError
89 | StateLoaded of StateLoadResult
91 | StateLoaded of StateLoadResult
@@ -130,13 +132,10 @@ module App =
131 let private contactName (contacts: Map<string, Contact>) (pk: string) =
133 let private contactName (contacts: Map<string, Contact>) (pk: string) =
132 let fallback = truncKey pk
134 let fallback = truncKey pk
134− |> Map.tryFind pk
135+ match Map.tryFind pk contacts with
135− |> Option.map (fun c ->
136− if c.Nickname <> fallback then c.Nickname
136+ | Some c when c.Nickname <> fallback -> c.Nickname
137− elif c.DisplayName <> "" then c.DisplayName
137+ | Some c when c.DisplayName <> "" -> c.DisplayName
139− |> Option.defaultValue fallback
138+ | _ -> fallback
141 let private messagesFor (pk: string) (messages: Map<string, ChatMessage list>) =
140 let private messagesFor (pk: string) (messages: Map<string, ChatMessage list>) =
142 messages |> Map.tryFind pk |> Option.defaultValue []
141 messages |> Map.tryFind pk |> Option.defaultValue []
@@ -157,17 +156,18 @@ module App =
157 let private withProfile (p: Profile) (c: Contact) =
156 let private withProfile (p: Profile) (c: Contact) =
158 { c with DisplayName = p.DisplayName; Bio = p.Bio; PhotoBase64 = p.PhotoBase64 }
157 { c with DisplayName = p.DisplayName; Bio = p.Bio; PhotoBase64 = p.PhotoBase64 }
160− let private applyEvent (m: Model) = function
159+ let private applyEvent (m: Model) (evt: IncomingEvent) =
161− | IncomingChat(senderPubkey, message) ->
160+ match evt.Event with
161+ | ChatMsg message ->
163 Contacts =
163 Contacts =
164− if Map.containsKey senderPubkey m.Contacts then m.Contacts
164+ if Map.containsKey evt.Sender m.Contacts then m.Contacts
165− else Map.add senderPubkey (newContact senderPubkey (truncKey senderPubkey)) m.Contacts
165+ else Map.add evt.Sender (newContact evt.Sender (truncKey evt.Sender)) m.Contacts
166− Messages = m.Messages |> appendMessage senderPubkey message }
166+ Messages = m.Messages |> appendMessage evt.Sender message }
167− | IncomingDeliveryAck(senderPubkey, ackIds) ->
167+ | DeliveryAck ackIds ->
168− { m with Messages = m.Messages |> markDelivered senderPubkey ackIds }
168+ { m with Messages = m.Messages |> markDelivered evt.Sender ackIds }
169− | IncomingProfile(senderPubkey, profile) ->
169+ | ProfileUpdate profile ->
170− { m with Contacts = m.Contacts |> Map.change senderPubkey (Option.map (withProfile profile)) }
170+ { m with Contacts = m.Contacts |> Map.change evt.Sender (Option.map (withProfile profile)) }
172 let private trySession model =
172 let private trySession model =
173 match model.Auth with
173 match model.Auth with
@@ -363,17 +363,18 @@ module App =
364 |> Async.Start)
364 |> Async.Start)
366+ [<RequireQualifiedAccess>]
366 type private Envelope =
367 type private Envelope =
367 | TextMessage of id: string * body: string
368 | TextMessage of id: string * body: string
368 | DeliveryAck of ackIds: string list
369 | DeliveryAck of ackIds: string list
369 | ProfileMessage of profile: Profile
370 | ProfileMessage of profile: Profile
371 let private serializeEnvelope = function
372 let private serializeEnvelope = function
372− | TextMessage(id, body) ->
373+ | Envelope.TextMessage(id, body) ->
373 JsonSerializer.Serialize({| ``type`` = "text"; id = id; body = body |})
374 JsonSerializer.Serialize({| ``type`` = "text"; id = id; body = body |})
374− | DeliveryAck ackIds ->
375+ | Envelope.DeliveryAck ackIds ->
375 JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = Guid.NewGuid().ToString(); ack_ids = ackIds |})
376 JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = Guid.NewGuid().ToString(); ack_ids = ackIds |})
376− | ProfileMessage profile ->
377+ | Envelope.ProfileMessage profile ->
377 JsonSerializer.Serialize({| ``type`` = "profile"; id = Guid.NewGuid().ToString(); timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = profile.DisplayName; bio = profile.Bio; photo = profile.PhotoBase64 |})
378 JsonSerializer.Serialize({| ``type`` = "profile"; id = Guid.NewGuid().ToString(); timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = profile.DisplayName; bio = profile.Bio; photo = profile.PhotoBase64 |})
379 let private sendEnvelope (session: Session) (recipientHex: string) (envelope: Envelope) =
380 let private sendEnvelope (session: Session) (recipientHex: string) (envelope: Envelope) =
@@ -394,49 +395,49 @@ module App =
394 let root = doc.RootElement
395 let root = doc.RootElement
395 match root.GetProperty("type").GetString() with
396 match root.GetProperty("type").GetString() with
396 | "text" ->
397 | "text" ->
397− Some(TextMessage(root.GetProperty("id").GetString(), root.GetProperty("body").GetString()))
398+ Some(Envelope.TextMessage(root.GetProperty("id").GetString(), root.GetProperty("body").GetString()))
398 | "delivery.ack" ->
399 | "delivery.ack" ->
399 let ackIds = root.GetProperty("ack_ids").EnumerateArray() |> Seq.map _.GetString() |> Seq.toList
400 let ackIds = root.GetProperty("ack_ids").EnumerateArray() |> Seq.map _.GetString() |> Seq.toList
400− Some(DeliveryAck ackIds)
401+ Some(Envelope.DeliveryAck ackIds)
401 | "profile" ->
402 | "profile" ->
402 let displayName = root.GetProperty("display_name").GetString()
403 let displayName = root.GetProperty("display_name").GetString()
403 let bio = tryGetJsonString root "bio" |> Option.defaultValue ""
404 let bio = tryGetJsonString root "bio" |> Option.defaultValue ""
404 let photo = tryGetJsonString root "photo" |> Option.defaultValue ""
405 let photo = tryGetJsonString root "photo" |> Option.defaultValue ""
405− Some(ProfileMessage { DisplayName = displayName; Bio = bio; PhotoBase64 = photo })
406+ Some(Envelope.ProfileMessage { DisplayName = displayName; Bio = bio; PhotoBase64 = photo })
406 | _ -> None
407 | _ -> None
409+ let private toDecryptedEvent timestamp = function
410+ | Envelope.TextMessage(id, body) ->
412+ { Id = id; Body = body
413+ Timestamp = DateTimeOffset.FromUnixTimeSeconds(timestamp)
415+ Status = DeliveryStatus.Delivered }
416+ | Envelope.DeliveryAck ackIds -> DeliveryAck ackIds
417+ | Envelope.ProfileMessage profile -> ProfileUpdate profile
408 let private decryptEvent (privKey: byte[]) (payload: EventPayload) =
419 let private decryptEvent (privKey: byte[]) (payload: EventPayload) =
410 let blob = Crypto.fromHex payload.EncryptedBlob
421 let blob = Crypto.fromHex payload.EncryptedBlob
412 match Crypto.decrypt privKey blob with
422 match Crypto.decrypt privKey blob with
413 | Some(plaintext, senderHex) ->
423 | Some(plaintext, senderHex) ->
414 match parseEnvelope plaintext with
424 match parseEnvelope plaintext with
415− | Some(TextMessage(id, body)) ->
425+ | Some envelope -> Ok { Sender = senderHex; Event = toDecryptedEvent payload.Timestamp envelope }
416− Ok(IncomingChat(senderHex,
417− { Id = id; Body = body
418− Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)
420− Status = DeliveryStatus.Delivered }))
421− | Some(DeliveryAck ackIds) ->
422− Ok(IncomingDeliveryAck(senderHex, ackIds))
423− | Some(ProfileMessage profile) ->
424− Ok(IncomingProfile(senderHex, profile))
425 | None -> Error "unknown envelope type"
426 | None -> Error "unknown envelope type"
426 | None -> Error "decrypt failed"
427 | None -> Error "decrypt failed"
427 with ex ->
428 with ex ->
428 Error $"parse: {ex.Message}"
429 Error $"parse: {ex.Message}"
430− let private sendDeliveryAcks (session: Session) (events: DecryptedEvent list) =
431+ let private sendDeliveryAcks (session: Session) (events: IncomingEvent list) =
432 let chatsBySender =
433 let chatsBySender =
434− |> List.choose (function IncomingChat(senderPubkey, msg) -> Some(senderPubkey, msg.Id) | _ -> None)
435+ |> List.choose (fun evt -> match evt.Event with ChatMsg msg -> Some(evt.Sender, msg.Id) | _ -> None)
435 |> List.groupBy fst
436 |> List.groupBy fst
436 |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)
437 |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)
438 for sender, msgIds in chatsBySender do
439 for sender, msgIds in chatsBySender do
439− try do! sendEnvelope session sender (DeliveryAck msgIds) |> Async.Ignore
440+ try do! sendEnvelope session sender (Envelope.DeliveryAck msgIds) |> Async.Ignore
440 with _ -> ()
441 with _ -> ()
@@ -454,7 +455,7 @@ module App =
454 | CmdSend(session, recipientHex, text, messageId) ->
455 | CmdSend(session, recipientHex, text, messageId) ->
455 asyncCmd (async {
456 asyncCmd (async {
457− let! status = sendEnvelope session recipientHex (TextMessage(messageId, text))
458+ let! status = sendEnvelope session recipientHex (Envelope.TextMessage(messageId, text))
458 match messageStatusToError status with
459 match messageStatusToError status with
459 | Some err -> return SendFailed err
460 | Some err -> return SendFailed err
460 | None -> return SendOk
461 | None -> return SendOk
@@ -484,7 +485,7 @@ module App =
485 do! sendDeliveryAcks session events
486 do! sendDeliveryAcks session events
487− let chatCount = events |> List.sumBy (function IncomingChat _ -> 1 | _ -> 0)
488+ let chatCount = events |> List.sumBy (fun e -> match e.Event with ChatMsg _ -> 1 | _ -> 0)
488 let status = Received { Events = response.Events.Length; Messages = chatCount; Errors = errors.Length; FirstError = List.tryHead errors }
489 let status = Received { Events = response.Events.Length; Messages = chatCount; Errors = errors.Length; FirstError = List.tryHead errors }
489 return PollResult(events, status, response.Cursor)
490 return PollResult(events, status, response.Cursor)
@@ -536,7 +537,7 @@ module App =
536 Cmd.ofEffect (fun _ ->
537 Cmd.ofEffect (fun _ ->
538 for recipientHex in recipientHexes do
539 for recipientHex in recipientHexes do
539− try do! sendEnvelope session recipientHex (ProfileMessage profile) |> Async.Ignore
540+ try do! sendEnvelope session recipientHex (Envelope.ProfileMessage profile) |> Async.Ignore
540 with _ -> ()
541 with _ -> ()
541 } |> Async.Start)
542 } |> Async.Start)