7b4b58d · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Simplify and improve type safety: inline gossip predicates, deduplicate remote servers

7b4b58diko6 months ago

client/App.fs+36−50

compare with master

unifiedsplit

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

24 | Chat of pubkey: string * compose: string

25 | AddContact of pubkey: string * nickname: string

26 | Settings

27− | EditProfile of displayName: string * bio: string * photo: string option

27+ | EditProfile of displayName: string * bio: string * photo: string

29 type Session = { Url: string; Token: string; Identity: Identity }

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

40 type DecryptedEvent =

41 | IncomingChat of senderPubkey: string * message: ChatMessage

42 | IncomingDeliveryAck of senderPubkey: string * ackIds: string list

43− | IncomingProfile of senderPubkey: string * displayName: string * bio: string * photo: string option

43+ | IncomingProfile of senderPubkey: string * displayName: string * bio: string * photo: string

45 type PollReceived = { Events: int; Messages: int; Errors: int; FirstError: string option }

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

56 { Page: Page

57 Auth: AuthState

58 ServerUrl: string

59− Contacts: Contact list

59+ Contacts: Map<string, Contact>

60 PollStatus: PollStatus

61 Messages: Map<string, ChatMessage list>

62 Error: string option

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

92 | SetProfileDisplayName of string

93 | SetProfileBio of string

94 | DoPickPhoto

95− | PhotoPicked of string option

95+ | PhotoPicked of string

96 | DoSaveProfile

98 // ── CmdMsg ──

@@ -130,10 +130,10 @@ module App =

130 |> Option.orElseWith (fun () -> Crypto.tryFromHex input)

131 |> Option.filter (fun bytes -> bytes.Length = 32)

132

133− let private contactName (contacts: Contact list) (pk: string) =

133+ let private contactName (contacts: Map<string, Contact>) (pk: string) =

134 let fallback = truncKey pk

135 contacts

136− |> List.tryFind (fun c -> c.Pubkey = pk)

136+ |> Map.tryFind pk

137 |> Option.map (fun c ->

138 if c.Nickname <> fallback then c.Nickname

139 elif c.DisplayName <> "" then c.DisplayName

@@ -156,15 +156,6 @@ module App =

156 |> fun updated -> Map.add pk updated messages

157 | None -> messages

158

159− let private addContactIfNew (contact: Contact) (contacts: Contact list) =

160− if contacts |> List.exists (fun c -> c.Pubkey = contact.Pubkey) then contacts

161− else contacts @ [ contact ]

162−

163− let private upsertContact (contact: Contact) (contacts: Contact list) =

164− match contacts |> List.tryFindIndex (fun c -> c.Pubkey = contact.Pubkey) with

165− | Some i -> contacts |> List.updateAt i contact

166− | None -> contacts @ [ contact ]

167−

168 let private newContact pubkey nickname : Contact =

159 let private newContact pubkey nickname : Contact =

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

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

170

161

@@ -193,7 +184,7 @@ module App =

193 Auth = NoIdentity

184 Auth = NoIdentity

194 ServerUrl = "http://localhost:8080"

185 ServerUrl = "http://localhost:8080"

195 PollStatus = Idle

186 PollStatus = Idle

196− Contacts = []

187+ Contacts = Map.empty

197 Messages = Map.empty

188 Messages = Map.empty

198 Error = None

189 Error = None

199 PollCursor = 0L

190 PollCursor = 0L

@@ -281,18 +272,17 @@ module App =

281 match evt with

272 match evt with

282 | IncomingChat(senderPubkey, message) ->

273 | IncomingChat(senderPubkey, message) ->

283 { m with

274 { m with

275+ Contacts =

276+ if Map.containsKey senderPubkey m.Contacts then m.Contacts

284− Contacts = m.Contacts |> addContactIfNew (newContact senderPubkey (truncKey senderPubkey))

277+ else Map.add senderPubkey (newContact senderPubkey (truncKey senderPubkey)) m.Contacts

285 Messages = m.Messages |> appendMessage senderPubkey message }

278 Messages = m.Messages |> appendMessage senderPubkey message }

286 | IncomingDeliveryAck(senderPubkey, ackIds) ->

279 | IncomingDeliveryAck(senderPubkey, ackIds) ->

287 { m with Messages = m.Messages |> markDelivered senderPubkey ackIds }

280 { m with Messages = m.Messages |> markDelivered senderPubkey ackIds }

288 | IncomingProfile(senderPubkey, displayName, bio, photo) ->

281 | IncomingProfile(senderPubkey, displayName, bio, photo) ->

289 { m with

282 { m with

290 Contacts =

283 Contacts =

291− m.Contacts

284+ m.Contacts |> Map.change senderPubkey (Option.map (fun c ->

292− |> List.map (fun c ->

293− if c.Pubkey = senderPubkey then

294− { c with DisplayName = displayName; Bio = bio; PhotoBase64 = photo |> Option.defaultValue "" }

285+ { c with DisplayName = displayName; Bio = bio; PhotoBase64 = photo })) })

295− else c) })

