@@ -17,31 +17,11 @@ module App =
1717
1818 // ── Domain Types ──
1919
20− [<JsonConverter(typeof<EnvelopeTypeConverter>)>]
21− type private EnvelopeType = Text | UnknownEnvelope of string
22− and private EnvelopeTypeConverter() =
23− inherit JsonConverter<EnvelopeType>()
24− override _.Read(reader, _, _) =
25− match reader.GetString() with
26− | "text" -> Text
27− | s -> UnknownEnvelope s
28− override _.Write(writer, value, _) =
29− writer.WriteStringValue(
30− match value with
31− | Text -> "text"
32− | UnknownEnvelope s -> s)
33−
34− [<CLIMutable>]
35− type private TextEnvelope =
36− { [<JsonPropertyName("type")>] Type: EnvelopeType
37− [<JsonPropertyName("id")>] Id: string
38− [<JsonPropertyName("body")>] Body: string }
39−
4020 type Page =
4121 | Setup
4222 | Conversations
43− | Chat of pubkey: string
44− | AddContact
23+ | Chat of pubkey: string * compose: string
24+ | AddContact of pubkey: string * nickname: string
4525 | Settings
4626
4727 type Session = { Url: string; Token: string; Identity: Identity }
@@ -57,6 +37,10 @@ module App =
5737
5838 type IncomingMessage = { SenderPubkey: string; Message: ChatMessage }
5939
40+ type DecryptedEvent =
41+ | IncomingChat of IncomingMessage
42+ | IncomingDeliveryAck of senderPubkey: string * ackIds: string list
43+
6044 type PollReceived = { Events: int; Messages: int; Errors: int; FirstError: string option }
6145
6246 type PollStatus =
@@ -75,10 +59,7 @@ module App =
7559 PollStatus: PollStatus
7660 Messages: Map<string, ChatMessage list>
7761 Error: string option
78− PollCursor: int64
79− Compose: string
80− ContactPubkey: string
81− ContactNickname: string }
62+ PollCursor: int64 }
8263
8364 // ── Msg ──
8465
@@ -93,7 +74,6 @@ module App =
9374 | SetContactPubkey of string
9475 | SetContactNickname of string
9576 | GenIdentity
96− | IdentityReady of Identity
9777 | SetServerUrl of string
9878 | DoConnect
9979 | AuthOk of string
@@ -102,7 +82,7 @@ module App =
10282 | DoSend
10383 | SendFailed of string
10484 | DoSaveContact
105− | PollResult of messages: IncomingMessage list * status: PollStatus * cursor: int64
85+ | PollResult of events: DecryptedEvent list * status: PollStatus * cursor: int64
10686 | CopyPubKey
10787 | DismissError
10888 | StateLoaded of StateLoadResult
@@ -110,7 +90,6 @@ module App =
11090 // ── CmdMsg ──
11191
11292 type CmdMsg =
113− | CmdGenIdentity
11493 | CmdConnect of url: string * identity: Identity
11594 | CmdSend of session: Session * recipientHex: string * text: string * messageId: string
11695 | CmdPoll of session: Session * cursor: int64
@@ -154,6 +133,14 @@ module App =
154133 if existing |> List.exists (fun m -> m.Id = msg.Id) then messages
155134 else Map.add pk (existing @ [ msg ]) messages
156135
136+ let private markDelivered (pk: string) (ackIds: string list) (messages: Map<string, ChatMessage list>) =
137+ match Map.tryFind pk messages with
138+ | Some msgs ->
139+ msgs
140+ |> List.map (fun m -> if m.IsOutgoing && List.contains m.Id ackIds then { m with Status = DeliveryStatus.Delivered } else m)
141+ |> fun updated -> Map.add pk updated messages
142+ | None -> messages
143+
157144 let private addContactIfNew (contact: Contact) (contacts: Contact list) =
158145 if contacts |> List.exists (fun c -> c.Pubkey = contact.Pubkey) then contacts
159146 else contacts @ [ contact ]
@@ -174,7 +161,7 @@ module App =
174161 | NoIdentity -> model
175162
176163 let private saveCmdMsg model =
177− CmdSaveData { Contacts = model.Contacts; Messages = model.Messages; ServerUrl = Some model.ServerUrl; PollCursor = model.PollCursor }
164+ CmdSaveData { Contacts = model.Contacts; Messages = model.Messages; ServerUrl = model.ServerUrl; PollCursor = model.PollCursor }
178165
179166 let private connStatusLabel = function
180167 | NoIdentity | Identified(_, Offline) -> "OFFLINE"
@@ -191,29 +178,30 @@ module App =
191178 Contacts = []
192179 Messages = Map.empty
193180 Error = None
194− PollCursor = 0L
195− Compose = ""
196− ContactPubkey = ""
197− ContactNickname = "" },
181+ PollCursor = 0L },
198182 [ CmdLoadState ]
199183
200184 // ── Update ──
201185
202186 let update msg model =
203187 match msg with
204− | SetPage(Chat pk) ->
205− { model with Page = Chat pk; Compose = "" }, []
206− | SetPage AddContact ->
207− { model with Page = AddContact; ContactPubkey = ""; ContactNickname = "" }, []
208188 | SetPage page -> { model with Page = page }, []
209189
210− | SetCompose text -> { model with Compose = text }, []
211− | SetContactPubkey pk -> { model with ContactPubkey = pk }, []
212− | SetContactNickname nn -> { model with ContactNickname = nn }, []
213−
214− | GenIdentity -> model, [ CmdGenIdentity ]
190+ | SetCompose text ->
191+ match model.Page with
192+ | Chat(pk, _) -> { model with Page = Chat(pk, text) }, []
193+ | _ -> model, []
194+ | SetContactPubkey pk ->
195+ match model.Page with
196+ | AddContact(_, nn) -> { model with Page = AddContact(pk, nn) }, []
197+ | _ -> model, []
198+ | SetContactNickname nn ->
199+ match model.Page with
200+ | AddContact(pk, _) -> { model with Page = AddContact(pk, nn) }, []
201+ | _ -> model, []
215202
216− | IdentityReady identity ->
203+ | GenIdentity ->
204+ let identity = Crypto.generateIdentity ()
217205 { model with Auth = Identified(identity, Offline); Page = Settings },
218206 [ CmdSaveIdentity identity ]
219207
@@ -239,45 +227,51 @@ module App =
239227
240228 | DoSend ->
241229 match model.Page, trySession model with
242− | Chat pk, Some session when model.Compose <> "" ->
230+ | Chat(pk, compose), Some session when compose <> "" ->
243231 let id = Guid.NewGuid().ToString()
244232 let outMsg =
245233 { Id = id
246− Body = model.Compose
234+ Body = compose
247235 Timestamp = DateTimeOffset.UtcNow
248− IsOutgoing = true }
236+ IsOutgoing = true
237+ Status = DeliveryStatus.Sent }
249238
250239 let model' =
251240 { model with
252− Compose = ""
241+ Page = Chat(pk, "")
253242 Messages = model.Messages |> appendMessage pk outMsg }
254243
255− model', [ CmdSend(session, pk, model.Compose, id); saveCmdMsg model' ]
244+ model', [ CmdSend(session, pk, compose, id); saveCmdMsg model' ]
256245 | _ -> model, []
257246
258247 | SendFailed err -> { model with Error = Some err }, []
259248
260− | PollResult(incoming, status, newCursor) ->
249+ | PollResult(events, status, newCursor) ->
261250 let model' =
262− incoming
251+ events
263252 |> List.fold
264− (fun (m: Model) msg ->
265− { m with
266− Contacts = m.Contacts |> addContactIfNew { Pubkey = msg.SenderPubkey; Nickname = truncKey msg.SenderPubkey }
267− Messages = m.Messages |> appendMessage msg.SenderPubkey msg.Message })
253+ (fun (m: Model) evt ->
254+ match evt with
255+ | IncomingChat msg ->
256+ { m with
257+ Contacts = m.Contacts |> addContactIfNew { Pubkey = msg.SenderPubkey; Nickname = truncKey msg.SenderPubkey }
258+ Messages = m.Messages |> appendMessage msg.SenderPubkey msg.Message }
259+ | IncomingDeliveryAck(senderPubkey, ackIds) ->
260+ { m with Messages = m.Messages |> markDelivered senderPubkey ackIds })
268261 { model with PollStatus = status; PollCursor = newCursor }
269262
270263 model',
271264 [ match trySession model' with
272265 | Some session -> CmdPoll(session, model'.PollCursor)
273266 | None -> ()
274− if not incoming.IsEmpty then saveCmdMsg model' ]
267+ if not events.IsEmpty then saveCmdMsg model' ]
275268
276269 | DoSaveContact ->
277− if model.ContactPubkey <> "" && model.ContactNickname <> "" then
278− match tryParsePubkey model.ContactPubkey with
270+ match model.Page with
271+ | AddContact(cpk, cnn) when cpk <> "" && cnn <> "" ->
272+ match tryParsePubkey cpk with
279273 | Some bytes ->
280− let contact: Contact = { Pubkey = Crypto.toHex bytes; Nickname = model.ContactNickname }
274+ let contact: Contact = { Pubkey = Crypto.toHex bytes; Nickname = cnn }
281275
282276 let model' =
283277 { model with
@@ -286,8 +280,7 @@ module App =
286280
287281 model', [ saveCmdMsg model' ]
288282 | None -> { model with Error = Some "Invalid public key" }, []
289− else
290− model, []
283+ | _ -> model, []
291284
292285 | CopyPubKey ->
293286 match model.Auth with
@@ -302,7 +295,7 @@ module App =
302295 Auth = Identified(identity, Connecting)
303296 Contacts = data.Contacts
304297 Messages = data.Messages
305− ServerUrl = data.ServerUrl |> Option.defaultValue model.ServerUrl
298+ ServerUrl = if data.ServerUrl <> "" then data.ServerUrl else model.ServerUrl
306299 PollCursor = data.PollCursor
307300 Page = Conversations }
308301 model', [ CmdConnect(model'.ServerUrl, identity) ]
@@ -326,26 +319,32 @@ module App =
326319
327320 match Crypto.decrypt privKey blob with
328321 | Some(plaintext, senderHex) ->
329− let envelope = JsonSerializer.Deserialize<TextEnvelope>(plaintext)
330−
331− match envelope.Type with
332− | Text ->
333− Ok { SenderPubkey = senderHex
334− Message =
335− { Id = envelope.Id
336− Body = envelope.Body
337− Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)
338− IsOutgoing = false } }
339− | UnknownEnvelope t -> Error $"unknown envelope type: {t}"
322+ use doc = JsonDocument.Parse(plaintext)
323+ let root = doc.RootElement
324+
325+ match root.GetProperty("type").GetString() with
326+ | "text" ->
327+ Ok(IncomingChat
328+ { SenderPubkey = senderHex
329+ Message =
330+ { Id = root.GetProperty("id").GetString()
331+ Body = root.GetProperty("body").GetString()
332+ Timestamp = DateTimeOffset.FromUnixTimeSeconds(payload.Timestamp)
333+ IsOutgoing = false
334+ Status = DeliveryStatus.Delivered } })
335+ | "delivery.ack" ->
336+ let ackIds =
337+ root.GetProperty("ack_ids").EnumerateArray()
338+ |> Seq.map _.GetString()
339+ |> Seq.toList
340+ Ok(IncomingDeliveryAck(senderHex, ackIds))
341+ | t -> Error $"unknown envelope type: {t}"
340342 | None -> Error "decrypt failed"
341343 with ex ->
342344 Error $"parse: {ex.Message}"
343345
344346 let mapCmd cmdMsg =
345347 match cmdMsg with
346− | CmdGenIdentity ->
347− Cmd.ofEffect (fun dispatch -> dispatch (IdentityReady(Crypto.generateIdentity ())))
348−
349348 | CmdConnect(url, identity) ->
350349 asyncCmd (async {
351350 try
@@ -361,7 +360,7 @@ module App =
361360 try
362361 let recipPub = Crypto.fromHex recipientHex
363362 let ts = DateTimeOffset.UtcNow.ToUnixTimeSeconds()
364− let payload = JsonSerializer.Serialize<TextEnvelope>({ Type = Text; Id = messageId; Body = text })
363+ let payload = JsonSerializer.Serialize({| ``type`` = "text"; id = messageId; body = text |})
365364 let blob = Crypto.encrypt session.Identity.PrivKey recipPub payload
366365 let! status = sendMessage session.Url session.Token recipientHex (Crypto.toHex blob) ts
367366
@@ -381,23 +380,39 @@ module App =
381380 let! response = poll session.Url session.Token cursor
382381 let ackIds = response.Events |> Array.map _.Id |> Array.toList
383382
384− let messages, errors =
383+ let events, errors =
385384 Array.foldBack
386− (fun (evt: PollEvent) (msgs, errs) ->
385+ (fun (evt: PollEvent) (evts, errs) ->
387386 match evt.EventType with
388387 | Message ->
389388 match decryptEvent session.Identity.PrivKey evt.Payload with
390− | Ok msg -> (msg :: msgs, errs)
391− | Error err -> (msgs, err :: errs)
392− | Ack | UnknownEvent _ -> (msgs, errs))
389+ | Ok event -> (event :: evts, errs)
390+ | Error err -> (evts, err :: errs)
391+ | UnknownEvent _ -> (evts, errs))
393392 response.Events
394393 ([], [])
395394
396395 if not ackIds.IsEmpty then
397− do! ackMessages session.Url session.Token ackIds
398−
399− let status = Received { Events = response.Events.Length; Messages = messages.Length; Errors = errors.Length; FirstError = List.tryHead errors }
400− return PollResult(messages, status, response.Cursor)
396+ try do! ackMessages session.Url session.Token ackIds
397+ with _ -> ()
398+
399+ // Send delivery.ack for received chat messages (not for delivery.ack messages — no infinite loop)
400+ let chatsBySender =
401+ events
402+ |> List.choose (function IncomingChat msg -> Some(msg.SenderPubkey, msg.Message.Id) | _ -> None)
403+ |> List.groupBy fst
404+ |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)
405+
406+ for sender, msgIds in chatsBySender do
407+ try
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
411+ with _ -> ()
412+
413+ 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 }
415+ return PollResult(events, status, response.Cursor)
401416 with
402417 | :? TimeoutException ->
403418 return PollResult([], Polling, cursor)
@@ -510,7 +525,7 @@ module App =
510525 Label("Conversations")
511526 .font(size = 24.)
512527
513− Button("+", SetPage AddContact)
528+ Button("+", SetPage(AddContact("", "")))
514529 Button("Settings", SetPage Settings)
515530 }
516531
@@ -532,13 +547,13 @@ module App =
532547 |> Option.map (fun m -> if m.Body.Length > 40 then m.Body.[..39] + "..." else m.Body)
533548 |> Option.defaultValue ""
534549
535− Button($"{c.Nickname}\n{preview}", SetPage(Chat c.Pubkey))
550+ Button($"{c.Nickname}\n{preview}", SetPage(Chat(c.Pubkey, "")))
536551 })
537552 .padding(20.)
538553 )
539554 )
540555
541− let private viewChat model pk =
556+ let private viewChat model pk compose =
542557 let name = contactName model.Contacts pk
543558 let msgs = messagesFor pk model.Messages
544559
@@ -560,12 +575,13 @@ module App =
560575 .font(size = 14.)
561576 else
562577 for m in msgs do
563− Label(if m.IsOutgoing then $"You: {m.Body}" else m.Body)
578+ let tick = if m.IsOutgoing && m.Status = DeliveryStatus.Delivered then " \u2713" else ""
579+ Label((if m.IsOutgoing then $"You: {m.Body}" else m.Body) + tick)
564580 .padding(8.)
565581 .font(size = 14.)
566582
567583 HStack(spacing = 8.) {
568− Entry(model.Compose, SetCompose)
584+ Entry(compose, SetCompose)
569585 .placeholder("Message...")
570586
571587 Button("Send", DoSend)
@@ -574,7 +590,7 @@ module App =
574590 .padding(12.)
575591 )
576592
577− let private viewAddContact model =
593+ let private viewAddContact model cpk cnn =
578594 ContentPage(
579595 (VStack(spacing = 16.) {
580596 HStack(spacing = 8.) {
@@ -587,11 +603,11 @@ module App =
587603 viewErrorBanner model.Error
588604
589605 Label("Public Key:")
590− Entry(model.ContactPubkey, SetContactPubkey)
606+ Entry(cpk, SetContactPubkey)
591607 .placeholder("sampel-palnet-...")
592608
593609 Label("Nickname:")
594− Entry(model.ContactNickname, SetContactNickname)
610+ Entry(cnn, SetContactNickname)
595611
596612 Button("Save Contact", DoSaveContact)
597613 .centerHorizontal()
@@ -605,8 +621,8 @@ module App =
605621 | Setup -> viewSetup ()
606622 | Settings -> viewSettings model
607623 | Conversations -> viewConversations model
608− | Chat pk -> viewChat model pk
609− | AddContact -> viewAddContact model
624+ | Chat(pk, compose) -> viewChat model pk compose
625+ | AddContact(pk, nn) -> viewAddContact model pk nn
610626
611627 Application() { Window(page) }
612628