[bug#53389,0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,
Commit Message
Hi,
Maxime Devos <maximedevos@telenet.be> skribis:
> Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
>> > + (unless keep-lingering?
>> > + ;; exit the server thread
>> > + (system-async-mark (lambda () (throw 'quit)) server))
>>
>> When do we need ‘keep-lingering?’?
>
> In tests/challenge.scm (call-mismatch-test), due to how the store monad
> work, the thunk technically returns (*) before we are done with the
> querying the server. Perhaps this can be resolved with sufficient
> monadology, but I don't quite see how.
>
> (*) a monadic value.
How about fixing it locally like this:
That way we don’t need to keep the lingering variant in (guix tests
http).
WDYT?
Ludo’.
Comments
Ludovic Courtès schreef op ma 07-02-2022 om 10:53 [+0100]:
> Hi,
>
> Maxime Devos <maximedevos@telenet.be> skribis:
>
> > Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
> > > > + (unless keep-lingering?
> > > > + ;; exit the server thread
> > > > + (system-async-mark (lambda () (throw 'quit)) server))
> > >
> > > When do we need ‘keep-lingering?’?
> >
> > In tests/challenge.scm (call-mismatch-test), due to how the store monad
> > work, the thunk technically returns (*) before we are done with the
> > querying the server. Perhaps this can be resolved with sufficient
> > monadology, but I don't quite see how.
> >
> > (*) a monadic value.
>
> How about fixing it locally like this:
>
> That way we don’t need to keep the lingering variant in (guix tests
> http).
>
> WDYT?
Looks nice, though it isn't ideal that port 9000/9001 is hardcoded
here. That can be left as an exercise for later though. I'll do this
in the v2 (and remove keep-lingering?) whenever I get around to writing
the v2 (I'm mostly doing Scheme-GNUnet stuff at the moment).
Greetings,
Maaxime.
Hi Maxime,
Maxime Devos <maximedevos@telenet.be> skribis:
> Looks nice, though it isn't ideal that port 9000/9001 is hardcoded
> here. That can be left as an exercise for later though. I'll do this
> in the v2 (and remove keep-lingering?) whenever I get around to writing
> the v2 (I'm mostly doing Scheme-GNUnet stuff at the moment).
I just remembered about this patch series. Let me know when you can
come up with v2.
Ludo’.
Ludovic Courtès schreef op zo 06-03-2022 om 17:23 [+0100]:
> I just remembered about this patch series. Let me know when you can
> come up with v2.
Not right now, but there's another (older) patch series that should be
ready: <https://issues.guix.gnu.org/50299#91>.
Greetings,
Maxime.
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -57,6 +57,17 @@ (define-syntax with-derivation-narinfo*
(lambda () body ...)
hash))))
+(define-syntax-rule (with-http-server* arguments body ...)
+ ;; Like 'with-http-server' but for use in a monadic context.
+ (let ((port (%http-server-port)))
+ (lambda (store)
+ (values (parameterize ((%http-server-port port))
+ (call-with-http-server arguments
+ (lambda ()
+ (run-with-store store
+ body ...))))
+ store))))
+
(test-begin "challenge")
@@ -198,11 +209,11 @@ (define (call-mismatch-test proc)
(lambda (port)
(write-file out2 port)))))
(parameterize ((%http-server-port 9000))
- (with-http-server `((200 ,(make-narinfo item size1 hash1))
- (200 ,nar1))
+ (with-http-server* `((200 ,(make-narinfo item size1 hash1))
+ (200 ,nar1))
(parameterize ((%http-server-port 9001))
- (with-http-server `((200 ,(make-narinfo item size2 hash2))
- (200 ,nar2))
+ (with-http-server* `((200 ,(make-narinfo item size2 hash2))
+ (200 ,nar2))
(mlet* %store-monad ((urls -> (list (%local-url 9000)
(%local-url 9001)))
(reports (compare-contents (list item)
@@ -238,4 +249,5 @@ (define (call-mismatch-test proc)
;;; Local Variables:
;;; eval: (put 'with-derivation-narinfo* 'scheme-indent-function 2)
+;;; eval: (put 'with-http-server* 'scheme-indent-function 1)
;;; End: