25ba3b8 · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Improve type safety: use MessageDirection discriminated union, simplify polling

25ba3b8iko6 months ago

README.md+4

compare with master

unifiedsplit

@@ -1,5 +1,9 @@

1# Skrepka

3+<p align="center">

4+ <img src="client/Resources/Images/logo.png" width="300px" align="center">

5+</p>

3Decentralized, end-to-end encrypted messaging with no accounts and no home servers. See [PROTOCOL.md](PROTOCOL.md) for the full specification.

7Decentralized, end-to-end encrypted messaging with no accounts and no home servers. See [PROTOCOL.md](PROTOCOL.md) for the full specification.

5## Install the relay server

9## Install the relay server

client/App.fs+40−51

@@ -70,7 +70,7 @@ module App =

70 | DoSend

71 | SendFailed of string

72 | DoSaveContact

73− | PollResult of events: IncomingEvent list * ackIds: string list * status: string * cursor: int64

73+ | PollResult of events: IncomingEvent list * status: string * cursor: int64

74 | CopyPubKey

75 | DismissError

76 | StateLoaded of Identity option * Data option * Profile option

@@ -84,14 +84,12 @@ module App =

84 | CmdConnect of url: string * identity: Identity

85 | CmdSend of session: Session * recipientHex: string * envelope: Envelope

86 | CmdPoll of session: Session * cursor: int64

87− | CmdAckAndDeliver of session: Session * ackIds: string list * events: IncomingEvent list

88 | CmdCopyToClipboard of string

87 | CmdCopyToClipboard of string

89 | CmdLoadState

88 | CmdLoadState

90 | CmdSaveIdentity of Identity

89 | CmdSaveIdentity of Identity

91 | CmdSaveData of Data

90 | CmdSaveData of Data

92 | CmdPickPhoto

91 | CmdPickPhoto

93 | CmdSaveProfile of Profile

92 | CmdSaveProfile of Profile

94− | CmdSendProfileToAll of session: Session * Profile * recipientHexes: string list

96 // ── Helpers ──

94 // ── Helpers ──

@@ -127,7 +125,9 @@ module App =

127 let private markDelivered (pk: string) (ackIds: string list) (messages: Map<string, ChatMessage list>) =

125 let private markDelivered (pk: string) (ackIds: string list) (messages: Map<string, ChatMessage list>) =

128 let ackSet = Set.ofList ackIds

126 let ackSet = Set.ofList ackIds

129 messages |> Map.change pk (Option.map (List.map (fun m ->

127 messages |> Map.change pk (Option.map (List.map (fun m ->

128+ match m.Direction with

130− if m.IsOutgoing && Set.contains m.Id ackSet then { m with Status = DeliveryStatus.Delivered } else m)))

129+ | Outgoing _ when Set.contains m.Id ackSet -> { m with Direction = Outgoing DeliveryStatus.Delivered }

130+ | _ -> m)))

131

132 let private newContact pubkey nickname : Contact =

133 { Pubkey = pubkey; Nickname = nickname; DisplayName = ""; Bio = ""; PhotoBase64 = "" }

@@ -139,8 +139,7 @@ module App =

139 match evt.Envelope with

140 | Envelope.TextMessage(id, body) ->

141 let message =

142− { Id = id; Body = body; Timestamp = evt.Timestamp

142+ { Id = id; Body = body; Timestamp = evt.Timestamp; Direction = Incoming }

143− IsOutgoing = false; Status = DeliveryStatus.Delivered }

