From ad50d7427e4270d2e86c2b08b84b6c10b8a02692 Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 05:06:58 +0200
Subject: [PATCH 01/11] Add monitoring callback command redactions

---
 lib/MongoDB/Role/_CommandMonitoring.pm | 31 +++++++++++++++++++++++---
 1 file changed, 28 insertions(+), 3 deletions(-)

diff --git a/lib/MongoDB/Role/_CommandMonitoring.pm b/lib/MongoDB/Role/_CommandMonitoring.pm
index 55d43527..b1e63050 100644
--- a/lib/MongoDB/Role/_CommandMonitoring.pm
+++ b/lib/MongoDB/Role/_CommandMonitoring.pm
@@ -37,12 +37,17 @@ sub publish_command_started {
     return unless $self->monitoring_callback;
 
     $command = _to_tied_ixhash($command);
+    my $command_name = tied(%$command)->Keys(0);
 
     my $event = {
         type         => 'command_started',
         databaseName => $self->db_name,
-        commandName  => tied(%$command)->Keys(0),
-        command      => $command,
+        commandName  => $command_name,
+        command      => (
+            _needs_redaction($command_name)
+                ? _to_tied_ixhash([])
+                : $command,
+        ),
         requestId    => $request_id,
         connectionId => $link->address,
     };
@@ -79,7 +84,11 @@ sub publish_command_reply {
         requestId    => $start_event->{requestId},
         connectionId => $start_event->{connectionId},
         durationSecs => $duration,
-        reply        => $reply,
+        reply        => (
+            _needs_redaction($start_event->{commandName})
+                ? {}
+                : $reply,
+        ),
     };
 
     if ( $reply->{ok} ) {
@@ -158,6 +167,22 @@ sub publish_legacy_query_error {
     return $self->publish_command_reply($reply);
 }
 
+sub _needs_redaction {
+    my ($name) = @_;
+    return 1 if grep { $name eq $_ } qw(
+        authenticate
+        saslStart
+        saslContinue
+        getnonce
+        createUser
+        updateUser
+        copydbgetnonce
+        copydbsaslstart
+        copydb
+    );
+    return 0;
+}
+
 sub _convert_legacy_insert {
     my ( $self, $op_doc ) = @_;
     $op_doc = [$op_doc] unless ref $op_doc eq 'ARRAY';

From 50f5cadaf947eba67fc276648cb4a703283e6145 Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 05:08:20 +0200
Subject: [PATCH 02/11] Added monitoring spec test implementation

---
 t/monitoring_spec.t | 280 ++++++++++++++++++++++++++++++++++++++------
 1 file changed, 245 insertions(+), 35 deletions(-)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 12b53569..7a7c87c1 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -17,7 +17,7 @@
 use strict;
 use warnings;
 use Test::More 0.96;
-use JSON::MaybeXS;
+use JSON::MaybeXS qw( is_bool decode_json );
 use Test::Deep;
 use Path::Tiny;
 use Try::Tiny;
@@ -56,6 +56,19 @@ my $server_type    = server_type($conn);
 my $feat_compat_ver = get_feature_compat_version($conn);
 my $coll           = $testdb->get_collection('test_collection');
 
+# defines which argument hash fields become positional arguments
+my %method_args = (
+    insert_one => [qw( document )],
+    insert_many => [qw( documents )],
+    delete_one => [qw( filter )],
+    delete_many => [qw( filter )],
+    update_one => [qw( filter update )],
+    update_many => [qw( filter update )],
+    find => [qw( filter )],
+    count => [qw( filter )],
+    bulk_write => [qw( requests )],
+);
+
 my $dir = path("t/data/command-monitoring");
 my $iterator = $dir->iterator( { recurse => 1 } );
 while ( my $path = $iterator->() ) {
@@ -69,17 +82,32 @@ while ( my $path = $iterator->() ) {
 
     subtest $name => sub {
         for my $test ( @{ $plan->{tests} } ) {
-            $coll->drop;
-            $coll->insert_many( $plan->{data} );
-            clear_events();
-            my $op   = $test->{operation};
-            my $meth = $op->{name};
-            $meth =~ s{([A-Z])}{_\L$1}g;
-            my $test_meth = "test_$meth";
-            plan skip_all => "not implemented"
-                unless main->can("$test_meth");
-            my $res = main->$test_meth( $test->{description}, $meth, $op->{arguments},
-                $test->{expectations} );
+            subtest $test->{description} => sub {
+
+                my $max_ver = $test->{ignore_if_server_version_greater_than};
+                my $min_ver = $test->{ignore_if_server_version_less_than};
+
+                plan skip_all => "Ignored for versions above $max_ver"
+                    if defined $max_ver
+                    and $server_version > version->parse("$max_ver");
+                plan skip_all => "Ignored for versions below $min_ver"
+                    if defined $min_ver
+                    and $server_version < version->parse("$min_ver");
+
+                $coll->drop;
+                $coll->insert_many( $plan->{data} );
+                clear_events();
+
+                my $op   = $test->{operation};
+                my $meth = $op->{name};
+                $meth =~ s{([A-Z])}{_\L$1}g;
+                my $test_meth = "test_$meth";
+                my $res = test_dispatch(
+                    $meth,
+                    $op->{arguments},
+                    $test->{expectations},
+                );
+            };
         }
     };
 }
@@ -88,37 +116,219 @@ while ( my $path = $iterator->() ) {
 # generic tests
 #--------------------------------------------------------------------------#
 
-sub test_find {
-    my ( $class, $label, $method, $args, $events ) = @_;
-    my $filter = delete $args->{filter};
-    my $res = $coll->$method( grep { defined } $filter, $args );
-    check_event_expectations( $label, $method, $events );
+sub test_dispatch {
+    my ($method, $args, $events) = @_;
+    my @call_args = _adjust_arguments($method, $args);
+    my $res = eval {
+        my $res = $coll->$method(@call_args);
+        $res->all
+            if $method eq 'find';
+        $res;
+    };
+    my $err = $@;
+    diag "error from '$method': $err"
+        if $err;
+    check_event_expectations($method, _adjust_types($events));
 }
 
-sub check_event_expectations {
-    my ($label, $method, $expected) = @_;
-    my @got = @events;
-    my $ok = 1;
-    for my $exp ( @$expected ) {
-        if (!@got ) {
-            $ok = 0;
-            last;
+sub _adjust_arguments {
+    my ($method, $args) = @_;
+    $args = _adjust_types($args);
+    my @fields = @{ $method_args{$method} };
+    my @field_values = map {
+        my $val = delete $args->{$_};
+        ($method eq 'bulk_write' and $_ eq 'requests')
+            ? _adjust_bulk_write_requests($val)
+            : $val;
+    } @fields;
+    return(
+        (grep { defined } @field_values),
+        scalar(keys %$args) ? $args : (),
+    );
+}
+
+sub _adjust_types {
+    my ($value) = @_;
+    if (ref $value eq 'HASH') {
+        if (scalar(keys %$value) == 1) {
+            my ($name, $value) = %$value;
+            if ($name eq '$numberLong') {
+                return 0+$value;
+            }
+        }
+        return +{map {
+            my $key = $_;
+            ($key, _adjust_types($value->{$key}));
+        } keys %$value};
+    }
+    elsif (ref $value eq 'ARRAY') {
+        return [map { _adjust_types($_) } @$value];
+    }
+    else {
+        return $value;
+    }
+}
+
+sub _adjust_bulk_write_requests {
+    my ($requests) = @_;
+    return [map {
+        my ($name, $args) = %$_;
+        $name =~ s{([A-Z])}{_\L$1}g;
+        +{ $name => [_adjust_arguments($name, $args)] };
+    } @$requests];
+}
+
+sub check_command_started_event {
+    my ($exp, $event) = @_;
+    check_event($exp, $event);
+}
+
+sub check_command_succeeded_event {
+    my ($exp, $event) = @_;
+    check_event($exp, $event);
+}
+
+sub check_command_failed_event {
+    my ($exp, $event) = @_;
+    check_event($exp, $event);
+}
+
+sub _verify_is_positive_num {
+    my $value = shift;
+    return(0, "error code is not defined")
+        unless defined $value;
+    return(0, "error code is not positive")
+        unless $value > 1;
+    return 1;
+}
+
+sub _verify_is_nonempty_str {
+    my $value = shift;
+    return(0, "error message is not defined")
+        unless defined $value;
+    return(0, "error message is empty")
+        unless length $value;
+    return 1;
+}
+
+sub check_database_name_field {
+    my ($exp_name, $event) = @_;
+    ok defined($event->{databaseName}), "database_name defined";
+    ok length($event->{databaseName}), "database_name non-empty";
+}
+
+sub check_command_name_field {
+    my ($exp_name, $event) = @_;
+    is $event->{commandName}, $exp_name, "command name";
+}
+
+sub check_reply_field {
+    my ($exp_reply, $event) = @_;
+    my $event_reply = $event->{reply};
+    if (exists $exp_reply->{cursor}) {
+        if (exists $exp_reply->{cursor}{id}) {
+            $exp_reply->{cursor}{id} = code(\&_verify_is_positive_num)
+                if $exp_reply->{cursor}{id} eq '42';
+        }
+    }
+    if (exists $exp_reply->{writeErrors}) {
+        for my $error (@{ $exp_reply->{writeErrors} }) {
+            if (exists $error->{code} and $error->{code} eq 42) {
+                $error->{code} = code(\&_verify_is_positive_num);
+            }
+            if (exists $error->{errmsg} and $error->{errmsg} eq '') {
+                $error->{errmsg} = code(\&_verify_is_nonempty_str);
+            }
+        }
+    }
+    for my $exp_key (sort keys %$exp_reply) {
+        cmp_deeply
+            $event_reply->{$exp_key},
+            prepare_data_spec($exp_reply->{$exp_key}),
+            "reply field $exp_key";
+    }
+}
+
+sub check_command_field {
+    my ($exp_command, $event) = @_;
+    my $event_command = $event->{command};
+    if (exists $exp_command->{getMore}) {
+        $exp_command->{getMore} = code(\&_verify_is_positive_num)
+            if $exp_command->{getMore} eq '42';
+    }
+    for my $exp_key (sort keys %$exp_command) {
+        cmp_deeply
+            $event_command->{$exp_key},
+            prepare_data_spec($exp_command->{$exp_key}),
+            "command field $exp_key";
+    }
+}
+
+sub prepare_data_spec {
+    my ($spec) = @_;
+    if (not ref $spec) {
+        if ($spec eq 'test') {
+            return any(qw( test test_collection ));
         }
-        if ( $got[0]->{type} ne $exp->{type} ) {
-            shift @got;
-            redo;
+        if ($spec eq 'test-unacknowledged-bulk-write') {
+            return code(\&_verify_is_nonempty_str);
         }
-        ...;
+        if ($spec eq 'command-monitoring-tests.test') {
+            return code(\&_verify_is_nonempty_str);
+        }
+        return $spec;
+    }
+    elsif (is_bool $spec) {
+        my $specced = $spec ? 1 : 0;
+        return code(sub {
+            my $value = shift;
+            return(0, 'expected a true boolean value')
+                if $specced and not $value;
+            return(0, 'expected a false boolean value')
+                if $value and not $specced;
+            return 1;
+        });
+    }
+    elsif (ref $spec eq 'ARRAY') {
+        return [map {
+            prepare_data_spec($_)
+        } @$spec];
+    }
+    elsif (ref $spec eq 'HASH') {
+        return +{map {
+            ($_, prepare_data_spec($spec->{$_}))
+        } keys %$spec};
+    }
+    else {
+        return $spec;
     }
 }
 
-sub _prep_to_ignore_special_data {
-    my ($hr) = @_;
-    if (exists $hr->{command} && exists $hr->{command}{cursor} ) {
-        $hr->{command}{cursor}{id} = ignore();
+sub check_event_expectations {
+    my ($method, $expected) = @_;
+    my @got = @events;
+
+    for my $exp ( @$expected ) {
+        my ($exp_type, $exp_spec) = %$exp;
+        subtest $exp_type => sub {
+            ok(scalar(@got), 'event available')
+                or return;
+            my $event = shift @got;
+            is($event->{type}.'_event', $exp_type, "is a $exp_type")
+                or return;
+            my $event_tester = "check_$exp_type";
+            main->can($event_tester)->($exp_spec, $event);
+        };
     }
-    if (exists $hr->{reply} && exists $hr->{reply}{cursor} ) {
-        $hr->{reply}{cursor}{id} = ignore();
+
+    is scalar(@got), 0, 'no outstanding events';
+}
+
+sub check_event {
+    my ($exp, $event) = @_;
+    for my $key (sort keys %$exp) {
+        my $check = "check_${key}_field";
+        main->can($check)->($exp->{$key}, $event);
     }
 }
 

From ea51464315c08b5cbde644d1df638d0d83951051 Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 19:11:04 +0200
Subject: [PATCH 03/11] Don't check for expected 'ordered' field

---
 t/monitoring_spec.t | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 7a7c87c1..09e3f28c 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -251,6 +251,10 @@ sub check_reply_field {
 
 sub check_command_field {
     my ($exp_command, $event) = @_;
+
+    # ordered defaults to true
+    delete $exp_command->{ordered};
+
     my $event_command = $event->{command};
     if (exists $exp_command->{getMore}) {
         $exp_command->{getMore} = code(\&_verify_is_positive_num)

From 299545b8329b84e5383b9f927198aa964aa6845a Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 19:11:30 +0200
Subject: [PATCH 04/11] Make command fields 'comment' and 'maxTimeMS' TODO
 tests

---
 t/monitoring_spec.t | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 09e3f28c..08d892e1 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -260,11 +260,22 @@ sub check_command_field {
         $exp_command->{getMore} = code(\&_verify_is_positive_num)
             if $exp_command->{getMore} eq '42';
     }
+
     for my $exp_key (sort keys %$exp_command) {
-        cmp_deeply
-            $event_command->{$exp_key},
-            prepare_data_spec($exp_command->{$exp_key}),
-            "command field $exp_key";
+        my $event_value = $event_command->{$exp_key};
+        my $exp_value = prepare_data_spec($exp_command->{$exp_key});
+        my $label = "command field '$exp_key'";
+
+        if (grep { $exp_key eq $_ } qw( comment maxTimeMS )) {
+            TODO: {
+                local $TODO =
+                    "Command field '$exp_key' requires other fixes";
+                cmp_deeply $event_value, $exp_value, $label;
+            }
+        }
+        else {
+            cmp_deeply $event_value, $exp_value, $label;
+        }
     }
 }
 

From dc467c7d1817165db058c7b31aed92b808571f5f Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 19:28:57 +0200
Subject: [PATCH 05/11] some comments and code cleanup, notes about special
 casings

---
 t/monitoring_spec.t | 176 +++++++++++++++++++++++++++-----------------
 1 file changed, 107 insertions(+), 69 deletions(-)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 08d892e1..b37e7344 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -116,37 +116,51 @@ while ( my $path = $iterator->() ) {
 # generic tests
 #--------------------------------------------------------------------------#
 
+# runs the collection method and dispatches event tests
 sub test_dispatch {
     my ($method, $args, $events) = @_;
+
     my @call_args = _adjust_arguments($method, $args);
     my $res = eval {
         my $res = $coll->$method(@call_args);
+
+        # special case 'find' so commands are actually emitted
         $res->all
             if $method eq 'find';
+
         $res;
     };
+
     my $err = $@;
     diag "error from '$method': $err"
         if $err;
+
     check_event_expectations($method, _adjust_types($events));
 }
 
+# prepare collection method arguments
+# adjusts data structures and extracts leading positional arguments
 sub _adjust_arguments {
     my ($method, $args) = @_;
+
     $args = _adjust_types($args);
     my @fields = @{ $method_args{$method} };
     my @field_values = map {
         my $val = delete $args->{$_};
+        # bulk write is special cased to reuse argument extraction
         ($method eq 'bulk_write' and $_ eq 'requests')
             ? _adjust_bulk_write_requests($val)
             : $val;
     } @fields;
+
     return(
         (grep { defined } @field_values),
         scalar(keys %$args) ? $args : (),
     );
 }
 
+# some type transformations
+# currenetly only turns { '$numberLong' => $n } into 0+$n
 sub _adjust_types {
     my ($value) = @_;
     if (ref $value eq 'HASH') {
@@ -169,6 +183,7 @@ sub _adjust_types {
     }
 }
 
+# prepare bulk write requests for use as argument to ->bulk_write
 sub _adjust_bulk_write_requests {
     my ($requests) = @_;
     return [map {
@@ -178,6 +193,79 @@ sub _adjust_bulk_write_requests {
     } @$requests];
 }
 
+# common overrides for event data expectations
+sub prepare_data_spec {
+    my ($spec) = @_;
+    if (not ref $spec) {
+        if ($spec eq 'test') {
+            return any(qw( test test_collection ));
+        }
+        if ($spec eq 'test-unacknowledged-bulk-write') {
+            return code(\&_verify_is_nonempty_str);
+        }
+        if ($spec eq 'command-monitoring-tests.test') {
+            return code(\&_verify_is_nonempty_str);
+        }
+        return $spec;
+    }
+    elsif (is_bool $spec) {
+        my $specced = $spec ? 1 : 0;
+        return code(sub {
+            my $value = shift;
+            return(0, 'expected a true boolean value')
+                if $specced and not $value;
+            return(0, 'expected a false boolean value')
+                if $value and not $specced;
+            return 1;
+        });
+    }
+    elsif (ref $spec eq 'ARRAY') {
+        return [map {
+            prepare_data_spec($_)
+        } @$spec];
+    }
+    elsif (ref $spec eq 'HASH') {
+        return +{map {
+            ($_, prepare_data_spec($spec->{$_}))
+        } keys %$spec};
+    }
+    else {
+        return $spec;
+    }
+}
+
+sub check_event_expectations {
+    my ($method, $expected) = @_;
+    my @got = @events;
+
+    for my $exp ( @$expected ) {
+        my ($exp_type, $exp_spec) = %$exp;
+        subtest $exp_type => sub {
+            ok(scalar(@got), 'event available')
+                or return;
+            my $event = shift @got;
+            is($event->{type}.'_event', $exp_type, "is a $exp_type")
+                or return;
+            my $event_tester = "check_$exp_type";
+            main->can($event_tester)->($exp_spec, $event);
+        };
+    }
+
+    is scalar(@got), 0, 'no outstanding events';
+}
+
+sub check_event {
+    my ($exp, $event) = @_;
+    for my $key (sort keys %$exp) {
+        my $check = "check_${key}_field";
+        main->can($check)->($exp->{$key}, $event);
+    }
+}
+
+#
+# per-event type test handlers
+#
+
 sub check_command_started_event {
     my ($exp, $event) = @_;
     check_event($exp, $event);
@@ -193,6 +281,10 @@ sub check_command_failed_event {
     check_event($exp, $event);
 }
 
+#
+# verificationi subs for use with Test::Deep::code
+#
+
 sub _verify_is_positive_num {
     my $value = shift;
     return(0, "error code is not defined")
@@ -211,26 +303,37 @@ sub _verify_is_nonempty_str {
     return 1;
 }
 
+#
+# event field test handlers
+#
+
+# $event.database_name
 sub check_database_name_field {
     my ($exp_name, $event) = @_;
     ok defined($event->{databaseName}), "database_name defined";
     ok length($event->{databaseName}), "database_name non-empty";
 }
 
+# $event.command_name
 sub check_command_name_field {
     my ($exp_name, $event) = @_;
     is $event->{commandName}, $exp_name, "command name";
 }
 
+# $event.reply
 sub check_reply_field {
     my ($exp_reply, $event) = @_;
     my $event_reply = $event->{reply};
+
+    # special case for $event.reply.cursor.id
     if (exists $exp_reply->{cursor}) {
         if (exists $exp_reply->{cursor}{id}) {
             $exp_reply->{cursor}{id} = code(\&_verify_is_positive_num)
                 if $exp_reply->{cursor}{id} eq '42';
         }
     }
+
+    # special case for $event.reply.writeErrors
     if (exists $exp_reply->{writeErrors}) {
         for my $error (@{ $exp_reply->{writeErrors} }) {
             if (exists $error->{code} and $error->{code} eq 42) {
@@ -241,6 +344,7 @@ sub check_reply_field {
             }
         }
     }
+
     for my $exp_key (sort keys %$exp_reply) {
         cmp_deeply
             $event_reply->{$exp_key},
@@ -249,13 +353,15 @@ sub check_reply_field {
     }
 }
 
+# $event.command
 sub check_command_field {
     my ($exp_command, $event) = @_;
+    my $event_command = $event->{command};
 
     # ordered defaults to true
     delete $exp_command->{ordered};
 
-    my $event_command = $event->{command};
+    # special case for $event.command.getMore
     if (exists $exp_command->{getMore}) {
         $exp_command->{getMore} = code(\&_verify_is_positive_num)
             if $exp_command->{getMore} eq '42';
@@ -279,72 +385,4 @@ sub check_command_field {
     }
 }
 
-sub prepare_data_spec {
-    my ($spec) = @_;
-    if (not ref $spec) {
-        if ($spec eq 'test') {
-            return any(qw( test test_collection ));
-        }
-        if ($spec eq 'test-unacknowledged-bulk-write') {
-            return code(\&_verify_is_nonempty_str);
-        }
-        if ($spec eq 'command-monitoring-tests.test') {
-            return code(\&_verify_is_nonempty_str);
-        }
-        return $spec;
-    }
-    elsif (is_bool $spec) {
-        my $specced = $spec ? 1 : 0;
-        return code(sub {
-            my $value = shift;
-            return(0, 'expected a true boolean value')
-                if $specced and not $value;
-            return(0, 'expected a false boolean value')
-                if $value and not $specced;
-            return 1;
-        });
-    }
-    elsif (ref $spec eq 'ARRAY') {
-        return [map {
-            prepare_data_spec($_)
-        } @$spec];
-    }
-    elsif (ref $spec eq 'HASH') {
-        return +{map {
-            ($_, prepare_data_spec($spec->{$_}))
-        } keys %$spec};
-    }
-    else {
-        return $spec;
-    }
-}
-
-sub check_event_expectations {
-    my ($method, $expected) = @_;
-    my @got = @events;
-
-    for my $exp ( @$expected ) {
-        my ($exp_type, $exp_spec) = %$exp;
-        subtest $exp_type => sub {
-            ok(scalar(@got), 'event available')
-                or return;
-            my $event = shift @got;
-            is($event->{type}.'_event', $exp_type, "is a $exp_type")
-                or return;
-            my $event_tester = "check_$exp_type";
-            main->can($event_tester)->($exp_spec, $event);
-        };
-    }
-
-    is scalar(@got), 0, 'no outstanding events';
-}
-
-sub check_event {
-    my ($exp, $event) = @_;
-    for my $key (sort keys %$exp) {
-        my $check = "check_${key}_field";
-        main->can($check)->($exp->{$key}, $event);
-    }
-}
-
 done_testing;

From cdd5ddd048e8040116b1fa117506f594f4b257df Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 20:09:35 +0200
Subject: [PATCH 06/11] Respect ignore_if_topology_type

---
 t/monitoring_spec.t | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index b37e7344..5e9c2ad7 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -86,6 +86,7 @@ while ( my $path = $iterator->() ) {
 
                 my $max_ver = $test->{ignore_if_server_version_greater_than};
                 my $min_ver = $test->{ignore_if_server_version_less_than};
+                my $ignore_topologies = $test->{ignore_if_topology_type};
 
                 plan skip_all => "Ignored for versions above $max_ver"
                     if defined $max_ver
@@ -94,6 +95,14 @@ while ( my $path = $iterator->() ) {
                     if defined $min_ver
                     and $server_version < version->parse("$min_ver");
 
+                for my $topology (@{ $ignore_topologies || [] }) {
+                    my %to_server_type = (sharded => 'Mongos');
+                    my $ignore_server_type = $to_server_type{$topology}
+                        or die "Unknown topology type '$topology'";
+                    plan skip_all => "Ignored for '$topology' topology"
+                        if $ignore_server_type eq $server_type;
+                }
+
                 $coll->drop;
                 $coll->insert_many( $plan->{data} );
                 clear_events();

From 1617fb4a5d40b69e8ba0b8ab069606b73c355dbf Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Tue, 1 May 2018 20:18:33 +0200
Subject: [PATCH 07/11] Fix version comparison

---
 t/monitoring_spec.t | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 5e9c2ad7..ee4a839a 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -90,10 +90,10 @@ while ( my $path = $iterator->() ) {
 
                 plan skip_all => "Ignored for versions above $max_ver"
                     if defined $max_ver
-                    and $server_version > version->parse("$max_ver");
+                    and $server_version > version->parse("v$max_ver");
                 plan skip_all => "Ignored for versions below $min_ver"
                     if defined $min_ver
-                    and $server_version < version->parse("$min_ver");
+                    and $server_version < version->parse("v$min_ver");
 
                 for my $topology (@{ $ignore_topologies || [] }) {
                     my %to_server_type = (sharded => 'Mongos');

From 2a9d529decedd2f262d090c7bc68321316a1f7bc Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Wed, 2 May 2018 05:46:32 +0200
Subject: [PATCH 08/11] Added special case for expected writeConcern values to
 account for defaulted wtimeout value

---
 t/monitoring_spec.t | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index ee4a839a..783ab25d 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -376,6 +376,11 @@ sub check_command_field {
             if $exp_command->{getMore} eq '42';
     }
 
+    # special case for $event.command.writeConcern.wtimeout
+    if (exists $exp_command->{writeConcern}) {
+        $exp_command->{writeConcern}{wtimeout} = ignore();
+    }
+
     for my $exp_key (sort keys %$exp_command) {
         my $event_value = $event_command->{$exp_key};
         my $exp_value = prepare_data_spec($exp_command->{$exp_key});

From 6561720ea9b4f1ecbd679796e12e70e2d707936f Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Wed, 2 May 2018 15:51:40 +0200
Subject: [PATCH 09/11] Wrap writeConcern and getMore/batchSize in TODO pending
 other fixes

---
 t/monitoring_spec.t | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 783ab25d..47e169cd 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -386,7 +386,11 @@ sub check_command_field {
         my $exp_value = prepare_data_spec($exp_command->{$exp_key});
         my $label = "command field '$exp_key'";
 
-        if (grep { $exp_key eq $_ } qw( comment maxTimeMS )) {
+        if (
+            (grep { $exp_key eq $_ } qw( comment maxTimeMS writeConcern ))
+            or
+            ($event->{commandName} eq 'getMore' and $exp_key eq 'batchSize')
+        ) {
             TODO: {
                 local $TODO =
                     "Command field '$exp_key' requires other fixes";

From b550e42941911dfe3cb86e8acd8e6d7ae3df954b Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Wed, 2 May 2018 16:02:12 +0200
Subject: [PATCH 10/11] Error reporting should be note instead of diag

---
 t/monitoring_spec.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/t/monitoring_spec.t b/t/monitoring_spec.t
index 47e169cd..8d4243c6 100644
--- a/t/monitoring_spec.t
+++ b/t/monitoring_spec.t
@@ -141,7 +141,7 @@ sub test_dispatch {
     };
 
     my $err = $@;
-    diag "error from '$method': $err"
+    note "error from '$method': $err"
         if $err;
 
     check_event_expectations($method, _adjust_types($events));

From 49f04cd987082d825fa3d740dadbb18e38e4e987 Mon Sep 17 00:00:00 2001
From: Robert Sedlacek <rs@474.at>
Date: Wed, 2 May 2018 17:27:37 +0200
Subject: [PATCH 11/11] Add tests for redactions of 'getnonce' command data

---
 t/monitoring.t | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/t/monitoring.t b/t/monitoring.t
index a0f0235c..277e5241 100644
--- a/t/monitoring.t
+++ b/t/monitoring.t
@@ -253,6 +253,25 @@ subtest "exceptions are command_failed" => sub {
     };
 };
 
+subtest 'redactions' => sub {
+    clear_events();
+    my $mc     = build_client( monitoring_callback => \&event_cb );
+    my $testdb = get_test_db($mc);
+
+    $testdb->run_command([getnonce => 1]);
+    my ($started, $succeeded) =
+        grep { $_->{commandName} eq 'getnonce' }
+        @events;
+
+    is $started->{type}, 'command_started', 'start event';
+    is $succeeded->{type}, 'command_succeeded', 'success event';
+
+    ok defined($started->{command}), 'command not empty';
+    ok defined($succeeded->{reply}), 'reply not empty';
+    is scalar(keys %{ $started->{command} }), 0, 'no command fields';
+    is scalar(keys %{ $succeeded->{reply} }), 0, 'no reply fields';
+};
+
 sub _coll_with_monitor {
     my $mc     = build_client( monitoring_callback => \&event_cb );
     my $testdb = get_test_db($mc);