296 { model with PollStatus = status; PollCursor = newCursor }

286 { model with PollStatus = status; PollCursor = newCursor }

297

287

298 model',

288 model',

@@ -307,15 +297,14 @@ module App =

307 match tryParsePubkey cpk with

297 match tryParsePubkey cpk with

308 | Some bytes ->

298 | Some bytes ->

309 let hex = Crypto.toHex bytes

299 let hex = Crypto.toHex bytes

310− let existing = model.Contacts |> List.tryFind (fun c -> c.Pubkey = hex)

311− let contact: Contact =

300+ let contact =

312− match existing with

301+ match Map.tryFind hex model.Contacts with

313 | Some e -> { e with Nickname = cnn }

302 | Some e -> { e with Nickname = cnn }

314 | None -> newContact hex cnn

303 | None -> newContact hex cnn

315

304

316 let model' =

305 let model' =

317 { model with

306 { model with

318− Contacts = model.Contacts |> upsertContact contact

307+ Contacts = Map.add hex contact model.Contacts

319 Page = Conversations }

308 Page = Conversations }

320

309

321 model', [ saveCmdMsg model' ]

310 model', [ saveCmdMsg model' ]

@@ -353,7 +342,7 @@ module App =

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

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

354 [ CmdSaveProfile profile

343 [ CmdSaveProfile profile

355 match trySession model with

344 match trySession model with

356− | Some session -> CmdSendProfileToAll(session, profile, model.Contacts |> List.map _.Pubkey)

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

357 | None -> () ]

346 | None -> () ]

358 | _ -> model, []

347 | _ -> model, []

359

348

@@ -385,7 +374,7 @@ module App =

385 type private Envelope =

374 type private Envelope =

386 | TextMessage of id: string * body: string

375 | TextMessage of id: string * body: string

387 | DeliveryAck of id: string * ackIds: string list

376 | DeliveryAck of id: string * ackIds: string list

388− | ProfileMessage of id: string * displayName: string * bio: string * photo: string option

377+ | ProfileMessage of id: string * displayName: string * bio: string * photo: string

389

378

390 let private serializeEnvelope = function

379 let private serializeEnvelope = function

391 | TextMessage(id, body) ->

380 | TextMessage(id, body) ->

@@ -393,7 +382,7 @@ module App =

393 | DeliveryAck(id, ackIds) ->

382 | DeliveryAck(id, ackIds) ->

394 JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = id; ack_ids = ackIds |})

383 JsonSerializer.Serialize({| ``type`` = "delivery.ack"; id = id; ack_ids = ackIds |})

395 | ProfileMessage(id, displayName, bio, photo) ->

384 | ProfileMessage(id, displayName, bio, photo) ->

396− JsonSerializer.Serialize({| ``type`` = "profile"; id = id; timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = displayName; bio = bio; photo = (photo |> Option.defaultValue null) |})

385+ JsonSerializer.Serialize({| ``type`` = "profile"; id = id; timestamp = DateTimeOffset.UtcNow.ToUnixTimeSeconds(); display_name = displayName; bio = bio; photo = photo |})

397

386

398 let private sendEnvelope (session: Session) (recipientHex: string) (envelope: Envelope) =

387 let private sendEnvelope (session: Session) (recipientHex: string) (envelope: Envelope) =

