@@ -475,10 +475,12 @@ sendBatchedGossipToServer = \server allEvents ->
475 if count acc >= maxGossipEvents then acc
475 if count acc >= maxGossipEvents then acc
476 else union acc [e]) [] allEvents
476 else union acc [e]) [] allEvents
477 let rest = diff allEvents batch
477 let rest = diff allEvents batch
478− fetch (federationScheme ++ server) (RecvGossip {
478+ batchResult <- fetch (federationScheme ++ server) (RecvGossip {
479 authorization: "Bearer " ++ federationSecret,
479 authorization: "Bearer " ++ federationSecret,
480 events: batch, hopsRemaining: 2, fromServer: serverHostN})
480 events: batch, hopsRemaining: 2, fromServer: serverHostN})
481− sendBatchedGossipToServer server rest
482+ Ok _ -> sendBatchedGossipToServer server rest
483sendBatchedGossip : [Text] -> [{eventType: Text, pubkey: Text, server: Text, timestamp: Int, ttl: Int}] -> IO {} {}
485sendBatchedGossip : [Text] -> [{eventType: Text, pubkey: Text, server: Text, timestamp: Int, ttl: Int}] -> IO {} {}
484sendBatchedGossip = \peerServers allEvents ->
486sendBatchedGossip = \peerServers allEvents ->
@@ -843,16 +845,18 @@ serve = \req -> case req of
843 let finalStatus = if result.status == "federated" && (federationSecret == "" || result.forwardsAtCapacity) then "queued" else result.status
845 let finalStatus = if result.status == "federated" && (federationSecret == "" || result.forwardsAtCapacity) then "queued" else result.status
844 if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (result.status == "rejected") && not (federationSecret == "")
846 if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (result.status == "rejected") && not (federationSecret == "")
845 then sendToEach result.remoteServers (\server -> do
847 then sendToEach result.remoteServers (\server -> do
846− fetch (federationScheme ++ server) (ForwardMessage {
848+ fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {
847 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
849 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
848 timestamp: clampedTs, originServer: serverHostN, messageId: msgId,
850 timestamp: clampedTs, originServer: serverHostN, messageId: msgId,
849 authorization: "Bearer " ++ federationSecret})
851 authorization: "Bearer " ++ federationSecret})
850− atomic do
853+ Ok _ -> atomic do
851− forwards <- *forwards
854+ forwards <- *forwards
852− set *forwards = do
855+ set *forwards = do
853− x <- forwards
856+ x <- forwards
854− where not (x.messageId == msgId && x.toServer == server)
857+ where not (x.messageId == msgId && x.toServer == server)
855− yield x)
858+ yield x
856 else yield {}
860 else yield {}
857 if result.forwardsAtCapacity && count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (result.status == "rejected")
861 if result.forwardsAtCapacity && count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (result.status == "rejected")
858 then println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
862 then println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
@@ -1046,14 +1050,13 @@ serve = \req -> case req of
1046 gossipResult <- atomic do
1050 gossipResult <- atomic do
1047 pr <- maybePrune t
1051 pr <- maybePrune t
1048 presence <- *presence
1052 presence <- *presence
1049− let fromServerTrusted = count (do p <- presence; where p.server == fromServer; where p.expiresAt > t; yield p) > 0
1050 let trustedDeduped = do
1053 let trustedDeduped = do
1051 e <- deduped
1054 e <- deduped
1052− where e.server == fromServer || fromServerTrusted || count (do p <- presence; where p.server == e.server; where p.expiresAt > t; yield p) > 0
1055+ where e.server == fromServer || count (do p <- presence; where p.server == e.server; where p.expiresAt > t; yield p) > 0
1054 let trustedOffline = do
1057 let trustedOffline = do
1055 e <- offlineEntries
1058 e <- offlineEntries
1056− where e.server == fromServer || fromServerTrusted || count (do p <- presence; where p.server == e.server; where p.expiresAt > t; yield p) > 0
1059+ where e.server == fromServer || count (do p <- presence; where p.server == e.server; where p.expiresAt > t; yield p) > 0
1058 let appliedOnline = do
1061 let appliedOnline = do
1059 e <- trustedDeduped
1062 e <- trustedDeduped
@@ -1356,10 +1359,11 @@ backgroundPrune = do
1356 where not (a.originServer == serverHostN)
1359 where not (a.originServer == serverHostN)
1358 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}
1361 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}
1362+ fork backgroundPrune
1359 broadcastOfflineGossip t result.peerServers result.expiredLocal
1363 broadcastOfflineGossip t result.peerServers result.expiredLocal
1360 if not (federationSecret == "") && count result.pendingForwards > 0
1364 if not (federationSecret == "") && count result.pendingForwards > 0
1361 then retryPendingForwards result.pendingForwards
1365 then retryPendingForwards result.pendingForwards
1362− else yield {}
1366+ else yield {}
1363 if not (federationSecret == "") && count result.pendingAcks > 0
1367 if not (federationSecret == "") && count result.pendingAcks > 0
1365 let ackOriginServers = fold (\acc a ->
1369 let ackOriginServers = fold (\acc a ->
@@ -1367,7 +1371,6 @@ backgroundPrune = do
1367 else union acc [a.originServer]) [] result.pendingAcks
1371 else union acc [a.originServer]) [] result.pendingAcks
1368 sendAcksAndClean result.pendingAcks ackOriginServers
1372 sendAcksAndClean result.pendingAcks ackOriginServers
1369 else yield {}
1373 else yield {}
1370− fork backgroundPrune
1372main = do
1375main = do
1373 println "Skrepka relay server starting on port 8080..."
1376 println "Skrepka relay server starting on port 8080..."