view release on metacpan or  search on metacpan

t/03-failover.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use DBI;

# Skip if not in integration test environment
unless ( $ENV{PATRONI_URLS} && $ENV{TEST_FAILOVER} ) {
    plan skip_all =>
      'PATRONI_URLS and TEST_FAILOVER not set, skipping failover tests';
}

use_ok('DBD::Patroni');
use LWP::UserAgent;
use JSON;

my $patroni_urls = $ENV{PATRONI_URLS};
my $user         = $ENV{PGUSER}     || 'testuser';
my $pass         = $ENV{PGPASSWORD} || 'testpass';
my $dbname       = $ENV{PGDATABASE} || 'testdb';
my $sslmode      = $ENV{PGSSLMODE}  || 'disable';
my $dsn = "dbi:Patroni:dbname=$dbname;sslmode=$sslmode;patroni_url=$patroni_urls";

# Helper to get cluster info
sub get_cluster_info {
    my $ua = LWP::UserAgent->new( timeout => 5 );

    for my $url ( split /,/, $patroni_urls ) {
        my $resp = $ua->get($url);
        next unless $resp->is_success;

        my $data = eval { decode_json( $resp->decoded_content ) };
        next unless $data && $data->{members};

        my ($leader) = grep { $_->{role} eq 'leader' } @{ $data->{members} };
        my @replicas = grep { $_->{role} ne 'leader' } @{ $data->{members} };

        return {
            leader   => $leader,
            replicas => \@replicas,
            members  => $data->{members},
        };
    }
    return undef;
}

# Helper to trigger failover via Patroni API
sub trigger_failover {
    my ($new_leader) = @_;

    my $ua = LWP::UserAgent->new( timeout => 10 );

    # Find current leader's API endpoint
    my $info = get_cluster_info();
    return 0 unless $info && $info->{leader};

    my $leader_host  = $info->{leader}{host};
    my $failover_url = "http://${leader_host}:8008/failover";

    my $resp = $ua->post(
        $failover_url,
        'Content-Type' => 'application/json',
        Content        => encode_json( { candidate => $new_leader } ),
    );

    diag( "Failover response: " . $resp->status_line );
    diag( "Failover body: " . $resp->decoded_content ) if !$resp->is_success;

    return $resp->is_success;
}

# Wait for all replicas to be running
sub wait_for_replicas {
    my $max_attempts = shift || 60;

    for my $i ( 1 .. $max_attempts ) {
        my $info = get_cluster_info();
        next unless $info;

        # Count nodes that are running or streaming (replicas in sync)
        my @ready =
          grep { $_->{state} eq 'running' || $_->{state} eq 'streaming' }
          @{ $info->{members} };

        if ( @ready >= 3 ) {
            diag("All 3 nodes are ready");
            return 1;
        }

        # Show all states for debugging
        my $states =
          join( ", ", map { "$_->{name}:$_->{state}" } @{ $info->{members} } );
        diag("Attempt $i/$max_attempts: $states");
        sleep 5;
    }
    return 0;
}

# Wait for all nodes to be ready before starting tests
diag("Waiting for all cluster nodes to be ready...");
wait_for_replicas(60);    # 60 attempts x 5 seconds = 5 minutes max

# Test 1: Detect current leader
subtest 'Detect current leader' => sub {
    my $info = get_cluster_info();

    ok( $info,                       'Got cluster info' );
    ok( $info->{leader},             'Found leader' );
    ok( @{ $info->{replicas} } >= 1, 'Found at least one replica' );

    diag( "Current leader: " . $info->{leader}{host} );
    diag( "Replicas: "
          . join( ", ", map { $_->{host} } @{ $info->{replicas} } ) );