399 async {

388 async {

@@ -420,7 +409,7 @@ module App =

420 | "profile" ->

409 | "profile" ->

421 let displayName = root.GetProperty("display_name").GetString()

410 let displayName = root.GetProperty("display_name").GetString()

422 let bio = tryGetJsonString root "bio" |> Option.defaultValue ""

411 let bio = tryGetJsonString root "bio" |> Option.defaultValue ""

423− let photo = tryGetJsonString root "photo"

412+ let photo = tryGetJsonString root "photo" |> Option.defaultValue ""

424 Some(ProfileMessage(root.GetProperty("id").GetString(), displayName, bio, photo))

413 Some(ProfileMessage(root.GetProperty("id").GetString(), displayName, bio, photo))

425 | _ -> None

414 | _ -> None

426

415

@@ -487,17 +476,15 @@ module App =

487 let! response = poll session.Url session.Token cursor

476 let! response = poll session.Url session.Token cursor

488 let ackIds = response.Events |> Array.map _.Id |> Array.toList

477 let ackIds = response.Events |> Array.map _.Id |> Array.toList

489

478

490− let events, errors =

479+ let results =

491− Array.foldBack

480+ response.Events

492− (fun (evt: PollEvent) (evts, errs) ->

481+ |> Array.choose (fun evt ->

493− match evt.EventType with

482+ match evt.EventType with

494− | Message ->

495− match decryptEvent session.Identity.PrivKey evt.Payload with

483+ | Message -> Some(decryptEvent session.Identity.PrivKey evt.Payload)

496− | Ok event -> (event :: evts, errs)

484+ | UnknownEvent _ -> None)

497− | Error err -> (evts, err :: errs)

485+

498− | UnknownEvent _ -> (evts, errs))

486+ let events = results |> Array.choose (function Ok e -> Some e | _ -> None) |> Array.toList

499− response.Events

487+ let errors = results |> Array.choose (function Error e -> Some e | _ -> None) |> Array.toList

500− ([], [])

501

488

502 if not ackIds.IsEmpty then

489 if not ackIds.IsEmpty then

503 try do! ackMessages session.Url session.Token ackIds

490 try do! ackMessages session.Url session.Token ackIds

@@ -544,14 +531,14 @@ module App =

544 try

531 try

545 let! results = Microsoft.Maui.Media.MediaPicker.Default.PickPhotosAsync() |> Async.AwaitTask

532 let! results = Microsoft.Maui.Media.MediaPicker.Default.PickPhotosAsync() |> Async.AwaitTask

546 match results |> Seq.tryHead with

533 match results |> Seq.tryHead with

547− | None -> return PhotoPicked None

534+ | None -> return PhotoPicked ""

548 | Some file ->

535 | Some file ->

549 use! stream = file.OpenReadAsync() |> Async.AwaitTask

536 use! stream = file.OpenReadAsync() |> Async.AwaitTask

550 use ms = new MemoryStream()

537 use ms = new MemoryStream()

551 do! stream.CopyToAsync(ms) |> Async.AwaitTask

538 do! stream.CopyToAsync(ms) |> Async.AwaitTask

552− return PhotoPicked(Some(Convert.ToBase64String(ms.ToArray())))

539+ return PhotoPicked(Convert.ToBase64String(ms.ToArray()))

553 with _ ->

540 with _ ->

554− return PhotoPicked None

541+ return PhotoPicked ""

555 })

542 })

556

543

557 | CmdSaveProfile profile ->

544 | CmdSaveProfile profile ->

@@ -623,7 +610,7 @@ module App =

623 let displayName, bio, photo =

610 let displayName, bio, photo =

624 match model.Profile with

611 match model.Profile with

625 | Some p -> p.DisplayName, p.Bio, p.PhotoBase64

612 | Some p -> p.DisplayName, p.Bio, p.PhotoBase64

626− | None -> "", "", None

613+ | None -> "", "", ""

627 if displayName <> "" then

614 if displayName <> "" then

628 Label($"Name: {displayName}").font(size = 14.)

615 Label($"Name: {displayName}").font(size = 14.)

629 if bio <> "" then

616 if bio <> "" then

@@ -673,7 +660,7 @@ module App =

673 .centerTextHorizontal()

660 .centerTextHorizontal()

674 .textColor(Colors.Gray)

661 .textColor(Colors.Gray)

675

662

676− for c in model.Contacts do

663+ for c in model.Contacts.Values do

677 let preview =

664 let preview =

