@@ -41,7 +41,9 @@ federationEnabled = not (federationSecret == "")
4141-- Types
4242-- ============================================
4343
44−type PollEvent = {id: MessageIdHex, eventType: Text, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}
44+type PollEventType = Text where \s -> s == "message"
45+
46+type PollEvent = {id: MessageIdHex, eventType: PollEventType, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}
4547
4648type GossipEventType = Text where \s -> s == "online" || s == "offline"
4749
@@ -372,9 +374,7 @@ extractToken = \authHeader ->
372374 else ""
373375
374376verifySecret = \token secret ->
375− let result = safeCompare token (if secret == "" then "x" else secret) in
376− let secretSet = if secret == "" then 0 else 1 in
377− (if result then 1 else 0) * secretSet > 0
377+ safeCompare token (if secret == "" then "x" else secret) && not (secret == "")
378378
379379verifyFederationAuth = \authorization ->
380380 verifySecret (extractToken authorization) federationSecret
@@ -575,12 +575,9 @@ sendBatchedGossipToServer = \server allEvents ->
575575 else do
576576 let batch = takeN allEvents maxGossipEvents
577577 let rest = diff allEvents batch
578− batchResult <- fetch (federationScheme ++ server) (RecvGossip {
578+ _ <- fetch (federationScheme ++ server) (RecvGossip {
579579 authorization: "Bearer " ++ federationSecret,
580580 events: batch, hopsRemaining: 2, fromServer: serverHostN})
581− case batchResult of
582− Ok _ -> yield {}
583− Err _ -> yield {}
584581 sendBatchedGossipToServer server rest
585582
586583sendBatchedGossip : [Text] -> [GossipEvent] -> IO {network} {}
@@ -797,12 +794,10 @@ serve = \req -> case req of
797794 fork (do
798795 if result.sigValid && federationEnabled
799796 then sendToEach result.peerServers (\server -> do
800− fetchResult <- fetch (federationScheme ++ server) (RecvGossip {
797+ _ <- fetch (federationScheme ++ server) (RecvGossip {
801798 authorization: "Bearer " ++ federationSecret,
802799 events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})
803− case fetchResult of
804− Ok _ -> yield {}
805− Err _ -> yield {}
800+ yield {}
806801 )
807802 else yield {}
808803 broadcastOfflineGossip t result.offlinePeers (do
@@ -917,23 +912,22 @@ serve = \req -> case req of
917912 let evictedEntries = if excessCount <= 0 then []
918913 else diff combinedAckedIds afterEviction
919914 set *ackedIds = afterEviction
920− let ok = auth.authorized
921− yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, evictedEntries: evictedEntries}
915+ yield {ok: auth.authorized, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, evictedEntries: evictedEntries}
922916 let fedMessages = do
923917 m <- result.ackedMessages
924918 where isFederatedOrigin m.originServer
925919 yield m
926920 let originServers = collectPeerServers fedMessages (\m -> m.originServer)
927921 fork (do
928− if result.ok && count originServers > 0 && federationEnabled
929− then do
930− let pendingAcks = do
931− m <- fedMessages
932− yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: m.originServer}
933− sendAcksAndClean pendingAcks originServers
934− else yield {}
935922 if result.ok
936923 then do
924+ if count originServers > 0 && federationEnabled
925+ then do
926+ let pendingAcks = do
927+ m <- fedMessages
928+ yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: m.originServer}
929+ sendAcksAndClean pendingAcks originServers
930+ else yield {}
937931 let evictedToRetry = do
938932 a <- result.evictedEntries
939933 where none fedMessages (\m -> m.messageId == a.messageId && m.toKey == a.toKey)
@@ -942,11 +936,11 @@ serve = \req -> case req of
942936 then do
943937 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)
944938 sendToEach evictedOriginServers (\server -> do
945− result <- fetch (federationScheme ++ server) (FederationAck {
939+ fetchResult <- fetch (federationScheme ++ server) (FederationAck {
946940 authorization: "Bearer " ++ federationSecret,
947941 messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),
948942 originServer: server, fromServer: serverHostN})
949− case result of
943+ case fetchResult of
950944 Err _ -> do
951945 dropped <- atomic do
952946 ackedIds <- *ackedIds
@@ -1097,12 +1091,10 @@ serve = \req -> case req of
10971091 where not (s == fromServer)
10981092 yield s
10991093 sendToEach targets (\server -> do
1100− fetchResult <- fetch (federationScheme ++ server) (RecvGossip {
1094+ _ <- fetch (federationScheme ++ server) (RecvGossip {
11011095 authorization: "Bearer " ++ federationSecret,
11021096 events: effectiveEvents, hopsRemaining: cappedHops - 1, fromServer: serverHostN})
1103− case fetchResult of
1104− Ok _ -> yield {}
1105− Err _ -> yield {}
1097+ yield {}
11061098 )
11071099 else yield {}
11081100 broadcastOfflineGossip t gossipResult.peerServers gossipResult.expiredLocal)