144 { m with

143 { m with

145 Contacts =

144 Contacts =

146 if Map.containsKey evt.Sender m.Contacts then m.Contacts

145 if Map.containsKey evt.Sender m.Contacts then m.Contacts

@@ -222,8 +221,7 @@ module App =

222 { Id = id

221 { Id = id

223 Body = compose

222 Body = compose

224 Timestamp = DateTimeOffset.UtcNow

223 Timestamp = DateTimeOffset.UtcNow

225− IsOutgoing = true

226− Status = DeliveryStatus.Sent }

224+ Direction = Outgoing DeliveryStatus.Sent }

227

225

228 let isFirstInteraction = model.Messages |> messagesFor pk |> List.isEmpty

226 let isFirstInteraction = model.Messages |> messagesFor pk |> List.isEmpty

229

227

@@ -235,22 +233,19 @@ module App =

235 model',

233 model',

236 [ CmdSend(session, pk, Envelope.TextMessage(id, compose))

234 [ CmdSend(session, pk, Envelope.TextMessage(id, compose))

237 saveCmdMsg model'

235 saveCmdMsg model'

238− match model.Profile, isFirstInteraction with

236+ match model.Profile with

239− | Some profile, true -> CmdSendProfileToAll(session, profile, [ pk ])

237+ | Some profile when isFirstInteraction -> CmdSend(session, pk, Envelope.ProfileMessage profile)

240 | _ -> () ]

238 | _ -> () ]

241 | _ -> model, []

239 | _ -> model, []

242

240

243 | SendFailed err -> { model with Error = Some err }, []

241 | SendFailed err -> { model with Error = Some err }, []

244

242

245− | PollResult(events, ackIds, status, newCursor) ->

243+ | PollResult(events, status, newCursor) ->

246 let model' = events |> List.fold applyEvent { model with PollStatus = status; PollCursor = newCursor }

244 let model' = events |> List.fold applyEvent { model with PollStatus = status; PollCursor = newCursor }

247

245

248 model',

246 model',

249 [ match trySession model' with

247 [ match trySession model' with

250− | Some session ->

251− if not ackIds.IsEmpty || not events.IsEmpty then

252− CmdAckAndDeliver(session, ackIds, events)

253− CmdPoll(session, model'.PollCursor)

248+ | Some session -> CmdPoll(session, model'.PollCursor)

254 | None -> ()

249 | None -> ()

255 if not events.IsEmpty then saveCmdMsg model' ]

250 if not events.IsEmpty then saveCmdMsg model' ]

256

251

@@ -295,7 +290,9 @@ module App =

295 { model with Profile = Some profile; Page = Settings },

290 { model with Profile = Some profile; Page = Settings },

296 [ CmdSaveProfile profile

291 [ CmdSaveProfile profile

297 match trySession model with

292 match trySession model with

298− | Some session -> CmdSendProfileToAll(session, profile, model.Contacts.Keys |> Seq.toList)

293+ | Some session ->

294+ for pk in model.Contacts.Keys do

295+ CmdSend(session, pk, Envelope.ProfileMessage profile)

299 | None -> () ]

296 | None -> () ]

300 | _ -> model, []

297 | _ -> model, []

301

298

@@ -375,19 +372,6 @@ module App =

375 with ex ->

372 with ex ->

376 Error $"parse: {ex.Message}"

373 Error $"parse: {ex.Message}"

377

374

378− let private sendDeliveryAcks (session: Session) (events: IncomingEvent list) =

379− async {

380− let chatsBySender =

381− events

382− |> List.choose (fun evt -> match evt.Envelope with Envelope.TextMessage(id, _) -> Some(evt.Sender, id) | _ -> None)

383− |> List.groupBy fst

384− |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)

385−

386− for sender, msgIds in chatsBySender do

387− try do! sendEnvelope session sender (Envelope.DeliveryAck msgIds)

388− with _ -> ()

389− }

390−

391 let mapCmd cmdMsg =

375 let mapCmd cmdMsg =

392 match cmdMsg with

376 match cmdMsg with

393 | CmdConnect(url, identity) ->

377 | CmdConnect(url, identity) ->

@@ -427,6 +411,22 @@ module App =

427

411

428 for e in errors do log $"decrypt error: {e}"

412 for e in errors do log $"decrypt error: {e}"

429

413

414+ // Fire-and-forget: ack server + send delivery acks

415+ if not ackIds.IsEmpty || not events.IsEmpty then

416+ async {

417+ if not ackIds.IsEmpty then

418+ try do! ackMessages session.Url session.Token ackIds

419+ with _ -> ()

420+ let acksBySender =

421+ events

422+ |> List.choose (fun evt -> match evt.Envelope with Envelope.TextMessage(id, _) -> Some(evt.Sender, id) | _ -> None)

423+ |> List.groupBy fst

424+ |> List.map (fun (sender, pairs) -> sender, List.map snd pairs)

425+ for sender, msgIds in acksBySender do

426+ try do! sendEnvelope session sender (Envelope.DeliveryAck msgIds)

427+ with _ -> ()

428+ } |> Async.Start

429+

430 if response.Events.Length = 0 then

431 do! Async.Sleep 5000

432

@@ -434,26 +434,17 @@ module App =

434 let status =

435 $"evts:{response.Events.Length} msgs:{chatCount} errs:{errors.Length}"

436 + (match List.tryHead errors with Some e -> $" [{e}]" | None -> "")

437− return PollResult(events, ackIds, status, response.Cursor)

437+ return PollResult(events, status, response.Cursor)

438 with

439 | :? TimeoutException ->

440 log "poll timeout"

441− return PollResult([], [], "polling...", cursor)

441+ return PollResult([], "polling...", cursor)

442 | ex ->

443 log $"poll error: {ex.Message}"

444 do! Async.Sleep 3000

445− return PollResult([], [], $"poll error: {ex.Message}", cursor)

445+ return PollResult([], $"poll error: {ex.Message}", cursor)

446 })

447

448− | CmdAckAndDeliver(session, ackIds, events) ->

449− Cmd.ofEffect (fun _ ->

450− async {

451− if not ackIds.IsEmpty then

452− try do! ackMessages session.Url session.Token ackIds

453− with _ -> ()

454− do! sendDeliveryAcks session events

455− } |> Async.Start)

456−

457 | CmdCopyToClipboard text ->

448 | CmdCopyToClipboard text ->

458 Cmd.ofEffect (fun _ ->

449 Cmd.ofEffect (fun _ ->

459 Microsoft.Maui.ApplicationModel.DataTransfer.Clipboard.Default.SetTextAsync(text)

450 Microsoft.Maui.ApplicationModel.DataTransfer.Clipboard.Default.SetTextAsync(text)

@@ -492,14 +483,6 @@ module App =

492 | CmdSaveProfile profile ->

483 | CmdSaveProfile profile ->

493 Cmd.ofEffect (fun _ -> Store.saveProfile profile)

484 Cmd.ofEffect (fun _ -> Store.saveProfile profile)

494

485

495− | CmdSendProfileToAll(session, profile, recipientHexes) ->

496− Cmd.ofEffect (fun _ ->

497− async {

498− for recipientHex in recipientHexes do

499− try do! sendEnvelope session recipientHex (Envelope.ProfileMessage profile)

500− with _ -> ()

501− } |> Async.Start)

502−

503 // ── View ──

486 // ── View ──

504

487

505 let private viewErrorBanner (error: string option) =

488 let private viewErrorBanner (error: string option) =

@@ -514,6 +497,8 @@ module App =

514 let private viewSetup () =

497 let private viewSetup () =

515 ContentPage(

498 ContentPage(

516 (VStack(spacing = 24.) {

499 (VStack(spacing = 24.) {

500+ Image("logo.png")

501+ .margin(8, 0)

517 Label("Skrepka")

502 Label("Skrepka")

518 .font(size = 32.)

503 .font(size = 32.)

519 .centerTextHorizontal()

504 .centerTextHorizontal()

@@ -637,8 +622,12 @@ module App =

637 .font(size = 14.)

622 .font(size = 14.)

638 else

623 else

639 for m in msgs do

624 for m in msgs do

625+ let prefix, tick =

626+ match m.Direction with

640− let tick = if m.IsOutgoing && m.Status = DeliveryStatus.Delivered then " \u2713" else ""

627+ | Outgoing DeliveryStatus.Delivered -> "You: ", " \u2713"

641− Label((if m.IsOutgoing then $"You: {m.Body}" else m.Body) + tick)

628+ | Outgoing _ -> "You: ", ""

629+ | Incoming -> "", ""

630+ Label($"{prefix}{m.Body}{tick}")

642 .padding(8.)

631 .padding(8.)

643 .font(size = 14.)

632 .font(size = 14.)

644

633

logo.png → client/Resources/Images/logo.pngrenamed

Binary file not shown.

client/Store.fs+12−6

@@ -23,12 +23,13 @@ module Store =

23 [<RequireQualifiedAccess>]

24 type DeliveryStatus = Sent | Delivered

26+ type MessageDirection = Incoming | Outgoing of DeliveryStatus

27+

26 type ChatMessage =

28 type ChatMessage =

27 { Id: string

29 { Id: string

28 Body: string

30 Body: string

29 Timestamp: DateTimeOffset

31 Timestamp: DateTimeOffset

30− IsOutgoing: bool

32+ Direction: MessageDirection }

31− Status: DeliveryStatus }

33 type Data =

34 type Data =

34 { Contacts: Map<string, Contact>

35 { Contacts: Map<string, Contact>

@@ -61,12 +62,17 @@ module Store =

61 let private orEmpty s = s |> Option.ofObj |> Option.defaultValue ""

62 let private orEmpty s = s |> Option.ofObj |> Option.defaultValue ""

63 let private toChatMessage (d: MessageDoc) : ChatMessage =

64 let private toChatMessage (d: MessageDoc) : ChatMessage =

64− { Id = d.Id; Body = d.Body; Timestamp = DateTimeOffset.FromUnixTimeMilliseconds d.TimestampUnix; IsOutgoing = d.IsOutgoing

65+ { Id = d.Id; Body = d.Body; Timestamp = DateTimeOffset.FromUnixTimeMilliseconds d.TimestampUnix

65− Status = match d.Status with 1 -> DeliveryStatus.Delivered | _ -> DeliveryStatus.Sent }

66+ Direction = if not d.IsOutgoing then Incoming else Outgoing(match d.Status with 1 -> DeliveryStatus.Delivered | _ -> DeliveryStatus.Sent) }

67 let private toMessageDoc convId (m: ChatMessage) : MessageDoc =

68 let private toMessageDoc convId (m: ChatMessage) : MessageDoc =

69+ let isOutgoing, status =

70+ match m.Direction with

71+ | Incoming -> false, 0

72+ | Outgoing DeliveryStatus.Delivered -> true, 1

73+ | Outgoing DeliveryStatus.Sent -> true, 0

68− { Id = m.Id; ConversationId = convId; Body = m.Body; TimestampUnix = m.Timestamp.ToUnixTimeMilliseconds(); IsOutgoing = m.IsOutgoing

74+ { Id = m.Id; ConversationId = convId; Body = m.Body; TimestampUnix = m.Timestamp.ToUnixTimeMilliseconds()

69− Status = match m.Status with DeliveryStatus.Delivered -> 1 | DeliveryStatus.Sent -> 0 }

75+ IsOutgoing = isOutgoing; Status = status }

71 let private openDb () =

77 let private openDb () =

72 new LiteDatabase(Path.Combine(FileSystem.AppDataDirectory, "skrepka.db"))

78 new LiteDatabase(Path.Combine(FileSystem.AppDataDirectory, "skrepka.db"))

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfo.fs+1−1

@@ -10,7 +10,7 @@ open System.Reflection

10[<assembly: System.Reflection.AssemblyCompanyAttribute("Skrepka")>]

11[<assembly: System.Reflection.AssemblyConfigurationAttribute("Debug")>]

12[<assembly: System.Reflection.AssemblyFileVersionAttribute("1.0.0.0")>]

13−[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+c59feb8711edf67b505121d342f66ed8334f3286")>]

13+[<assembly: System.Reflection.AssemblyInformationalVersionAttribute("1.0+d0650888ccf1bf53219901811eb64b7103e14c67")>]

14[<assembly: System.Reflection.AssemblyProductAttribute("Skrepka")>]

15[<assembly: System.Reflection.AssemblyTitleAttribute("Skrepka")>]

16[<assembly: System.Reflection.AssemblyVersionAttribute("1.0.0.0")>]

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.AssemblyInfoInputs.cache+1−1

@@ -1 +1 @@

1−abd5c34920c568fe50524fa8c3fb57422b4cfa4ad533e1e6507750c8f7cc0873

1+02b5fa3ae3a2beecc1a0aeab16c12023ba39fb11a33f42458f1f8580fa272b24