678 messagesFor c.Pubkey model.Messages

665 messagesFor c.Pubkey model.Messages

679 |> List.tryLast

666 |> List.tryLast

@@ -759,13 +746,12 @@ module App =

759

746

760 viewErrorBanner model.Error

747 viewErrorBanner model.Error

761

748

762− match photo with

749+ if photo <> "" then

763− | Some p when p <> "" ->

764− Image(new MemoryStream(Convert.FromBase64String(p)) :> Stream)

750+ Image(new MemoryStream(Convert.FromBase64String(photo)) :> Stream)

765 .width(120.)

751 .width(120.)

766 .height(120.)

752 .height(120.)

767 .centerHorizontal()

753 .centerHorizontal()

768− | _ ->

754+ else

769 Label("No Photo")

755 Label("No Photo")

770 .font(size = 16.)

756 .font(size = 16.)

771 .centerTextHorizontal()

757 .centerTextHorizontal()

client/Store.fs+7−6

@@ -18,7 +18,7 @@ module Store =

18 type Profile =

19 { DisplayName: string

20 Bio: string

21− PhotoBase64: string option }

21+ PhotoBase64: string }

23 [<RequireQualifiedAccess>]

24 type DeliveryStatus = Sent | Delivered

@@ -31,7 +31,7 @@ module Store =

31 Status: DeliveryStatus }

33 type Data =

34− { Contacts: Contact list

34+ { Contacts: Map<string, Contact>

35 Messages: Map<string, ChatMessage list>

36 ServerUrl: string option

37 PollCursor: int64 }

@@ -93,7 +93,7 @@ module Store =

93 |> Option.map (fun p ->

94 { DisplayName = p.DisplayName |> Option.ofObj |> Option.defaultValue ""

95 Bio = p.Bio |> Option.ofObj |> Option.defaultValue ""

96− PhotoBase64 = p.PhotoBase64 |> Option.ofObj })

96+ PhotoBase64 = p.PhotoBase64 |> Option.ofObj |> Option.defaultValue "" })

97 with _ -> None

99 let saveProfile (profile: Profile) =

@@ -103,7 +103,7 @@ module Store =

103 { Id = "me"

104 DisplayName = profile.DisplayName

105 Bio = profile.Bio

106− PhotoBase64 = profile.PhotoBase64 |> Option.defaultValue null }

106+ PhotoBase64 = profile.PhotoBase64 }

107 |> ignore

108 with _ -> ()

109

@@ -122,7 +122,8 @@ module Store =

122 DisplayName = c.DisplayName |> Option.ofObj |> Option.defaultValue ""

123 Bio = c.Bio |> Option.ofObj |> Option.defaultValue ""

124 PhotoBase64 = c.PhotoBase64 |> Option.ofObj |> Option.defaultValue "" })

125− |> Seq.toList

125+ |> Seq.map (fun c -> c.Pubkey, c)

126+ |> Map.ofSeq

126

127

127 let messages =

128 let messages =

128 db.GetCollection<MessageDoc>("messages").FindAll()

129 db.GetCollection<MessageDoc>("messages").FindAll()

@@ -145,7 +146,7 @@ module Store =

145 let messages = db.GetCollection<MessageDoc>("messages")

146 let messages = db.GetCollection<MessageDoc>("messages")

146 let settings = db.GetCollection<SettingsDoc>("settings")

147 let settings = db.GetCollection<SettingsDoc>("settings")

147

148

148− for c in data.Contacts do

149+ for c in data.Contacts.Values do

149 contacts.Upsert c |> ignore

150 contacts.Upsert c |> ignore

150

151

151 data.Messages

152 data.Messages

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.dll

Binary file not shown.

client/bin/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.pdb

Binary file not shown.

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+50200f4e8cc7b94c2acf338b402efe56d4dce414")>]

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

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−8af8c70485fb6088d5df97530926c75e310135762195922457d0a7e470636584

1+ce21a6c11004b9877da85245c10ed4a19bfe33da82c2f55d2943c6c7b8845665

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.pdb

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/Skrepka.sourcelink.json+1−1

@@ -1 +1 @@

