+(: prog Prog)
+(define prog
+ (Prog "tt" (info:#%info-lookup 'version)))
+
+(: user-default User)
+(define user-default
+ (User (string->url "https://github.com/xandkar/tt") #f))
+
+(: user->str (-> User String))
+(define (user->str user)
+ (match-define (User u0 n) user)
+ (define u (url->string u0))
+ (if n
+ (format "+~a; @~a" u n)
+ (format "+~a" u )))
+
+(: user-agent->str (-> User-Agent String))
+(define (user-agent->str ua)
+ (match-define (User-Agent u p) ua)
+ (format "~a/~a (~a)" (Prog-name p) (Prog-version p) (user->str u)))
+
+(: user->user-agent User)
+(define (user->user-agent user)
+ (User-Agent user prog))
+
+(: user-agent-str String)
+(define user-agent-str
+ (user-agent->str (user->user-agent user-default)))
+
+(: set-user-agent-str (-> Path-String Void))
+(define (set-user-agent-str filename)
+ (set! user-agent-str (user-agent->str (user->user-agent (file->user filename))))
+ (log-info "User-Agent string is now set to: ~v" user-agent-str))
+
+(: file->user (-> Path-String User))
+(define (file->user filename)
+ (if (file-exists? filename)
+ (match (file->peers filename)
+ [(list p)
+ (log-info
+ "User-Agent. Found one peer in file: ~v. Using the found peer: ~a"
+ filename
+ (peer->str p))
+ (peer->user p)]
+ [(list* p _)
+ (log-warning
+ "User-Agent. Multiple peers in file: ~v. Picking arbitrary: ~a"
+ filename
+ (peer->str p))
+ (peer->user p)]
+ ['()
+ (log-warning
+ "User-Agent. No peers found in file: ~v. Using the default user: ~a"
+ filename
+ user-default)
+ user-default])
+ (begin
+ (log-warning
+ "User-Agent. File doesn't exist: ~v. Using the default user: ~a"
+ filename
+ user-default)
+ user-default)))
+
+(: peer->user (-> Peer User))
+(define (peer->user p)
+ (match-define (Peer n u _ _) p)
+ (User u n))
+
+(: peers-equal? (-> Peer Peer Boolean))
+(define (peers-equal? p1 p2)
+ (equal? (Peer-uri-str p1)
+ (Peer-uri-str p2)))
+
+(: peer-hash (-> Peer Fixnum))
+(define (peer-hash p)
+ (equal-hash-code (Peer-uri-str p)))
+
+(define-custom-set-types peers
+ #:elem? Peer?
+ peers-equal?
+ peer-hash)
+; XXX Without supplying above explicit hash procedure, we INTERMITTENTLY get
+; the following contract violations:
+;
+; custom-elem-contents: contract violation
+; expected: custom-elem?
+; given: #f
+; context...:
+; /usr/share/racket/collects/racket/private/set-types.rkt:104:0: custom-set->list
+; /home/siraaj/proj/pub/tt/tt.rkt:716:0: crawl
+; /usr/share/racket/collects/racket/cmdline.rkt:191:51
+; body of (submod "/home/siraaj/proj/pub/tt/tt.rkt" main)
+;
+; TODO Investigate why and make a minimal reproducible test case.
+
+(: peers-merge (-> (Listof Peer) * (Listof Peer)))
+(define (peers-merge . peer-sets)
+ (define groups
+ (foldl
+ (λ (p groups)
+ (hash-update groups (Peer-uri-str p) (λ (group) (cons p group)) '()))
+ (hash)
+ (append* peer-sets)))
+ (define (merge peers)
+ (match peers
+ ['() (raise 'impossible)]
+ [(list p) p]
+ [(list* p1 p2 ps)
+ (let* ([n1 (Peer-nick p1)]
+ [n2 (Peer-nick p2)]
+ [p (cond
+ ; TODO Try to pick from nicks db: preferred, otherwise seen
+ [(and (not n1) (not n2)) p1]
+ [(and n1 n2 ) p1]
+ [(and n1 (not n2)) p1]
+ [(and (not n1) n2) p2]
+ [else
+ (raise 'impossible)])])
+ (merge (cons p ps)))]))
+ (sort (map merge (hash-values groups))
+ (match-lambda**
+ [((Peer _ _ u1 _) (Peer _ _ u2 _)) (string<? u1 u2)])))
+
+(module+ test
+ (let* ([u1 "http://foo/bar"]
+ [u2 "http://baz/quux"]
+ [p1 (Peer #f (string->url u1) u1 #f)]
+ [p2 (Peer "a" (string->url u1) u1 #f)]
+ [p3 (Peer "b" (string->url u2) u2 #f)]
+ [s1 (list p1)]
+ [s2 (list p2 p3)])
+ (check-equal? (list p3 p2) (peers-merge s1 s2))
+ (check-equal? (list p3 p2) (peers-merge s2 s1))))
+