The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
##
# name:      Stackato::Stackrad
# abstract:  Curses Client for Stackato
# author:    Ingy döt Net <ingy@ingy.net>
# license:   perl
# copyright: 2012

package Stackato::Stackrad;
use Mo qw'build builder default';
use Curses::UI 0;
use LWP::UserAgent 0;
use LWP::Protocol::https 0;
use HTTP::Request 0;
use URI::Escape 0;
use JSON::XS 0;
use YAML::XS 0;
# use XXX;
our $VERSION;
BEGIN {
    $VERSION = '0.02';
}

our $SELF;
sub PPP {
    my $self = $SELF;
    my $text = YAML::XS::Dump(@_);
    $self->error($text);
    wantarray ? @_ : $_[0]
}

use constant app_name => 'Stackrad';
use constant target_key_hint => ' (set target with Ctrl+t)';
use constant default_title => app_name . target_key_hint;
use constant new_target_prompt =>
    "New target? (e.g., api.stackato.example.com)";
use constant username_prompt => "Username:";
use constant password_prompt => "Password:";
use constant user_agent_string =>
    app_name . "/$VERSION lwp/$LWP::UserAgent::VERSION";
use constant main_color => 'cyan';
use constant secondary_color => 'cyan';
use constant accent_color => 'red';
use constant banner => <<EOT;
        _____                   _              _          _
       / ____|                 | |            | |        | |
  ____| O_________          ___| |_  __ _  ___| | __ __ _| |_  ___
 /     \\___ \\     \\        / __| __|/ _` |/ __| |/ // _` | __|/ _ \\ TM