1−{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/50200f4e8cc7b94c2acf338b402efe56d4dce414/*"}}

1+{"documents":{"/Users/iko/Developer/skrepka/*":"https://raw.githubusercontent.com/ilyakooo0/skrepka/26d71bfd7b4764c7381338d2d47a0b86c18d9a9b/*"}}

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/ref/Skrepka.dll

Binary file not shown.

client/obj/Debug/net10.0-maccatalyst/maccatalyst-arm64/refint/Skrepka.dll

Binary file not shown.

server.knot+11−13

@@ -70,10 +70,6 @@ impl FromJSON GossipEventType where

70 else if s == "offline" then GossipOffline {}

71 else GossipUnknown {}

73−isGossipOnline = \et -> case et of GossipOnline {} -> True {}; _ -> False {}

74−isGossipOffline = \et -> case et of GossipOffline {} -> True {}; _ -> False {}

75−isGossipUnknown = \et -> case et of GossipUnknown {} -> True {}; _ -> False {}

76−

77type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}

73type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}

79type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}

75type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}

@@ -523,12 +519,14 @@ countMessagesFor = \messages toKey t ->

523validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]

519validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]

524validGossipEvents = \events t -> do

520validGossipEvents = \events t -> do

525 e <- events

521 e <- events

526− where not (isGossipUnknown e.eventType)

522+ case e.eventType of

523+ GossipUnknown {} -> []

524+ _ -> do

527− where e.server != serverHostN && e.timestamp <= t + clockSkewTolerance

525+ where e.server != serverHostN && e.timestamp <= t + clockSkewTolerance

528− let ttl = clampTtl e.ttl

526+ let ttl = clampTtl e.ttl

529− let expiresAt = e.timestamp + ttl * 1000

527+ let expiresAt = e.timestamp + ttl * 1000

530− where expiresAt > t

528+ where expiresAt > t

531− yield {eventType: e.eventType, pubkey: e.pubkey, server: e.server, expiresAt: expiresAt, timestamp: e.timestamp, ttl: ttl}

529+ yield {eventType: e.eventType, pubkey: e.pubkey, server: e.server, expiresAt: expiresAt, timestamp: e.timestamp, ttl: ttl}

532

530

533sendToEach : [ServerName] -> (ServerName -> (a {})) -> a {}

531sendToEach : [ServerName] -> (ServerName -> (a {})) -> a {}

534sendToEach = \servers action ->

532sendToEach = \servers action ->

@@ -850,7 +848,7 @@ serve = \req -> case req of

850 encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: LocalOrigin {}, receivedAt: seqTs}]

848 encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: LocalOrigin {}, receivedAt: seqTs}]

851 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p

849 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p

852 let localOnline = any toPresence (\p -> p.server == serverHostN)

850 let localOnline = any toPresence (\p -> p.server == serverHostN)

853− let remoteServers = do p <- toPresence; where p.server != serverHostN; yield p.server

851+ let remoteServers = collectPeerServers toPresence (\p -> p.server)

854 forwards <- *forwards

852 forwards <- *forwards

855 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)

853 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)

856 let shouldForward = federationEnabled && count forwardServers > 0

854 let shouldForward = federationEnabled && count forwardServers > 0

@@ -950,8 +948,8 @@ serve = \req -> case req of

950 then rejectFederation t respond

948 then rejectFederation t respond

951 else do

949 else do

952 let allValidEntries = validGossipEvents events t

950 let allValidEntries = validGossipEvents events t

953− let onlineEntries = do e <- allValidEntries; where isGossipOnline e.eventType; yield e

951+ let onlineEntries = do e <- allValidEntries; case e.eventType of GossipOnline {} -> yield e; _ -> []

954− let trustedOffline = do e <- allValidEntries; where isGossipOffline e.eventType && e.server == fromServer; yield e

952+ let trustedOffline = do e <- allValidEntries; case e.eventType of GossipOffline {} -> do where e.server == fromServer; yield e; _ -> []

955 let filteredOnline = resolveByTimestamp onlineEntries trustedOffline

953 let filteredOnline = resolveByTimestamp onlineEntries trustedOffline

956 let filteredOffline = resolveByTimestamp trustedOffline onlineEntries

954 let filteredOffline = resolveByTimestamp trustedOffline onlineEntries

957 let deduped = mergeByPubkeyServer [] filteredOnline

955 let deduped = mergeByPubkeyServer [] filteredOnline