on master help sign in
Improve type safety: convert MessageStatus to DU with custom JSON serialization, eliminate DeliveryStatus
commit32ef8d27d94c098194e967c81ad2bc33c2c7e1a4 authoriko <mail@iko.soy> dateFri 10 Apr 2026, 19:11 (6 months ago) parent8dcf190
1 file changed+26−14
server.knot+26−14
server.knot+26−14
@@ -69,7 +69,24 @@ type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: Serve
6969
7070type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
7171
72−type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || s == "delivered" || s == "federated" || s == "queued"
72+type MessageStatus = MsUnauthorized {} | MsRejected {} | MsDelivered {} | MsFederated {} | MsQueued {}
73+
74+impl ToJSON MessageStatus where
75+ toJson ms = toJson (case ms of
76+ MsUnauthorized {} -> "unauthorized"
77+ MsRejected {} -> "rejected"
78+ MsDelivered {} -> "delivered"
79+ MsFederated {} -> "federated"
80+ MsQueued {} -> "queued")
81+
82+impl FromJSON MessageStatus where
83+ parseJson t =
84+ let s : Text = parseJson t in
85+ if s == "unauthorized" then MsUnauthorized {}
86+ else if s == "rejected" then MsRejected {}
87+ else if s == "delivered" then MsDelivered {}
88+ else if s == "federated" then MsFederated {}
89+ else MsQueued {}
7390
7491type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
7592type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
@@ -92,12 +109,7 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T
92109type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
93110type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}
94111type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [ServerName]}
95−type DeliveryStatus = Delivered {} | Federated {} | Queued {}
96−deliveryStatusText = \s -> case s of
97− Delivered {} -> "delivered"
98− Federated {} -> "federated"
99− Queued {} -> "queued"
100−type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
112+type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: MessageStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
101113
102114
103115-- ============================================
@@ -819,9 +831,9 @@ serve = \req -> case req of
819831 forwards <- *forwards
820832 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
821833 let shouldForward = federationEnabled && count forwardServers > 0
822− let status = if localOnline then Delivered {}
823− else if shouldForward then Federated {}
824− else Queued {}
834+ let status = if localOnline then MsDelivered {}
835+ else if shouldForward then MsFederated {}
836+ else MsQueued {}
825837 set *forwards = if shouldForward
826838 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})
827839 else forwards
@@ -837,14 +849,14 @@ serve = \req -> case req of
837849 authorization: "Bearer " ++ federationSecret})
838850 whenOk fwdResult (removeForward msgId server))
839851 case status of
840− Queued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
852+ MsQueued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
841853 _ -> yield {})
842854 _ -> yield {}
843855 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
844856 yield (case result.send of
845− SendUnauthorized _ -> respond {status: "unauthorized", messageId: ""}
846− SendRejected _ -> respond {status: "rejected", messageId: ""}
847− SendDone {status} -> respond {status: deliveryStatusText status, messageId: msgId})
857+ SendUnauthorized _ -> respond {status: MsUnauthorized {}, messageId: ""}
858+ SendRejected _ -> respond {status: MsRejected {}, messageId: ""}
859+ SendDone {status} -> respond {status: status, messageId: msgId})
848860
849861 AckMessages {messageIds, authorization, respond} -> do
850862 t <- now