any-wrap: move channel? case before evt? case

(channel? x) implies (evt? x), so the any-wrap code that protects
channels was never used --- leaving a soundness bug

- move the evt? case below the channel? case
- fix bugs in the channel? chaperone

Author: bennn

typed-racket-lib/typed-racket/utils/any-wrap.rkt

@@ -171,10 +171,6 @@
                                    (with-contract-continuation-mark
                                     blame+neg-party
                                     (any-wrap/traverse k neg-party seen/v))))] ;; key
-      [(? evt?) (chaperone-evt v (lambda (e) (values e (λ (v)
-                                                         (with-contract-continuation-mark
-                                                          blame+neg-party
-                                                          (any-wrap/traverse v neg-party seen/v))))))]
       [(? set?) (chaperone-hash-set
                  v
                  (λ (s e) e) ; inject
@@ -208,8 +204,14 @@
        (chaperone-channel v
                           (lambda (e) (with-contract-continuation-mark
                                        blame+neg-party
-                                       (values v (any-wrap/traverse v neg-party seen/v))))
-                          (lambda (e) (fail neg-party v)))]
+                                       (values e (lambda (inner-val) (any-wrap/traverse inner-val neg-party seen/v)))))
+                          (lambda (_e _new-val) (fail neg-party v)))]
+      [(? evt?)
+       ;; must come after cases for write-able values that can be used as events
+       (chaperone-evt v (lambda (e) (values e (λ (v)
+                                                (with-contract-continuation-mark
+                                                 blame+neg-party
+                                                 (any-wrap/traverse v neg-party seen/v))))))]
       [_
        (on-opaque v b neg-party)]))
   any-wrap/traverse)

typed-racket-test/unit-tests/contract-tests.rkt

@@ -893,4 +893,18 @@
    (t-int (-val #rx"aa") void #rx"aa" #:untyped)
    (t-int (-val #rx#"bb") void #rx#"bb" #:untyped)
 
+   (t-int -ChannelTop
+          channel-get
+          (let ((ch (make-channel))) (thread (λ () (channel-put ch "ok"))) ch)
+          #:typed)
+   (t-int -ChannelTop
+          channel-get
+          (let ((ch (make-channel))) (thread (λ () (channel-put ch "ok"))) ch)
+          #:untyped)
+   (t-int/fail -ChannelTop
+               (lambda (ch)
+                 (channel-put ch 'error))
+               (make-channel)
+               #:typed
+               #:msg "higher-order value passed as `Any`")
    ))