|     .____O |     |       \\__ \\ |_| (_| | (__|   <| (_| | |_| (_) |
 \\_...|_____...___/        |___/\\__|\\__,_|\\___|_|\\_\\\\__,_|\\__|\\___/
                                                by ActiveState
                                                




EOT

has targets => (default => sub{[]});
# has targets => (default => sub{[{hostname=>'api.stacka.to'}]});

has target_index => ();
has cui => ();
has win1 => ();
has tabs => ();
has ui => (default => sub { [ 
    {
        name => 'Targets',
        on_activate => sub { },
        contents => undef,
    },
    {
        name => 'Overview',
        on_activate => sub { },
        contents => <<'EOT'
Memory: [ 128 MB of 256 MB ]
[----------------                  ]

1 / 2 Applications
0 / 2 Services

Applications:
[ ] tty-js [STARTED]
    Framework: node, Services: 0, Owner: as@sharpsaw.org
    [Restart] [Stop] [Launch] [Logs] [All Files] [More Info]

[ ] pairup [STARTED]
    Framework: generic, Services: 0, Owner: ingy@ingy.net
    [Restart] [Stop] [Launch] [Logs] [All Files] [More Info]

...

Provisioned Services:
[ ] filesystem  Provisioned Name: home   Bindings: 1
    [(Cannot Delete Bound Service)]
EOT
    },
    {
        name => 'Users',
        on_activate => sub { $SELF->update_users },
        contents => <<'EOT'
You need to login to a valid target Stackato VM.
EOT
    },
    {
        name => 'Groups',
        on_activate => sub { },
        contents => <<'EOT'
    Group   Users   Apps
[ ] pair    5       1
EOT
    },
    {
        name => 'App Store',
        on_activate => sub { },
        contents => <<'EOT'
[ ] Bugzilla - perl / mysql
    A bug tracking system for individuals or groups of developers
    256MB Required - License: MPL
    (Third Party Apps for Stackato)

[ ] Currency Converter - python / redis
    Currency converter using Python bottle framework
    128MB Required - License: Unknown
    (ActiveState Stackato Sample Applications)

[ ] Drupal - php / filesystem / mysql
    A popular PHP content management system which uses mysql and
    the persistent file system
    128MB Required - License: GPLv2
    (Third Party Apps for Stackato)

[ ] ...
EOT
    },
    {
        name => 'Local Apps',
        on_activate => sub { },
        contents => <<'EOT'
[ ] Node Env - node
    /home/ingy/src/node-env/

[ ] Foozle - ruby / postgresql
    /home/ingy/src/foozle/
EOT
    },
]});


sub run {
    my $class = shift;
    my $self = $class->new();
    $SELF = $self; # XXX, PPP
    $self->setup_cui;
    $self->cui->mainloop();
}

sub setup_cui {
    my $self = shift;
    $self->target_index($#{$self->targets}) if @{$self->targets};    # XXX
    my $cui = $self->{cui} = $self->cui(
        Curses::UI->new(
            -color_support => 1,
            # -debug => 1,
        )
    );

    $cui->set_binding(sub { exit 0 }, "\cC");
    $cui->set_binding(sub { $self->prompt_for_target }, "\cT");
    $cui->set_binding(sub { $self->delete_current_target }, "\cX");
    $cui->set_binding(sub { $self->login_logout }, "\cL");
    for my $index (1 .. 9) {
        $cui->set_binding(sub { $self->set_target($index) }, $index);
    }

    my $win1 = $self->{win1} =
        $cui->add('win1', 'Window',
            -title  => default_title,
            -bfg    => main_color,
            -border => 1,
        );
    $win1->add('help_text', 'Label',
        -y     => $win1->height - 3,
        -width => $win1->width - 2,
        -text  => 'Ctrl+n/PgUp / Ctrl+p/PgDn to switch tabs; Ctrl+C to exit',
        -textalignment => 'middle',
        -bold  => 1,
    );
    my $notebook = $win1->add('notebook', 'Notebook',
        -height => $win1->height - 3,
        -border => 1,
    );
    for my $tab (@{$self->ui}) {
        my $name = $tab->{name};
        my $id = 'tab_'.$name;
        my $page = $tab->{page} = $notebook->add_page($name,
            -on_activate => $tab->{on_activate}
        );
        $tab->{tv} = $page->add(
            $id, 'TextViewer',
            -x    => 1,
            -y    => 1,
            -text => $tab->{contents},
        );
    }
    $self->update_targets_screen;
    $notebook->focus;
}

sub tab_named {
    my ($self, $name) = @_;
    for (@{$self->ui}) {
        return $_ if $name eq $_->{name};
    }
}

sub current_target {
    my $self = shift;
    return unless defined $self->target_index;
    $self->targets->[$self->target_index]
}

sub set_target {
    my ($self, $new_index) = @_;
    $self->target_index($new_index);
    $self->update_users;
}

sub prompt_for_target {
    my $self = shift;
    my $answer = $self->cui->question(new_target_prompt); # TODO: "api."
    return unless $answer;

    return $self->error($answer . " does not appear to be a valid Stackato VM")
        unless $self->validate_target($answer);
    push @{$self->targets}, {hostname => $answer};
    $self->target_index($#{$self->targets});
    $self->update_targets_screen;
    $self->set_title
}

sub delete_current_target {
    my $self = shift;
    my $i = $self->target_index;
    return unless defined $i;
    splice @{$self->targets}, $i, 1;
    $i = undef if --$i < 0;
    $self->target_index($i);
    $self->set_title;
    $self->update_targets_screen;
}

sub update_targets_screen {
    my $self = shift;
    my $tab = $self->tab_named('Targets');
    my $out = '';
    for (0 .. $#{$self->targets}) {
        my $target = $self->targets->[$_];
        $out .= $_ == $self->target_index ? ' * ' : '   ';
        $out .= $target->{hostname};
        $out .= $target->{user}
            ? " (${\$target->{user}}) "
            : " (not logged in) ";
        $out .= "\n";
    }
    $out .= "\n\n";
    if (@{$self->targets}) {
        $out .= 'Ctrl+L to log' . ($self->logged_in ? 'out' : 'in')."\n";
        $out .= "Ctrl+x to delete current target.\n"
    } else {
        $out .= banner;
    }
    $out .= "Ctrl+t to add a target.\n";
#     $out .= "\n\nPress 'Ctrl+<target #>' to set current target."
#         if @{$self->targets} > 1;
    $tab->{tv}{-text} = $out;
    $self->redraw;
}

sub update_users {
    my $self = shift;
    my $out = '';
    if (not $self->current_target) {
        $out = 'You have no Stackato VM as a current target.';
    }
    else {
        my $response = $self->get(path => '/users');
        my $status = $response->code;
        if ($status == 403) {
            $out = "Unauthorized. Maybe you need to login as an admin user?";
        } else {
            my $data = decode_json($response->content);
            for (0 .. $#{$data}) {
                my $user = $data->[$_];
                $out .= $_+1 . '. ' . $user->{email} . "\n";
            }
        }
    }
    $self->tab_named('Users')->{tv}{-text} = $out;
}

sub login_logout {
    my $self = shift;
    return $self->logout if $self->logged_in;
    my $username = $self->cui->question(username_prompt); # TODO: <prev-user>
    return unless $username;
    my $password = $self->cui->question(password_prompt);
    return unless $password;
    my $path = '/users/' . uri_escape($username) . '/tokens';
    $password = quotemeta($password);
    my $response = $self->post(
        path => $path,
        content => qq({"password":"$password"})
    );
    unless ($response->is_success) {
        $self->error("Couldn't login.");
        return $self->logout;
    }
    my $token = decode_json($response->content)->{token};
    $self->current_target->{user} = $username;
    $self->current_target->{token} = $token;
    $self->update_targets_screen;
}

sub logout {
    my $self = shift;
    my $cur = $self->current_target;
    delete $cur->{user};
    delete $cur->{token};
    $self->update_targets_screen;
}

sub logged_in {
    my $self = shift;
    $self->current_target->{user}
}

sub set_title {
    my $self = shift;
    my $title = app_name;
    $title .= ' - target: ' . (
        $self->current_target &&
        $self->current_target->{hostname} ||
        'No Target'
    );
    $self->win1->{-title} = $title;
    $self->redraw;
}

sub validate_target {
    my ($self, $target) = @_;
    my $response = $self->get_from_target(
        target => { hostname => $target },
        path => '/info/'
    );
    return unless $response->is_success; 
    decode_json($response->content)
}

sub post_to_target {
    my ($self, %args) = @_;
    $self->ua->simple_request(
        $self->http_req('POST',
            host => $args{target}{hostname},
            path => $args{path},
            headers => {
                $args{target}{token}
                ? ('AUTHORIZATION' => $args{target}{token}) : ()
            },
            content => $args{content},
        )
    )
}

sub post {
    my ($self, %args) = @_;
    $self->post_to_target(
        target => $self->current_target,
        path => $args{path},
        content => $args{content},
    )
}

sub get_from_target {
    my ($self, %args) = @_;
    $self->ua->simple_request(
        $self->http_req('GET',
            host => $args{target}{hostname},
            path => $args{path},
            headers => {
                $args{target}{token}
                ? ('AUTHORIZATION' => $args{target}{token}) : ()
            },
            content => $args{content},
        )
    )
}

sub get {
    my ($self, %args) = @_;
    $self->get_from_target(
        target => $self->current_target,
        path => $args{path},
        content => $args{content},
    )
}

sub ua {
    my $self = shift;
    my $ua = LWP::UserAgent->new(agent => user_agent_string);
    # XXX
    # warn "Stackrad being lazy and disabling SSL cert verification!";
    $ua->ssl_opts(
        verify_hostname => 0,
        #? SSL_ca_path => '/app/fs/pair/certcert/stackato.ddns.us.pem',
    );
    $ua
}

sub http_req {
    my ($self, $method, %args) = @_;
    my $url = "https://$args{host}$args{path}";
    my $request = HTTP::Request->new($method, $url);
    $request->header('Accept' => 'application/json', %{$args{headers}});
    $request->content($args{content}) if $args{content};
    $request
}

sub error {
    my $self = shift;
    $self->cui->error(@_);
}

sub redraw {
    my $self = shift;
    $self->win1->draw(1);
}

1;