32ef8d2 · skrepka · git.iko.soy

git.iko.soy/skrepka

Improve type safety: convert MessageStatus to DU with custom JSON serialization, eliminate DeliveryStatus

32ef8d2iko6 months ago

server.knot+26−14

@@ -69,7 +69,24 @@ type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: Serve

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

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 {}

74type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s

91type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s

75type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s

92type 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

92type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}

109type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}

93type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}

110type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}

94type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [ServerName]}

111type 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}

101

113

102

114

103-- ============================================

115-- ============================================

@@ -819,9 +831,9 @@ serve = \req -> case req of

819 forwards <- *forwards

831 forwards <- *forwards

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

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

821 let shouldForward = federationEnabled && count forwardServers > 0

833 let shouldForward = federationEnabled && count forwardServers > 0

822− let status = if localOnline then Delivered {}

834+ let status = if localOnline then MsDelivered {}

823− else if shouldForward then Federated {}

835+ else if shouldForward then MsFederated {}

824− else Queued {}

836+ else MsQueued {}

825 set *forwards = if shouldForward

837 set *forwards = if shouldForward

826 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})

838 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})

827 else forwards

839 else forwards

@@ -837,14 +849,14 @@ serve = \req -> case req of

837 authorization: "Bearer " ++ federationSecret})

849 authorization: "Bearer " ++ federationSecret})

838 whenOk fwdResult (removeForward msgId server))

850 whenOk fwdResult (removeForward msgId server))

839 case status of

851 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")

841 _ -> yield {})

853 _ -> yield {})

842 _ -> yield {}

854 _ -> yield {}

843 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)

855 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)

844 yield (case result.send of

856 yield (case result.send of

845− SendUnauthorized _ -> respond {status: "unauthorized", messageId: ""}

857+ SendUnauthorized _ -> respond {status: MsUnauthorized {}, messageId: ""}

846− SendRejected _ -> respond {status: "rejected", messageId: ""}

858+ SendRejected _ -> respond {status: MsRejected {}, messageId: ""}

847− SendDone {status} -> respond {status: deliveryStatusText status, messageId: msgId})

859+ SendDone {status} -> respond {status: status, messageId: msgId})

848

860

849 AckMessages {messageIds, authorization, respond} -> do

861 AckMessages {messageIds, authorization, respond} -> do

850 t <- now

862 t <- now