@@ -1,732 +0,0 @@
1−namespace Skrepka
2−
3−open System
4−open System.IO
5−open Avalonia.Media
6−open Avalonia.Themes.Fluent
7−open Fabulous
8−open Fabulous.Avalonia
9−
10−open type Fabulous.Avalonia.View
11−
12−module App =
13−
14− open Store
15− open Crypto
16− open ApiClient
17− open AppTypes
18− open ViewSetup
19− open ViewSettings
20− open ViewConversations
21− open ViewChat
22− open ViewAddContact
23− open ViewEditProfile
24− open Protocol
25−
26− // ── Helpers ──
27−
28− let private tryParsePubkey (input: string) =
29− let input = input.Trim()
30−
31− Phonemic.fromOb input
32− |> Option.orElseWith (fun () -> Crypto.tryFromHex input)
33− |> Option.filter (fun bytes -> bytes.Length = 32)
34−
35− let private appendMessage (pk: string) (msg: ChatMessage) (messages: Map<string, ChatMessage list>) =
36− let existing = messagesFor pk messages
37−
38− if existing |> List.exists (fun m -> m.Id = msg.Id) then
39− messages
40− else
41− Map.add pk (existing @ [ msg ]) messages
42−
43− let private markDelivered (pk: string) (ackIds: string list) (messages: Map<string, ChatMessage list>) =
44− let ackSet = Set.ofList ackIds
45−
46− messages
47− |> Map.change
48− pk
49− (Option.map (
50− List.map (fun m ->
51− match m.Direction with
52− | Outgoing DeliveryStatus.Sent when Set.contains m.Id ackSet ->
53− { m with
54− Direction = Outgoing DeliveryStatus.Delivered }
55− | _ -> m)
56− ))
57−
58− let private newContact pubkey nickname : Contact =
59− { Pubkey = pubkey
60− Nickname = nickname
61− DisplayName = truncKey pubkey
62− Bio = ""
63− Photo = None
64− AddedDate = System.DateTimeOffset.UtcNow }
65−
66− let private withProfile (p: Profile) (c: Contact) =
67− { c with
68− DisplayName = p.DisplayName
69− Bio = p.Bio
70− Photo = p.Photo }
71−
72− let private applyEvent (m: Model) (evt: IncomingEvent) =
73− match evt.Envelope with
74− | Envelope.TextMessage(id, body) ->
75− let message =
76− { Id = id
77− Body = body
78− Timestamp = evt.Timestamp
79− Direction = Incoming }
80−
81− { m with
82− Contacts =
83− if Map.containsKey evt.Sender m.Contacts then
84− m.Contacts
85− else
86− Map.add evt.Sender (newContact evt.Sender "") m.Contacts
87− Messages = m.Messages |> appendMessage evt.Sender message }
88− | Envelope.DeliveryAck ackIds ->
89− { m with
90− Messages = m.Messages |> markDelivered evt.Sender ackIds }
91− | Envelope.ProfileMessage profile ->
92− { m with
93− Contacts =
94− m.Contacts
95− |> Map.change evt.Sender (fun c ->
96− let contact = c |> Option.defaultWith (fun () -> newContact evt.Sender "")
97− Some(withProfile profile contact)) }
98−
99− let private trySession model =
100− match model.Auth with
101− | Identified(id, Online token) ->
102− Some
103− { Url = model.ServerUrl
104− Token = token
105− Identity = id }
106− | _ -> None
107−
108− let private setConn status model =
109− match model.Auth with
110− | Identified(id, _) ->
111− { model with
112− Auth = Identified(id, status) }
113− | NoIdentity -> model
114−
115− let private saveCmdMsg model : CmdMsg =
116− CmdSaveData(
117− { Contacts = model.Contacts
118− Messages = model.Messages
119− ServerUrl = model.ServerUrl
120− PollCursor = model.PollCursor }
121− : Data
122− )
123−
124− // ── Init ──
125−
126− let init () =
127− { Page = Setup
128− Auth = NoIdentity
129− ServerUrl = "http://localhost:8080"
130− PollStatus = ""
131− Contacts = Map.empty
132− Messages = Map.empty
133− Error = None
134− PollCursor = 0L
135− Profile = None
136− FlushingOutbox = false
137− PollRetries = 0
138− KeyboardHeight = 0.
139− SafeAreaTop = 0.
140− SafeAreaBottom = 0. },
141− [ CmdLoadState; CmdSubscribeKeyboard; CmdSubscribeSafeArea ]
142−
143− // ── Update ──
144−
145− let update msg model =
146− match msg with
147− | SetPage page -> { model with Page = page }, []
148−
149− | GenIdentity ->
150− let identity = Crypto.generateIdentity ()
151−
152− { model with
153− Auth = Identified(identity, Offline)
154− Page = EditProfile("", "", None) },
155− [ CmdSaveIdentity identity ]
156−
157− | SetServerUrl url -> { model with ServerUrl = url }, []
158−
159− | DoConnect ->
160− match model.Auth with
161− | Identified(id, _) -> model |> setConn Connecting, [ CmdConnect(model.ServerUrl, id) ]
162− | NoIdentity ->
163− { model with
164− Error = Some "No identity generated" },
165− []
166−
167− | AuthOk token ->
168− match model.Auth with
169− | Identified(id, Connecting) ->
170− let session =
171− { Url = model.ServerUrl
172− Token = token
173− Identity = id }
174−
175− { model with
176− Auth = Identified(id, Online token)
177− Page =
178− match model.Page with
179− | Setup -> Conversations
180− | p -> p
181− Error = None
182− PollStatus = "polling..."
183− FlushingOutbox = true },
184− [ CmdPoll(session, model.PollCursor, 0); CmdFlushOutbox session ]
185− | _ -> model, []
186−
187− | AuthErr err ->
188− { setConn Offline model with
189− Error = Some err
190− FlushingOutbox = false
191− PollRetries = 0 },
192− []
193−
194− | TokenExpired ->
195− match model.Auth with
196− | Identified(id, Online _) ->
197− let m = setConn Connecting model
198−
199− { m with
200− FlushingOutbox = false
201− PollRetries = 0 },
202− [ CmdConnect(model.ServerUrl, id) ]
203− | _ -> model, []
204−
205− | DoDisconnect ->
206− { setConn Offline model with
207− PollStatus = ""
208− FlushingOutbox = false
209− PollRetries = 0 },
210− []
211−
212− | DoSend ->
213− match model.Page with
214− | Chat(pk, compose) when compose.Trim() <> "" ->
215− let body = compose.Trim()
216− let id = Guid.NewGuid().ToString()
217−
218− let outMsg =
219− { Id = id
220− Body = body
221− Timestamp = DateTimeOffset.UtcNow
222− Direction = Outgoing DeliveryStatus.Sent }
223−
224− let neverSentTo =
225− model.Messages
226− |> messagesFor pk
227− |> List.exists (fun m -> match m.Direction with Outgoing _ -> true | _ -> false)
228− |> not
229−
230− let model' =
231− { model with
232− Page = Chat(pk, "")
233− Messages = model.Messages |> appendMessage pk outMsg }
234−
235− model',
236− [ CmdEnqueue(pk, Envelope.TextMessage(id, body))
237− match model.Profile with
238− | Some profile when neverSentTo -> CmdEnqueue(pk, Envelope.ProfileMessage profile)
239− | _ -> ()
240− saveCmdMsg model' ]
241− | _ -> model, []
242−
243− | StartFlush ->
244− if model.FlushingOutbox then
245− eprintfn "[skrepka] StartFlush: already flushing, skipping"
246− model, []
247− else
248− match trySession model with
249− | Some session ->
250− eprintfn "[skrepka] StartFlush: dispatching flush"
251− { model with FlushingOutbox = true }, [ CmdFlushOutbox session ]
252− | None ->
253− eprintfn "[skrepka] StartFlush: no session"
254− model, []
255−
256− | FlushResult sent ->
257− if sent then
258− match trySession model with
259− | Some session -> model, [ CmdFlushOutbox session ]
260− | None -> { model with FlushingOutbox = false }, []
261− else
262− { model with FlushingOutbox = false }, []
263−
264− | PollResult(events, status, newCursor) ->
265− let retries =
266− if events.IsEmpty && status.StartsWith("poll error") then
267− model.PollRetries + 1
268− else
269− 0
270−
271− let model' =
272− events
273− |> List.fold
274− applyEvent
275− { model with
276− PollStatus = status
277− PollCursor = newCursor
278− PollRetries = retries }
279−
280− model',
281− [ match trySession model' with
282− | Some session -> CmdPoll(session, model'.PollCursor, model'.PollRetries)
283− | None -> ()
284− if not events.IsEmpty then
285− saveCmdMsg model' ]
286−
287− | DoSaveContact ->
288− match model.Page with
289− | AddContact(cpk) when cpk <> "" ->
290− match tryParsePubkey cpk with
291− | Some bytes ->
292− let hex = Crypto.toHex bytes
293−
294− match Map.tryFind hex model.Contacts with
295− | Some e -> model, []
296− | None ->
297− let contact = newContact hex cpk
298−
299− let model' =
300− { model with
301− Contacts = Map.add hex contact model.Contacts
302− Page = Conversations }
303−
304− model', [ saveCmdMsg model' ]
305− | None ->
306− { model with
307− Error = Some "Invalid public key" },
308− []
309− | _ -> model, []
310−
311− | CopyPubKey ->
312− match model.Auth with
313− | Identified(id, _) -> model, [ CmdCopyToClipboard(hexToOb id.PubKeyHex) ]
314− | NoIdentity -> model, []
315−
316− | DismissError -> { model with Error = None }, []
317−
318− | DoPickPhoto -> model, [ CmdPickPhoto ]
319−
320− | PhotoPicked(Some _ as photo) ->
321− match model.Page with
322− | EditProfile(name, bio, _) ->
323− { model with
324− Page = EditProfile(name, bio, photo) },
325− []
326− | _ -> model, []
327− | PhotoPicked None -> model, []
328−
329− | DoSaveProfile ->
330− match model.Page with
331− | EditProfile(name, bio, photo) ->
332− let profile: Profile =
333− { DisplayName = name
334− Bio = bio
335− Photo = photo }
336−
337− { model with
338− Profile = Some profile
339− Page = Settings },
340− [ CmdSaveProfile profile
341− for pk in model.Contacts.Keys do
342− CmdEnqueue(pk, Envelope.ProfileMessage profile) ]
343− | _ -> model, []
344−
345− | StateLoaded(Some identity, Some data, profile) ->
346− let model' =
347− { model with
348− Auth = Identified(identity, Connecting)
349− Contacts = data.Contacts
350− Messages = data.Messages
351− ServerUrl =
352− if data.ServerUrl <> "" then
353− data.ServerUrl
354− else
355− model.ServerUrl
356− PollCursor = data.PollCursor
357− Profile = profile
358− Page = Conversations }
359−
360− model', [ CmdConnect(model'.ServerUrl, identity) ]
361− | StateLoaded(Some identity, None, profile) ->
362− { model with
363− Auth = Identified(identity, Offline)
364− Profile = profile
365− Page = Settings },
366− []
367− | StateLoaded(None, _, _) -> model, []
368−
369− | Search _ -> model, []
370−
371− | KeyboardHeightChanged h -> { model with KeyboardHeight = h }, []
372− | SafeAreaChanged(top, bottom) -> { model with SafeAreaTop = top; SafeAreaBottom = bottom }, []
373−
374− | DoScanQR -> model, [ CmdScanQR ]
375−
376− | QRScanned(Some text) ->
377− match model.Page with
378− | AddContact _ -> { model with Page = AddContact(text) }, []
379− | _ -> model, []
380−
381− | QRScanned None -> model, []
382−
383− // ── mapCmd ──
384−
385− let private log msg = eprintfn $"[skrepka] {msg}"
386−
387− let private getClipboard () =
388− match Avalonia.Application.Current with
389− | null -> None
390− | app ->
391− match app.ApplicationLifetime with
392− | :? Avalonia.Controls.ApplicationLifetimes.IClassicDesktopStyleApplicationLifetime as desktop ->
393− desktop.MainWindow
394− |> Option.ofObj
395− |> Option.bind (fun w -> w.Clipboard |> Option.ofObj)
396− | :? Avalonia.Controls.ApplicationLifetimes.ISingleViewApplicationLifetime as singleView ->
397− singleView.MainView
398− |> Option.ofObj
399− |> Option.bind (fun v -> Avalonia.Controls.TopLevel.GetTopLevel(v) |> Option.ofObj)
400− |> Option.bind (fun tl -> tl.Clipboard |> Option.ofObj)
401− | _ -> None
402−
403− let private getStorageProvider () =
404− match Avalonia.Application.Current with
405− | null -> None
406− | app ->
407− match app.ApplicationLifetime with
408− | :? Avalonia.Controls.ApplicationLifetimes.IClassicDesktopStyleApplicationLifetime as desktop ->
409− desktop.MainWindow |> Option.ofObj |> Option.map (fun w -> w.StorageProvider)
410− | :? Avalonia.Controls.ApplicationLifetimes.ISingleViewApplicationLifetime as singleView ->
411− singleView.MainView
412− |> Option.ofObj
413− |> Option.bind (fun v -> Avalonia.Controls.TopLevel.GetTopLevel(v) |> Option.ofObj)
414− |> Option.map (fun tl -> tl.StorageProvider)
415− | _ -> None
416−
417− let private cropToSquarePng (imageBytes: byte[]) =
418− use skBmp = SkiaSharp.SKBitmap.Decode(imageBytes)
419− let size = min skBmp.Width skBmp.Height
420− let x = (skBmp.Width - size) / 2
421− let y = (skBmp.Height - size) / 2
422− use cropped = new SkiaSharp.SKBitmap(size, size)
423−
424− skBmp.ExtractSubset(cropped, SkiaSharp.SKRectI(x, y, x + size, y + size))
425− |> ignore
426−
427− use img = SkiaSharp.SKImage.FromBitmap(cropped)
428− use data = img.Encode(SkiaSharp.SKEncodedImageFormat.Png, 90)
429− data.ToArray()
430−
431−#if MOBILE
432− let private scanQRCmd =
433− Cmd.ofEffect (fun dispatch ->
434− task {
435− try
436− let! result = Skrepka.iOS.QRScanner.scan ()
437− dispatch (QRScanned result)
438− with ex ->
439− log $"QR scan error: {ex.Message}"
440− dispatch (QRScanned None)
441− }
442− |> ignore)
443−
444− let private pickPhotoCmd =
445− Cmd.ofEffect (fun dispatch ->
446− task {
447− try
448− let! bytes = Skrepka.iOS.PhotoPicker.pick ()
449−
450− match bytes with
451− | Some b -> dispatch (PhotoPicked(Some(cropToSquarePng b)))
452− | None -> dispatch (PhotoPicked None)
453− with ex ->
454− log $"photo pick error: {ex.Message}"
455− dispatch (PhotoPicked None)
456− }
457− |> ignore)
458−#else
459− let private scanQRCmd =
460− Cmd.ofEffect (fun dispatch ->
461− Avalonia.Threading.Dispatcher.UIThread.InvokeAsync(fun () ->
462− task {
463− try
464− match getStorageProvider () with
465− | Some sp ->
466− let opts =
467− Avalonia.Platform.Storage.FilePickerOpenOptions(
468− AllowMultiple = false,
469− Title = "Select QR Code Image",
470− FileTypeFilter =
471− [ Avalonia.Platform.Storage.FilePickerFileType(
472− "Images",
473− Patterns = [ "*.png"; "*.jpg"; "*.jpeg"; "*.gif"; "*.bmp" ]
474− ) ]
475− )
476−
477− let! files = sp.OpenFilePickerAsync(opts)
478−
479− match files |> Seq.tryHead with
480− | None -> dispatch (QRScanned None)
481− | Some file ->
482− use! stream = file.OpenReadAsync()
483− use ms = new MemoryStream()
484− do! stream.CopyToAsync(ms)
485−
486− use bitmap = SkiaSharp.SKBitmap.Decode(ms.ToArray())
487− let reader = ZXing.SkiaSharp.BarcodeReader()
488− let result = reader.Decode(bitmap)
489−
490− if isNull result then
491− dispatch (QRScanned None)
492− else
493− dispatch (QRScanned(Some result.Text))
494− | None -> dispatch (QRScanned None)
495− with ex ->
496− log $"QR scan error: {ex.Message}"
497− dispatch (QRScanned None)
498− }
499− :> System.Threading.Tasks.Task)
500− |> ignore)
501−
502− let private pickPhotoCmd =
503− Cmd.ofEffect (fun dispatch ->
504− Avalonia.Threading.Dispatcher.UIThread.InvokeAsync(fun () ->
505− task {
506− try
507− match getStorageProvider () with
508− | Some sp ->
509− let opts =
510− Avalonia.Platform.Storage.FilePickerOpenOptions(
511− AllowMultiple = false,
512− Title = "Pick Photo",
513− FileTypeFilter =
514− [ Avalonia.Platform.Storage.FilePickerFileType(
515− "Images",
516− Patterns = [ "*.png"; "*.jpg"; "*.jpeg"; "*.gif"; "*.bmp" ]
517− ) ]
518− )
519−
520− let! files = sp.OpenFilePickerAsync(opts)
521−
522− match files |> Seq.tryHead with
523− | None -> dispatch (PhotoPicked None)
524− | Some file ->
525− use! stream = file.OpenReadAsync()
526− use ms = new MemoryStream()
527− do! stream.CopyToAsync(ms)
528− dispatch (PhotoPicked(Some(cropToSquarePng (ms.ToArray()))))
529− | None -> dispatch (PhotoPicked None)
530− with ex ->
531− log $"photo pick error: {ex.Message}"
532− dispatch (PhotoPicked None)
533− }
534− :> System.Threading.Tasks.Task)
535− |> ignore)
536−#endif
537−
538− let mapCmd cmdMsg =
539− match cmdMsg with
540− | CmdConnect(url, identity) ->
541− Cmd.OfAsync.either (fun (url, id) -> authenticate url id) (url, identity) AuthOk (fun ex ->
542− AuthErr ex.Message)
543−
544− | CmdEnqueue(recipientHex, envelope) ->
545− Cmd.ofEffect (fun dispatch ->
546− async {
547− let ts = DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()
548− let json = serializeEnvelope ts envelope
549− do! Store.enqueueOutbox recipientHex json
550− dispatch StartFlush
551− }
552− |> Async.Start)
553−
554− | CmdFlushOutbox session ->
555− Cmd.ofEffect (fun dispatch ->
556− async {
557− match! Store.peekOutbox () with
558− | Some item ->
559− log $"flush: sending to {item.RecipientHex.[..7]}..."
560− try
561− let blobOpt =
562− Crypto.encrypt
563− session.Identity.PrivKey
564− (Crypto.fromHex item.RecipientHex)
565− item.EnvelopeJson
566−
567− match blobOpt with
568− | Some blob ->
569− log $"flush: encrypted, posting to {session.Url}/messages"
570− do! sendMessage session.Url session.Token item.RecipientHex (Crypto.toHex blob)
571− log "flush: sent OK"
572− do! Store.dequeueOutbox item.Id
573− dispatch (FlushResult true)
574− | None ->
575− log $"outbox encrypt failed, dropping message to {item.RecipientHex}"
576− do! Store.dequeueOutbox item.Id
577− dispatch (FlushResult true)
578− with
579− | Unauthorized ->
580− log "outbox unauthorized, reauthenticating"
581− dispatch TokenExpired
582− | ServerRejected msg ->
583− log $"outbox rejected, dropping: {msg}"
584− do! Store.dequeueOutbox item.Id
585− dispatch (FlushResult true)
586− | ex ->
587− log $"outbox send error: {ex.Message}"
588− do! Async.Sleep Constants.outboxRetryDelayMs
589− dispatch (FlushResult true)
590− | None -> dispatch (FlushResult false)
591− }
592− |> Async.Start)
593−
594− | CmdPoll(session, cursor, retries) ->
595− Cmd.ofEffect (fun dispatch ->
596− async {
597− log $"poll start cursor={cursor}"
598−
599− try
600− let! response = poll session.Url session.Token cursor
601− log $"poll response: {response.Events.Length} events, cursor={response.Cursor}"
602−
603− let results =
604− response.Events
605− |> Array.map (fun evt -> decryptEvent session.Identity.PrivKey evt)
606−
607− let events = results |> Array.choose Result.toOption |> Array.toList
608−
609− let errors =
610− results
611− |> Array.choose (function
612− | Error e -> Some e
613− | _ -> None)
614− |> Array.toList
615−
616− for e in errors do
617− log $"decrypt error: {e}"
618−
619− if not events.IsEmpty then
620− let acksBySender =
621− events
622− |> List.choose (fun evt ->
623− match evt.Envelope with
624− | Envelope.TextMessage(id, _) -> Some(evt.Sender, id)
625− | _ -> None)
626− |> List.groupBy fst
627− |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)
628−
629− for sender, msgIds in acksBySender do
630− try
631− do! sendEnvelope session sender (Envelope.DeliveryAck msgIds)
632− with ex ->
633− log $"delivery ack error: {ex.Message}"
634−
635− let chatCount =
636− events
637− |> List.sumBy (fun e ->
638− match e.Envelope with
639− | Envelope.TextMessage _ -> 1
640− | _ -> 0)
641−
642− let status =
643− $"evts:{response.Events.Length} msgs:{chatCount} errs:{errors.Length}"
644− + (match List.tryHead errors with
645− | Some e -> $" [{e}]"
646− | None -> "")
647−
648− dispatch (PollResult(events, status, response.Cursor))
649− with
650− | :? TimeoutException ->
651− log "poll timeout"
652− dispatch (PollResult([], "polling...", cursor))
653− | Unauthorized ->
654− log "poll unauthorized, reauthenticating"
655− dispatch TokenExpired
656− | ex ->
657− log $"poll error: {ex.Message}"
658− let delay = min (Constants.pollRetryBaseMs * (pown 2 retries)) 30000
659− do! Async.Sleep delay
660− dispatch (PollResult([], $"poll error: {ex.Message}", cursor))
661− }
662− |> Async.Start)
663−
664− | CmdCopyToClipboard text ->
665− Cmd.ofEffect (fun _ ->
666− match getClipboard () with
667− | Some clipboard -> clipboard.SetTextAsync(text) |> ignore
668− | None -> ())
669−
670− | CmdLoadState ->
671− Cmd.OfAsync.perform
672− (fun () ->
673− async {
674− match! Store.loadIdentity () with
675− | Some id ->
676− let! data = Store.loadData ()
677− let! profile = Store.loadProfile ()
678− return (Some id, data, profile)
679− | None -> return (None, None, None)
680− })
681− ()
682− StateLoaded
683−
684− | CmdSaveIdentity identity -> Cmd.ofEffect (fun _ -> Store.saveIdentity identity |> Async.Start)
685−
686− | CmdSaveData data -> Cmd.ofEffect (fun _ -> Store.saveData data |> Async.Start)
687−
688− | CmdPickPhoto -> pickPhotoCmd
689−
690− | CmdScanQR -> scanQRCmd
691−
692− | CmdSaveProfile profile -> Cmd.ofEffect (fun _ -> Store.saveProfile profile |> Async.Start)
693−
694− | CmdSubscribeKeyboard ->
695− Cmd.ofEffect (fun dispatch -> Keyboard.heightChanged.Add(fun h -> dispatch (KeyboardHeightChanged h)))
696−
697− | CmdSubscribeSafeArea ->
698− Cmd.ofEffect (fun dispatch -> SafeArea.insetsChanged.Add(fun (t, b) -> dispatch (SafeAreaChanged(t, b))))
699−
700− // ── View ──
701−
702− let private pageContent model =
703− let page =
704− match model.Page with
705− | Setup -> AnyView(viewSetup ())
706− | Settings -> AnyView(viewSettings model)
707− | Conversations -> AnyView(viewConversations model)
708− | Chat(pk, compose) -> AnyView(viewChat model pk compose)
709− | AddContact(pk) -> AnyView(viewAddContact model pk)
710− | EditProfile(displayName, bio, photo) -> AnyView(viewEditProfile model displayName bio photo)
711−
712− Border(page)
713− .background(SolidColorBrush(Colors.White))
714− .padding (Avalonia.Thickness(0., model.SafeAreaTop, 0., model.KeyboardHeight))
715−
716− let view model =
717−#if MOBILE
718− SingleViewApplication(pageContent model)
719−#else
720− DesktopApplication() {
721− Window(pageContent model)
722− .title("Skrepka")
723− .icon("avares://Skrepka/Assets/Images/logo.png")
724− .width(450.)
725− .height (750.)
726− }
727−#endif
728−
729− let program = Program.statefulWithCmdMsg init update mapCmd |> Program.withView view
730−
731− let create () =
732− FabulousAppBuilder.Configure(FluentTheme, program)