@@ -81,6 +81,7 @@ module App =
81 | DoDisconnect
81 | DoDisconnect
83 | SendFailed of string
83 | SendFailed of string
84 | DoSaveContact
85 | DoSaveContact
85 | PollResult of events: DecryptedEvent list * status: PollStatus * cursor: int64
86 | PollResult of events: DecryptedEvent list * status: PollStatus * cursor: int64
86 | CopyPubKey
87 | CopyPubKey
@@ -161,7 +162,7 @@ module App =
161 | NoIdentity -> model
162 | NoIdentity -> model
163 let private saveCmdMsg model =
164 let private saveCmdMsg model =
164− CmdSaveData { Contacts = model.Contacts; Messages = model.Messages; ServerUrl = model.ServerUrl; PollCursor = model.PollCursor }
165+ CmdSaveData { Contacts = model.Contacts; Messages = model.Messages; ServerUrl = Some model.ServerUrl; PollCursor = model.PollCursor }
166 let private connStatusLabel = function
167 let private connStatusLabel = function
167 | NoIdentity | Identified(_, Offline) -> "OFFLINE"
168 | NoIdentity | Identified(_, Offline) -> "OFFLINE"
@@ -245,6 +246,7 @@ module App =
245 | _ -> model, []
246 | _ -> model, []
247 | SendFailed err -> { model with Error = Some err }, []
248 | SendFailed err -> { model with Error = Some err }, []
249+ | SendOk -> model, []
249 | PollResult(events, status, newCursor) ->
251 | PollResult(events, status, newCursor) ->
250 let model' =
252 let model' =
@@ -295,7 +297,7 @@ module App =
295 Auth = Identified(identity, Connecting)
297 Auth = Identified(identity, Connecting)
296 Contacts = data.Contacts
298 Contacts = data.Contacts
297 Messages = data.Messages
299 Messages = data.Messages
298− ServerUrl = if data.ServerUrl <> "" then data.ServerUrl else model.ServerUrl
300+ ServerUrl = data.ServerUrl |> Option.defaultValue model.ServerUrl
299 PollCursor = data.PollCursor
301 PollCursor = data.PollCursor
300 Page = Conversations }
302 Page = Conversations }
301 model', [ CmdConnect(model'.ServerUrl, identity) ]
303 model', [ CmdConnect(model'.ServerUrl, identity) ]
@@ -313,36 +315,65 @@ module App =
314 |> Async.Start)
316 |> Async.Start)
318+ type private Envelope =
319+ | TextMessage of id: string * body: string
320+ | DeliveryAck of id: string * ackIds: string list
322+ let private serializeEnvelope = function
323+ | TextMessage(id, body) ->
324+ JsonSerializer.Serialize({| ``type`` = "text"; id = id; body = body |})
325+ | DeliveryAck(id, ackIds) ->
326+ JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = id; ack_ids = ackIds |})
328+ let private parseEnvelope (json: string) =
329+ use doc = JsonDocument.Parse(json)
330+ let root = doc.RootElement
331+ match root.GetProperty("type").GetString() with
333+ Some(TextMessage(root.GetProperty("id").GetString(), root.GetProperty("body").GetString()))
335+ let ackIds = root.GetProperty("ack_ids").EnumerateArray() |> Seq.map _.GetString() |> Seq.toList
336+ Some(DeliveryAck(root.GetProperty("id").GetString(), ackIds))
316 let private decryptEvent (privKey: byte[]) (payload: EventPayload) =
339 let private decryptEvent (privKey: byte[]) (payload: EventPayload) =
318 let blob = Crypto.fromHex payload.EncryptedBlob
341 let blob = Crypto.fromHex payload.EncryptedBlob
320 match Crypto.decrypt privKey blob with
343 match Crypto.decrypt privKey blob with
321 | Some(plaintext, senderHex) ->
344 | Some(plaintext, senderHex) ->
322− use doc = JsonDocument.Parse(plaintext)
345+ match parseEnvelope plaintext with
323− let root = doc.RootElement
346+ | Some(TextMessage(id, body)) ->
325− match root.GetProperty("type").GetString() with
327 Ok(IncomingChat
347 Ok(IncomingChat
328 { SenderPubkey = senderHex
348 { SenderPubkey = senderHex
329 Message =
349 Message =
330− { Id = root.GetProperty("id").GetString()
350+ { Id = id; Body = body
331− Body = root.GetProperty("body").GetString()
332 Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)
351 Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)
333 IsOutgoing = false
352 IsOutgoing = false
334 Status = DeliveryStatus.Delivered } })
353 Status = DeliveryStatus.Delivered } })
335− | "delivery.ack" ->
354+ | Some(DeliveryAck(_, ackIds)) ->
337− root.GetProperty("ack_ids").EnumerateArray()
338− |> Seq.map _.GetString()
340 Ok(IncomingDeliveryAck(senderHex, ackIds))
355 Ok(IncomingDeliveryAck(senderHex, ackIds))
341− | t -> Error $"unknown envelope type: {t}"
356+ | None -> Error "unknown envelope type"
342 | None -> Error "decrypt failed"
357 | None -> Error "decrypt failed"
343 with ex ->
358 with ex ->
344 Error $"parse: {ex.Message}"
359 Error $"parse: {ex.Message}"
361+ let private sendDeliveryAcks (session: Session) (events: DecryptedEvent list) =
365+ |> List.choose (function IncomingChat msg -> Some(msg.SenderPubkey, msg.Message.Id) | _ -> None)
367+ |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)
369+ for sender, msgIds in chatsBySender do
371+ let ackPayload = serializeEnvelope (DeliveryAck(Guid.NewGuid().ToString(), msgIds))
372+ let blob = Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex sender) ackPayload
373+ do! sendMessage session.Url session.Token sender (Crypto.toHex blob) (DateTimeOffset.UtcNow.ToUnixTimeSeconds()) |> Async.Ignore
346 let mapCmd cmdMsg =
377 let mapCmd cmdMsg =
347 match cmdMsg with
378 match cmdMsg with
348 | CmdConnect(url, identity) ->
379 | CmdConnect(url, identity) ->
@@ -355,24 +386,20 @@ module App =
357 | CmdSend(session, recipientHex, text, messageId) ->
388 | CmdSend(session, recipientHex, text, messageId) ->
358− Cmd.ofEffect (fun dispatch ->
359− async {
389+ asyncCmd (async {
361− let recipPub = Crypto.fromHex recipientHex
391+ let recipPub = Crypto.fromHex recipientHex
362− let ts = DateTimeOffset.UtcNow.ToUnixTimeSeconds()
392+ let ts = DateTimeOffset.UtcNow.ToUnixTimeSeconds()
363− let payload = JsonSerializer.Serialize({| ``type`` = "text"; id = messageId; body = text |})
393+ let payload = serializeEnvelope (TextMessage(messageId, text))
364− let blob = Crypto.encrypt session.Identity.PrivKey recipPub payload
394+ let blob = Crypto.encrypt session.Identity.PrivKey recipPub payload
365− let! status = sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts
395+ let! status = sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts
367− match status with
397+ match messageStatusToError status with
368− | Delivered | Federated | Queued -> ()
398+ | Some err -> return SendFailed err
369− | Rejected -> dispatch (SendFailed "Message rejected by server")
399+ | None -> return SendOk
370− | Unauthorized -> dispatch (SendFailed "Not authorized to deliver message")
371− | UnknownStatus s -> dispatch (SendFailed $"Unexpected status: {s}")
372− with ex ->
400+ with ex ->
373− dispatch (SendFailed $"Send failed: {ex.Message}")
401+ return SendFailed $"Send failed: {ex.Message}"
377 | CmdPoll(session, cursor) ->
404 | CmdPoll(session, cursor) ->
378 asyncCmd (async {
405 asyncCmd (async {
@@ -396,19 +423,7 @@ module App =
396 try do! ackMessages session.Url session.Token ackIds
423 try do! ackMessages session.Url session.Token ackIds
397 with _ -> ()
424 with _ -> ()
399− // Send delivery.ack for received chat messages (not for delivery.ack messages — no infinite loop)
426+ do! sendDeliveryAcks session events
402− |> List.choose (function IncomingChat msg -> Some(msg.SenderPubkey, msg.Message.Id) | _ -> None)
404− |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)
406− for sender, msgIds in chatsBySender do
408− let ackPayload = JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = Guid.NewGuid().ToString(); ack_ids = msgIds |})
409− let blob = Crypto.encrypt session.Identity.PrivKey (Crypto.fromHex sender) ackPayload
410− do! sendMessage session.Url session.Token sender (Crypto.toHex blob) (DateTimeOffset.UtcNow.ToUnixTimeSeconds()) |> Async.Ignore
413 let chatCount = events |> List.sumBy (function IncomingChat _ -> 1 | _ -> 0)
428 let chatCount = events |> List.sumBy (function IncomingChat _ -> 1 | _ -> 0)
414 let status = Received { Events = response.Events.Length; Messages = chatCount; Errors = errors.Length; FirstError = List.tryHead errors }
429 let status = Received { Events = response.Events.Length; Messages = chatCount; Errors = errors.Length; FirstError = List.tryHead errors }