f880fd2 · skrepka · git.iko.soy

41-- Types

42-- ============================================

43

44+type PollEventType = Text where \s -> s == "message"

45+

44−type PollEvent = {id: MessageIdHex, eventType: Text, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}

46+type PollEvent = {id: MessageIdHex, eventType: PollEventType, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}

45

47

46type GossipEventType = Text where \s -> s == "online" || s == "offline"

48type GossipEventType = Text where \s -> s == "online" || s == "offline"

47

49

372 else ""

374 else ""

373

375

374verifySecret = \token secret ->

376verifySecret = \token secret ->

375− let result = safeCompare token (if secret == "" then "x" else secret) in

377+ safeCompare token (if secret == "" then "x" else secret) && not (secret == "")

376− let secretSet = if secret == "" then 0 else 1 in

377− (if result then 1 else 0) * secretSet > 0

378

379verifyFederationAuth = \authorization ->

380 verifySecret (extractToken authorization) federationSecret

575 else do

576 let batch = takeN allEvents maxGossipEvents

577 let rest = diff allEvents batch

578− batchResult <- fetch (federationScheme ++ server) (RecvGossip {

578+ _ <- fetch (federationScheme ++ server) (RecvGossip {

579 authorization: "Bearer " ++ federationSecret,

580 events: batch, hopsRemaining: 2, fromServer: serverHostN})

581− case batchResult of

582− Ok _ -> yield {}

583− Err _ -> yield {}

584 sendBatchedGossipToServer server rest

581 sendBatchedGossipToServer server rest

585

582

586sendBatchedGossip : [Text] -> [GossipEvent] -> IO {network} {}

583sendBatchedGossip : [Text] -> [GossipEvent] -> IO {network} {}

797 fork (do

794 fork (do

798 if result.sigValid && federationEnabled

795 if result.sigValid && federationEnabled

799 then sendToEach result.peerServers (\server -> do

796 then sendToEach result.peerServers (\server -> do

800− fetchResult <- fetch (federationScheme ++ server) (RecvGossip {

797+ _ <- fetch (federationScheme ++ server) (RecvGossip {

801 authorization: "Bearer " ++ federationSecret,

798 authorization: "Bearer " ++ federationSecret,

802 events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})

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

806 )

801 )

807 else yield {}

802 else yield {}

808 broadcastOfflineGossip t result.offlinePeers (do

803 broadcastOfflineGossip t result.offlinePeers (do

917 let evictedEntries = if excessCount <= 0 then []

912 let evictedEntries = if excessCount <= 0 then []

918 else diff combinedAckedIds afterEviction

913 else diff combinedAckedIds afterEviction

919 set *ackedIds = afterEviction

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

922 let fedMessages = do

916 let fedMessages = do

923 m <- result.ackedMessages

917 m <- result.ackedMessages

924 where isFederatedOrigin m.originServer

918 where isFederatedOrigin m.originServer

925 yield m

919 yield m

926 let originServers = collectPeerServers fedMessages (\m -> m.originServer)

920 let originServers = collectPeerServers fedMessages (\m -> m.originServer)

927 fork (do

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

935 if result.ok

922 if result.ok

936 then do

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

937 let evictedToRetry = do

931 let evictedToRetry = do

938 a <- result.evictedEntries

932 a <- result.evictedEntries

939 where none fedMessages (\m -> m.messageId == a.messageId && m.toKey == a.toKey)

933 where none fedMessages (\m -> m.messageId == a.messageId && m.toKey == a.toKey)

942 then do

936 then do

943 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)

937 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)

944 sendToEach evictedOriginServers (\server -> do

938 sendToEach evictedOriginServers (\server -> do

945− result <- fetch (federationScheme ++ server) (FederationAck {

939+ fetchResult <- fetch (federationScheme ++ server) (FederationAck {

946 authorization: "Bearer " ++ federationSecret,

940 authorization: "Bearer " ++ federationSecret,

947 messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),

941 messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),

948 originServer: server, fromServer: serverHostN})

942 originServer: server, fromServer: serverHostN})

949− case result of

943+ case fetchResult of

950 Err _ -> do

944 Err _ -> do

951 dropped <- atomic do

945 dropped <- atomic do

952 ackedIds <- *ackedIds

946 ackedIds <- *ackedIds

1097 where not (s == fromServer)

1091 where not (s == fromServer)

1098 yield s

1092 yield s

1099 sendToEach targets (\server -> do

1093 sendToEach targets (\server -> do

1100− fetchResult <- fetch (federationScheme ++ server) (RecvGossip {

1094+ _ <- fetch (federationScheme ++ server) (RecvGossip {

1101 authorization: "Bearer " ++ federationSecret,

1095 authorization: "Bearer " ++ federationSecret,

1102 events: effectiveEvents, hopsRemaining: cappedHops - 1, fromServer: serverHostN})

1096 events: effectiveEvents, hopsRemaining: cappedHops - 1, fromServer: serverHostN})

1103− case fetchResult of

1104− Ok _ -> yield {}

1105− Err _ -> yield {}

1097+ yield {}

1106 )

1098 )

1107 else yield {}

1099 else yield {}

1108 broadcastOfflineGossip t gossipResult.peerServers gossipResult.expiredLocal)

1100 broadcastOfflineGossip t gossipResult.peerServers gossipResult.expiredLocal)