git.iko.soy/skrepka
on master help sign in
Update server.knot to match Knot language spec: bind source relations before use, all IO before branching
6d59d9biko
server.knot+170−147
compare with master
unifiedsplit
@@ -84,9 +84,9 @@ genToken = do
84 d <- randomInt 2147483647
84 d <- randomInt 2147483647
85 yield (bytesToHex (textToBytes (show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d)))
85 yield (bytesToHex (textToBytes (show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d)))
86
86
87−lookupSession = \token t ->
87+lookupSession = \sessions token t ->
88 single (do
88 single (do
89− s <- *sessions
89+ s <- sessions
90 where s.token == token
90 where s.token == token
91 where s.expiresAt > t
91 where s.expiresAt > t
92 yield s)
92 yield s)
@@ -102,20 +102,24 @@ verifyFederationAuth = \authorization ->
102clampTtl = \ttl -> if ttl > maxPresenceTtl then maxPresenceTtl else ttl
102clampTtl = \ttl -> if ttl > maxPresenceTtl then maxPresenceTtl else ttl
103
103
104pruneExpired = \t -> do
104pruneExpired = \t -> do
105+ challenges <- *challenges
105 set *challenges = do
106 set *challenges = do
106− c <- *challenges
107+ c <- challenges
107 where c.expiresAt > t
108 where c.expiresAt > t
108 yield c
109 yield c
110+ sessions <- *sessions
109 set *sessions = do
111 set *sessions = do
110− s <- *sessions
112+ s <- sessions
111 where s.expiresAt > t
113 where s.expiresAt > t
112 yield s
114 yield s
115+ presence <- *presence
113 set *presence = do
116 set *presence = do
114− p <- *presence
117+ p <- presence
115 where p.expiresAt > t
118 where p.expiresAt > t
116 yield p
119 yield p
120+ messages <- *messages
117 set *messages = do
121 set *messages = do
118− m <- *messages
122+ m <- messages
119 where m.timestamp > t - messageMaxAge
123 where m.timestamp > t - messageMaxAge
120 yield m
124 yield m
121
125
@@ -129,176 +133,195 @@ serve = \req -> case req of
129 challenge <- genToken
133 challenge <- genToken
130 t <- now
134 t <- now
131 pruneExpired t
135 pruneExpired t
136+ challenges <- *challenges
132− set *challenges = union *challenges
137+ set *challenges = union challenges
133 [{pubkey: pubkey, challenge: challenge, expiresAt: t + 60000}]
138 [{pubkey: pubkey, challenge: challenge, expiresAt: t + 60000}]
134 respond {challenge: challenge}
139 respond {challenge: challenge}
135
140
136 VerifyAuth {pubkey, challenge, signature, respond} -> do
141 VerifyAuth {pubkey, challenge, signature, respond} -> do
137 t <- now
142 t <- now
143+ challenges <- *challenges
144+ sessions <- *sessions
145+ presence <- *presence
146+ token <- genToken
147+ let expiry = t + 3600000
138− case single (do
148+ let matched = single (do
139− c <- *challenges
149+ c <- challenges
140 where c.pubkey == pubkey
150 where c.pubkey == pubkey
141 where c.challenge == challenge
151 where c.challenge == challenge
142 where c.expiresAt > t
152 where c.expiresAt > t
143− yield c) of
153+ yield c)
154+ let sigValid = case matched of
144− Nothing {} ->
155+ Nothing {} -> False {}
145− respond {token: "", expiresAt: 0}
156+ _ -> verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
157+ set *challenges = case matched of
158+ Nothing {} -> challenges
146 _ -> do
159 _ -> do
147− set *challenges = do
148− c <- *challenges
160+ c <- challenges
149− where not (c.pubkey == pubkey && c.challenge == challenge)
161+ where not (c.pubkey == pubkey && c.challenge == challenge)
150− yield c
162+ yield c
151− if verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
163+ set *sessions = if sigValid
152− then do
164+ then union sessions [{token: token, pubkey: pubkey, expiresAt: expiry}]
153− token <- genToken
165+ else sessions
154− let expiry = t + 3600000
166+ set *presence = if sigValid
155− set *sessions = union *sessions
167+ then union
156− [{token: token, pubkey: pubkey, expiresAt: expiry}]
168+ (do
157− set *presence = union
169+ p <- presence
158− (do
170+ where not (p.pubkey == pubkey && p.server == serverHost)
159− p <- *presence
171+ yield p)
160− where not (p.pubkey == pubkey && p.server == serverHost)
172+ [{pubkey: pubkey, server: serverHost, expiresAt: expiry}]
161− yield p)
173+ else presence
162− [{pubkey: pubkey, server: serverHost, expiresAt: expiry}]
174+ let result = if sigValid
163− respond {token: token, expiresAt: expiry}
175+ then {token: token, expiresAt: expiry}
164− else
165− respond {token: "", expiresAt: 0}
176+ else {token: "", expiresAt: 0}
177+ respond result
166
178
167 Poll {authorization, respond} -> do
179 Poll {authorization, respond} -> do
168 t <- now
180 t <- now
169 pruneExpired t
181 pruneExpired t
182+ sessions <- *sessions
183+ messages <- *messages
170− case lookupSession (extractToken authorization) t of
184+ let session = lookupSession sessions (extractToken authorization) t
185+ let evts = case session of
171− Nothing {} ->
186+ Nothing {} -> []
172− respond {events: [], cursor: ""}
173− Just {value: session} -> do
187+ Just {value: s} -> do
174− let evts = do
175− m <- *messages
188+ m <- messages
176− where m.toKey == session.pubkey
189+ where m.toKey == s.pubkey
177− yield {id: m.messageId, eventType: "message",
190+ yield {id: m.messageId, eventType: "message",
178− payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
191+ payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
179− encryptedBlob: m.encryptedBlob,
192+ encryptedBlob: m.encryptedBlob,
180− timestamp: m.timestamp}}
193+ timestamp: m.timestamp}}
181− respond {events: evts, cursor: ""}
194+ respond {events: evts, cursor: ""}
182
195
183 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
196 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
184 t <- now
197 t <- now
198+ sessions <- *sessions
199+ messages <- *messages
185− case lookupSession (extractToken authorization) t of
200+ let session = lookupSession sessions (extractToken authorization) t
186− Nothing {} ->
187− respond {status: "unauthorized", messageId: ""}
188− Just {value: session} -> do
189− msgId <- genToken
201+ msgId <- genToken
202+ set *messages = case session of
203+ Nothing {} -> messages
190− set *messages = union *messages
204+ Just {value: s} -> union messages
191− [{messageId: msgId, toKey: to, fromKey: session.pubkey,
205+ [{messageId: msgId, toKey: to, fromKey: s.pubkey,
192− encryptedBlob: encryptedBlob, timestamp: t}]
206+ encryptedBlob: encryptedBlob, timestamp: t}]
193− let online = count (do
207+ let online = case session of
208+ Nothing {} -> False {}
209+ Just {value: _} -> count (do
194− s <- *sessions
210+ s <- sessions
195− where s.pubkey == to
211+ where s.pubkey == to
196− where s.expiresAt > t
212+ where s.expiresAt > t
197− yield s) > 0
213+ yield s) > 0
214+ let result = case session of
215+ Nothing {} -> {status: "unauthorized", messageId: ""}
198− respond {status: (if online then "delivered" else "queued"),
216+ _ -> {status: (if online then "delivered" else "queued"),
199− messageId: msgId}
217+ messageId: msgId}
218+ respond result
200
219
201 AckMessages {messageIds, authorization, respond} -> do
220 AckMessages {messageIds, authorization, respond} -> do
202 t <- now
221 t <- now
222+ sessions <- *sessions
223+ messages <- *messages
203− case lookupSession (extractToken authorization) t of
224+ let session = lookupSession sessions (extractToken authorization) t
225+ set *messages = case session of
204− Nothing {} ->
226+ Nothing {} -> messages
205− respond {ok: (False {})}
206− Just {value: session} -> do
207− set *messages = diff *messages (do
227+ Just {value: s} -> diff messages (do
208− m <- *messages
228+ m <- messages
209− mid <- messageIds
229+ mid <- messageIds
210− where m.messageId == mid
230+ where m.messageId == mid
211− where m.toKey == session.pubkey
231+ where m.toKey == s.pubkey
212− yield m)
232+ yield m)
233+ let result = case session of
234+ Nothing {} -> {ok: (False {})}
213− respond {ok: (True {})}
235+ _ -> {ok: (True {})}
236+ respond result
214
237
215 LookupPresence {pubkey, authorization, respond} -> do
238 LookupPresence {pubkey, authorization, respond} -> do
216 t <- now
239 t <- now
240+ sessions <- *sessions
241+ presence <- *presence
217− case lookupSession (extractToken authorization) t of
242+ let session = lookupSession sessions (extractToken authorization) t
218− Nothing {} ->
243+ let valid = do
244+ p <- presence
245+ where p.pubkey == pubkey
246+ where p.expiresAt > t
247+ yield p
248+ let result = case session of
219− respond {online: (False {}), server: ""}
249+ Nothing {} -> {online: (False {}), server: ""}
220 Just {value: _} ->
250 Just {value: _} ->
221− let valid = do
222− p <- *presence
223− where p.pubkey == pubkey
224− where p.expiresAt > t
225− yield p
226− in if count valid == 0
251+ if count valid == 0
227− then respond {online: (False {}), server: ""}
252+ then {online: (False {}), server: ""}
228 else case single (do
253 else case single (do
229 p <- valid
254 p <- valid
230 where p.server == serverHost
255 where p.server == serverHost
231 yield p) of
256 yield p) of
232− Just {value: p} ->
233− respond {online: (True {}), server: p.server}
257+ Just {value: p} -> {online: (True {}), server: p.server}
234 Nothing {} ->
258 Nothing {} ->
235 case single valid of
259 case single valid of
236− Just {value: p} ->
237− respond {online: (True {}), server: p.server}
260+ Just {value: p} -> {online: (True {}), server: p.server}
238− Nothing {} ->
239− respond {online: (True {}), server: ""}
261+ Nothing {} -> {online: (True {}), server: ""}
240−
262+ respond result
263+
241− RecvGossip {events, hopsRemaining, authorization, respond} ->
264+ RecvGossip {events, hopsRemaining, authorization, respond} -> do
265+ t <- now
266+ presence <- *presence
242− if not (verifyFederationAuth authorization)
267+ let authorized = verifyFederationAuth authorization
243− then respond {ok: (False {})}
244− else if hopsRemaining < 1
268+ let validRequest = authorized && hopsRemaining >= 1
245− then respond {ok: (False {})}
246− else do
247− t <- now
248− let onlineEntries = do
269+ let onlineEntries = do
249− e <- events
270+ e <- events
250− where e.eventType == "online"
271+ where e.eventType == "online"
251− yield {pubkey: e.pubkey, server: e.server, expiresAt: t + clampTtl e.ttl * 1000}
272+ yield {pubkey: e.pubkey, server: e.server, expiresAt: t + clampTtl e.ttl * 1000}
252− let affectedKeys = do
273+ let affectedKeys = do
253− e <- events
274+ e <- events
254− yield {pubkey: e.pubkey, server: e.server}
275+ yield {pubkey: e.pubkey, server: e.server}
255− let cleaned = diff *presence (do
276+ let cleaned = diff presence (do
256− p <- *presence
277+ p <- presence
257− k <- affectedKeys
278+ k <- affectedKeys
258− where p.pubkey == k.pubkey
279+ where p.pubkey == k.pubkey
259− where p.server == k.server
280+ where p.server == k.server
260− yield p)
281+ yield p)
261− let deduped = do
282+ let deduped = do
262− e <- onlineEntries
283+ e <- onlineEntries
263− where count (do
284+ where count (do
264− o <- onlineEntries
285+ o <- onlineEntries
265− where o.pubkey == e.pubkey
286+ where o.pubkey == e.pubkey
266− where o.server == e.server
287+ where o.server == e.server
267− where o.expiresAt > e.expiresAt
288+ where o.expiresAt > e.expiresAt
268− yield o) == 0
289+ yield o) == 0
269− yield e
290+ yield e
291+ set *presence = if validRequest
270− set *presence = union cleaned deduped
292+ then union cleaned deduped
293+ else presence
271− respond {ok: (True {})}
294+ respond {ok: validRequest}
272−
295+
273− ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} ->
296+ ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
274− if not (verifyFederationAuth authorization)
297+ t <- now
275− then respond {ok: (False {})}
298+ messages <- *messages
276− else do
299+ let authorized = verifyFederationAuth authorization
277− t <- now
278− let clampedTs = if timestamp > t then t else timestamp
300+ let clampedTs = if timestamp > t then t else timestamp
279− let exists = count (do
301+ let exists = count (do
280− m <- *messages
302+ m <- messages
281− where m.messageId == messageId
303+ where m.messageId == messageId
282− where m.timestamp > t - messageMaxAge
304+ where m.timestamp > t - messageMaxAge
283− yield m) > 0
305+ yield m) > 0
284− if exists
306+ let shouldInsert = authorized && not exists
285− then respond {ok: (True {})}
307+ set *messages = if shouldInsert
286− else do
287− set *messages = union *messages
308+ then union messages
288− [{messageId: messageId, toKey: toKey, fromKey: fromKey,
309+ [{messageId: messageId, toKey: toKey, fromKey: fromKey,
289− encryptedBlob: encryptedBlob, timestamp: clampedTs}]
310+ encryptedBlob: encryptedBlob, timestamp: clampedTs}]
311+ else messages
290− respond {ok: (True {})}
312+ respond {ok: authorized}
291−
313+
292− FederationAck {messageIds, originServer, authorization, respond} ->
314+ FederationAck {messageIds, originServer, authorization, respond} -> do
293− if not (verifyFederationAuth authorization)
315+ messages <- *messages
294− then respond {ok: (False {})}
316+ let authorized = verifyFederationAuth authorization
295− else do
317+ set *messages = if authorized
296− set *messages = diff *messages (do
318+ then diff messages (do
297− m <- *messages
319+ m <- messages
298− mid <- messageIds
320+ mid <- messageIds
299− where m.messageId == mid
321+ where m.messageId == mid
300− yield m)
322+ yield m)
323+ else messages
301− respond {ok: (True {})}
324+ respond {ok: authorized}
302
325
303-- ============================================
326-- ============================================
304-- Entry Point
327-- Entry Point
servers.json+3−3
@@ -1,5 +1,5 @@
1[
1[
2− "https://178.72.170.73",
2+ "https://1.skrepka.lol",
3− "https://45.66.117.187",
3+ "https://2.skrepka.lol",
4− "https://158.160.236.107"
4+ "https://3.skrepka.lol"
5]
5]