git.iko.soy/skrepka
on d1663a6 help sign in
skrepka/client/App.fs
550 lines 19 kB history raw
1namespace Skrepka
3open System
4open System.Text.Json
5open Fabulous
6open Fabulous.Maui
7open Microsoft.Maui.Graphics
9open type Fabulous.Maui.View
11module App =
13 // ── Domain Types ──
15 type Contact = { Pubkey: string; Nickname: string }
17 type ChatMessage =
18 { Id: string
19 Body: string
20 Timestamp: DateTimeOffset
21 IsOutgoing: bool }
23 type Page =
24 | Setup
25 | Conversations
26 | Chat of string
27 | AddContact
28 | Settings
30 type ConnState =
31 | Offline
32 | Connecting
33 | Online of token: string
35 // ── Model ──
37 type Model =
38 { Page: Page
39 PrivKey: byte[] option
40 PubKeyHex: string
41 ServerUrl: string
42 Conn: ConnState
43 Contacts: Contact list
44 PollStatus: string
45 Messages: Map<string, ChatMessage list>
46 ComposeText: string
47 NewPubkey: string
48 NewNickname: string
49 Error: string option }
51 // ── Msg ──
53 type Msg =
54 | Nav of Page
55 | GenIdentity
56 | IdentityReady of byte[] * byte[]
57 | SetServerUrl of string
58 | DoConnect
59 | AuthOk of string
60 | AuthErr of string
61 | DoDisconnect
62 | SetCompose of string
63 | DoSend
64 | Sent of string * string
65 | SetNewPubkey of string
66 | SetNewNickname of string
67 | DoSaveContact
68 | DoDeleteContact of string
69 | PollResult of (string * string * int64 * string) list * string
70 | DoPoll
71 | CopyPubKey
72 | DismissError
74 // ── CmdMsg ──
76 type CmdMsg =
77 | CmdGenIdentity
78 | CmdConnect of url: string * pubHex: string * privKey: byte[]
79 | CmdSend of
80 url: string *
81 token: string *
82 toHex: string *
83 privKey: byte[] *
84 pubKeyHex: string *
85 recipPubHex: string *
86 text: string
87 | CmdPoll of url: string * token: string * privKey: byte[]
88 | CmdCopyToClipboard of string
90 // ── Helpers ──
92 let private truncKey (hex: string) =
93 if hex.Length > 16 then hex.[..15] + "..." else hex
95 let private contactName (contacts: Contact list) (pk: string) =
96 contacts
97 |> List.tryFind (fun c -> c.Pubkey = pk)
98 |> Option.map _.Nickname
99 |> Option.defaultValue (truncKey pk)
101 // ── Init ──
103 let init () =
104 { Page = Setup
105 PrivKey = None
106 PubKeyHex = ""
107 ServerUrl = "http://localhost:8080"
108 Conn = Offline
109 PollStatus = ""
110 Contacts = []
111 Messages = Map.empty
112 ComposeText = ""
113 NewPubkey = ""
114 NewNickname = ""
115 Error = None },
116 []
118 // ── Update ──
120 let update msg model =
121 match msg with
122 | Nav page -> { model with Page = page }, []
124 | GenIdentity -> model, [ CmdGenIdentity ]
126 | IdentityReady(priv, pub) ->
127 { model with
128 PrivKey = Some priv
129 PubKeyHex = Crypto.toHex pub
130 Page = Settings },
131 []
133 | SetServerUrl url -> { model with ServerUrl = url }, []
135 | DoConnect ->
136 match model.PrivKey with
137 | Some priv ->
138 { model with Conn = Connecting }, [ CmdConnect(model.ServerUrl, model.PubKeyHex, priv) ]
139 | None -> { model with Error = Some "No identity generated" }, []
141 | AuthOk token ->
142 { model with
143 Conn = Online token
144 Page = Conversations
145 Error = None },
146 [ CmdPoll(model.ServerUrl, token, model.PrivKey.Value) ]
148 | AuthErr err -> { model with Conn = Offline; Error = Some err }, []
150 | DoDisconnect -> { model with Conn = Offline }, []
152 | SetCompose text -> { model with ComposeText = text }, []
154 | DoSend ->
155 match model.Page, model.Conn, model.PrivKey with
156 | Chat pk, Online token, Some priv when model.ComposeText <> "" ->
157 let text = model.ComposeText
158 let outMsg =
159 { Id = Guid.NewGuid().ToString()
160 Body = text
161 Timestamp = DateTimeOffset.UtcNow
162 IsOutgoing = true }
163 let msgs = model.Messages |> Map.tryFind pk |> Option.defaultValue []
165 { model with
166 ComposeText = ""
167 Messages = model.Messages |> Map.add pk (msgs @ [ outMsg ]) },
168 [ CmdSend(model.ServerUrl, token, pk, priv, model.PubKeyHex, pk, text) ]
169 | _ -> model, []
171 | Sent _ -> model, []
173 | PollResult(incoming, status) ->
174 let model' =
175 incoming
176 |> List.fold
177 (fun m (fromPk, body, ts, id) ->
178 let msgs = m.Messages |> Map.tryFind fromPk |> Option.defaultValue []
180 if msgs |> List.exists (fun msg -> msg.Id = id) then
181 m
182 else
183 let newMsg =
184 { Id = id
185 Body = body
186 Timestamp = DateTimeOffset.FromUnixTimeSeconds(ts)
187 IsOutgoing = false }
189 let contacts =
190 if m.Contacts |> List.exists (fun c -> c.Pubkey = fromPk) then
191 m.Contacts
192 else
193 m.Contacts @ [ { Pubkey = fromPk; Nickname = truncKey fromPk } ]
195 { m with
196 Contacts = contacts
197 Messages = m.Messages |> Map.add fromPk (msgs @ [ newMsg ]) })
198 { model with PollStatus = status }
200 match model'.Conn with
201 | Online token -> model', [ CmdPoll(model'.ServerUrl, token, model'.PrivKey.Value) ]
202 | _ -> model', []
204 | DoPoll ->
205 match model.Conn, model.PrivKey with
206 | Online token, Some priv -> model, [ CmdPoll(model.ServerUrl, token, priv) ]
207 | _ -> model, []
209 | SetNewPubkey pk -> { model with NewPubkey = pk }, []
210 | SetNewNickname nn -> { model with NewNickname = nn }, []
212 | DoSaveContact ->
213 if model.NewPubkey <> "" && model.NewNickname <> "" then
214 let contact =
215 { Pubkey = model.NewPubkey
216 Nickname = model.NewNickname }
218 let contacts =
219 if model.Contacts |> List.exists (fun c -> c.Pubkey = model.NewPubkey) then
220 model.Contacts
221 |> List.map (fun c ->
222 if c.Pubkey = model.NewPubkey then contact else c)
223 else
224 model.Contacts @ [ contact ]
226 { model with
227 Contacts = contacts
228 NewPubkey = ""
229 NewNickname = ""
230 Page = Conversations },
231 []
232 else
233 model, []
235 | DoDeleteContact pk ->
236 { model with
237 Contacts = model.Contacts |> List.filter (fun c -> c.Pubkey <> pk) },
238 []
240 | CopyPubKey -> model, [ CmdCopyToClipboard model.PubKeyHex ]
242 | DismissError -> { model with Error = None }, []
244 // ── mapCmd ──
246 let private asyncCmd (op: Async<Msg>) : Cmd<Msg> =
247 Cmd.ofEffect (fun dispatch ->
248 System.Threading.Tasks.Task.Run(Func<System.Threading.Tasks.Task>(fun () ->
249 task {
250 let! msg = Async.StartAsTask op
251 dispatch msg
252 }))
253 |> ignore)
255 let mapCmd cmdMsg =
256 match cmdMsg with
257 | CmdGenIdentity ->
258 asyncCmd (async {
259 let priv, pub = Crypto.generateIdentity ()
260 return IdentityReady(priv, pub)
261 })
263 | CmdConnect(url, pubHex, privKey) ->
264 asyncCmd (async {
265 try
266 let! challenge = ApiClient.requestChallenge url pubHex
267 let sigHex = Crypto.signChallenge privKey challenge
268 let! (token, _) = ApiClient.verify url pubHex challenge sigHex
270 if String.IsNullOrEmpty(token) then
271 return AuthErr "Authentication rejected by server"
272 else
273 return AuthOk token
274 with ex ->
275 return AuthErr ex.Message
276 })
278 | CmdSend(url, token, toHex, privKey, pubKeyHex, recipPubHex, text) ->
279 asyncCmd (async {
280 try
281 let pubKey = Crypto.fromHex pubKeyHex
282 let recipPub = Crypto.fromHex recipPubHex
283 let id = Guid.NewGuid().ToString()
284 let ts = DateTimeOffset.UtcNow.ToUnixTimeSeconds()
286 let payload =
287 $"""{{ "type": "text", "id": "{id}", "timestamp": {ts}, "body": {JsonSerializer.Serialize(text)} }}"""
289 let blob = Crypto.encrypt privKey pubKey recipPub payload
290 let blobHex = Crypto.toHex blob
291 let! (_, msgId) = ApiClient.sendMessage url token toHex blobHex ts
292 return Sent(toHex, msgId)
293 with ex ->
294 return DismissError // TODO: show send errors properly
295 })
297 | CmdPoll(url, token, privKey) ->
298 asyncCmd (async {
299 try
300 let! (events, _) = ApiClient.poll url token
301 let messages = ResizeArray()
302 let ackIds = ResizeArray()
303 let errors = ResizeArray()
305 for (evtId, evtType, payload) in events do
306 if evtType = "message" then
307 try
308 let doc = JsonDocument.Parse(payload)
309 let blobHex = doc.RootElement.GetProperty("encryptedBlob").GetString()
310 let ts = doc.RootElement.GetProperty("timestamp").GetInt64()
311 let blob = Crypto.fromHex blobHex
313 match Crypto.decrypt privKey blob with
314 | Some(plaintext, senderHex) ->
315 let ptDoc = JsonDocument.Parse(plaintext)
316 let ptRoot = ptDoc.RootElement
318 if ptRoot.GetProperty("type").GetString() = "text" then
319 let msgId = ptRoot.GetProperty("id").GetString()
320 let body = ptRoot.GetProperty("body").GetString()
321 messages.Add((senderHex, body, ts, msgId))
323 ackIds.Add(evtId)
324 | None ->
325 errors.Add("decrypt failed")
326 with ex ->
327 errors.Add($"parse: {ex.Message}")
329 if ackIds.Count > 0 then
330 do! ApiClient.ackMessages url token (Seq.toList ackIds)
332 let now = DateTimeOffset.UtcNow.ToString("HH:mm:ss")
334 let status =
335 $"[{now}] evts:{events.Length} msgs:{messages.Count} errs:{errors.Count}"
336 + (if errors.Count > 0 then $" [{errors.[0]}]" else "")
338 return PollResult(Seq.toList messages, status)
339 with
340 | :? System.Threading.Tasks.TaskCanceledException ->
341 // Normal timeout from long poll — just retry
342 return PollResult([], "polling...")
343 | ex ->
344 let now = DateTimeOffset.UtcNow.ToString("HH:mm:ss")
345 do! Async.Sleep 3000
346 return PollResult([], $"[{now}] poll error: {ex.Message}")
347 })
349 | CmdCopyToClipboard text ->
350 Cmd.ofEffect (fun _ ->
351 Microsoft.Maui.ApplicationModel.DataTransfer.Clipboard.Default.SetTextAsync(text)
352 |> ignore)
354 // ── View ──
356 let private viewSetup () =
357 ContentPage(
358 (VStack(spacing = 24.) {
359 Label("Skrepka")
360 .font(size = 32.)
361 .centerTextHorizontal()
363 Label("End-to-end encrypted messaging")
364 .font(size = 16.)
365 .centerTextHorizontal()
367 Button("Generate Identity", GenIdentity)
368 .centerHorizontal()
369 })
370 .padding(30.)
371 .centerVertical()
372 )
374 let private viewSettings model =
375 ContentPage(
376 ScrollView(
377 (VStack(spacing = 16.) {
378 Label("Settings")
379 .font(size = 24.)
380 .centerTextHorizontal()
382 Label("Your Public Key:")
384 Label(model.PubKeyHex)
385 .font(size = 9.)
387 Button("Copy Public Key", CopyPubKey)
389 Label("Server:")
391 Entry(model.ServerUrl, SetServerUrl)
393 if model.Error.IsSome then
394 Label(model.Error.Value)
395 .textColor(Colors.Red)
396 .font(size = 12.)
398 Button("Dismiss", DismissError)
400 match model.Conn with
401 | Offline -> Button("Connect", DoConnect)
402 | Connecting -> Label("Connecting...").centerTextHorizontal()
403 | Online _ ->
404 Button("Disconnect", DoDisconnect)
405 Button("Go to Conversations", Nav Conversations)
406 })
407 .padding(20.)
408 )
409 )
411 let private viewConversations model =
412 let connStr =
413 match model.Conn with
414 | Offline -> "OFFLINE"
415 | Connecting -> "CONNECTING"
416 | Online _ -> "ONLINE"
418 let contactNames =
419 model.Contacts
420 |> List.map _.Nickname
421 |> String.concat ", "
423 let totalMsgs =
424 model.Messages |> Map.fold (fun acc _ msgs -> acc + List.length msgs) 0
426 ContentPage(
427 ScrollView(
428 (VStack(spacing = 8.) {
429 HStack(spacing = 8.) {
430 Label("Conversations")
431 .font(size = 24.)
433 Button("+", Nav AddContact)
434 Button("Settings", Nav Settings)
435 }
437 Label($"conn:{connStr} contacts:{model.Contacts.Length} msgs:{totalMsgs}")
438 .font(size = 10.)
439 .textColor(Colors.DimGray)
441 Label($"poll: {model.PollStatus}")
442 .font(size = 10.)
443 .textColor(Colors.DimGray)
445 if contactNames <> "" then
446 Label($"names: {contactNames}")
447 .font(size = 10.)
448 .textColor(Colors.DimGray)
450 if model.Contacts.IsEmpty then
451 Label("No contacts yet. Tap + to add one.")
452 .centerTextHorizontal()
453 .textColor(Colors.Gray)
455 for c in model.Contacts do
456 let lastMsg =
457 model.Messages
458 |> Map.tryFind c.Pubkey
459 |> Option.bind List.tryLast
460 |> Option.map _.Body
461 |> Option.defaultValue ""
463 let preview =
464 if lastMsg.Length > 40 then lastMsg.[..39] + "..." else lastMsg
466 Button($"{c.Nickname}\n{preview}", Nav(Chat c.Pubkey))
467 })
468 .padding(20.)
469 )
470 )
472 let private viewChat model pk =
473 let name = contactName model.Contacts pk
474 let msgs = model.Messages |> Map.tryFind pk |> Option.defaultValue []
476 ContentPage(
477 (VStack(spacing = 8.) {
478 HStack(spacing = 8.) {
479 Button("< Back", Nav Conversations)
481 Label(name)
482 .font(size = 20.)
483 .centerTextHorizontal()
484 }
486 if model.Error.IsSome then
487 Label(model.Error.Value)
488 .textColor(Colors.Red)
489 .font(size = 11.)
491 Label($"[{msgs.Length} message(s), compose: \"{model.ComposeText}\"]")
492 .textColor(Colors.Gray)
493 .font(size = 10.)
495 let allMessages =
496 msgs
497 |> List.map (fun m ->
498 if m.IsOutgoing then $"You: {m.Body}" else m.Body)
499 |> String.concat "\n"
501 Label(if allMessages = "" then "No messages yet" else allMessages)
502 .padding(8.)
503 .font(size = 14.)
505 HStack(spacing = 8.) {
506 Entry(model.ComposeText, SetCompose)
507 .placeholder("Message...")
509 Button("Send", DoSend)
510 }
511 })
512 .padding(12.)
513 )
515 let private viewAddContact model =
516 ContentPage(
517 (VStack(spacing = 16.) {
518 HStack(spacing = 8.) {
519 Button("< Back", Nav Conversations)
521 Label("Add Contact")
522 .font(size = 20.)
523 }
525 Label("Public Key (hex):")
526 Entry(model.NewPubkey, SetNewPubkey)
528 Label("Nickname:")
529 Entry(model.NewNickname, SetNewNickname)
531 Button("Save Contact", DoSaveContact)
532 .centerHorizontal()
533 })
534 .padding(20.)
535 )
537 let view model =
538 let page =
539 match model.Page with
540 | Setup -> viewSetup ()
541 | Settings -> viewSettings model
542 | Conversations -> viewConversations model
543 | Chat pk -> viewChat model pk
544 | AddContact -> viewAddContact model
546 Application() { Window(page) }
548 let program =
549 Program.statefulWithCmdMsg init update mapCmd
550 |> Program.withView view