path: root/FS/FS/part_export/voip_ms.pm

package FS::part_export::voip_ms;

use base qw( FS::part_export );
use strict;

use Tie::IxHash;
use LWP::UserAgent;
use URI;
use URI::Escape;
use Cpanel::JSON::XS;
use HTTP::Request::Common;
use Cache::FileCache;
use FS::Record qw(dbh);
use FS::Misc::DateTime qw(parse_datetime);
use DateTime;

our $me = '[voip.ms]';
our $DEBUG = 0;
# our $DEBUG = 1; # log requests
# our $DEBUG = 2; # log requests and content of replies
our $base_url = 'https://voip.ms/api/v1/rest.php';

# cache cities and provinces
our $CACHE; # a FileCache; their API is not as quick as I'd like
our $cache_timeout = 86400; # seconds

tie my %options, 'Tie::IxHash',
  'account'         => { label => 'Main account ID' },
  'username'        => { label => 'API username', },
  'password'        => { label => 'API password', },
  'debug'           => { label => 'Enable debugging', type => 'checkbox', value => 1 },
  # could dynamically pull this from the API...
  'protocol'        => {
    label             => 'Protocol',
    type              => 'select',
    options           => [ 1, 3 ],
    option_labels     => { 1 => 'SIP', 3 => 'IAX' },
  },
  'auth_type'       => {
    label             => 'Authorization type',
    type              => 'select',
    options           => [ 1, 2 ],
    option_labels     => { 1 => 'User/Password', 2 => 'Static IP' },
  },
  'billing_type'    => {
    label             => 'DID billing mode',
    type              => 'select',
    options           => [ 1, 2 ],
    option_labels     => { 1 => 'Per minute', 2 => 'Flat rate' },
  },
  'device_type'     => {
    label             => 'Device type',
    type              => 'select',
    options           => [ 1, 2 ],
    option_labels     => { 1 => 'IP PBX, e.g. Asterisk',
                           2 => 'IP phone or softphone',
                         },
  },
  'canada_routing'    => {
    label             => 'Canada routing policy',
    type              => 'select',
    options           => [ 1, 2 ],
    option_labels     => { 1 => 'Value (lowest price)',
                           2 => 'Premium (highest quality)'
                         },
  },
  'international_route' => { # yes, 'route'
    label             => 'International routing policy',
    type              => 'select',
    options           => [ 0, 1, 2 ],
    option_labels     => { 0 => 'Disable international calls',
                           1 => 'Value (lowest price)',
                           2 => 'Premium (highest quality)'
                         },
  },
  'cnam_lookup' => {
    label             => 'Enable CNAM lookup on incoming calls',
    type              => 'checkbox',
  },

;

tie my %roles, 'Tie::IxHash',
  'subacct'       => {  label     => 'SIP client',
                        svcdb     => 'svc_acct',
                     },
  'did'           => {  label     => 'DID',
                        svcdb     => 'svc_phone',
                        multiple  => 1,
                     },
;

our %info = (
  'svc'      => [qw( svc_acct svc_phone )],
  'desc'     =>
    'Provision subaccounts and DIDs to voip.ms wholesale',
  'options'  => \%options,
  'roles'    => \%roles,
  'no_machine' => 1,
  'notes'    => <<'END'
<P>Export to <b>voip.ms</b> hosted PBX service.</P>
<P>This requires two service definitions to be configured on the same package:
  <OL>
    <LI>An account service for the subaccount (the "login" used by the 
    customer's PBX or IP phone, and the call routing service). This should
    be attached to the export in the "subacct" role. If you are using 
    password authentication, the <i>username</i> and <i>_password</i> will 
    be used to authenticate to voip.ms. If you are using static IP 
    authentication, the <i>slipip</I> (IP address) field should be set to 
    the address.</LI>
    <LI>A phone service for a DID, attached to the export in the DID role.
    You must select a server for the "SIP Host" field. Calls from this DID
    will be routed to the customer via that server.</LI>
  </OL>
</P>
<P>Export options:
  <UL>
    <LI>Main account ID: the numeric ID for the master account. 
    Subaccount usernames will be prefixed with this number and an underscore,
    so if you create a subaccount in Freeside with a username of "myuser", 
    the SIP device will have to authenticate as something like 
    "123456_myuser".</LI>
    <LI>API username/password: your API login; see 
    <a href="https://www.voip.ms/m/api.php">this page</a> to configure it
    if you haven't done so yet.</LI>
    <LI>Enable debugging: writes all traffic with the API server to the log.
    This includes passwords.</LI>
  </UL>
  The other options correspond to options in either the subaccount or DID 
  configuration menu in the voip.ms portal; see documentation there for 
  details.
</P>
END
);

sub _export_insert {
  my($self, $svc_x) = (shift, shift);

  my $role = $self->svc_role($svc_x);
  if ( $role eq 'subacct' ) {

    my $error = $self->insert_subacct($svc_x);
    return "$me $error" if $error;

    my @existing_dids = ( $self->svc_with_role($svc_x, 'did') );

    foreach my $svc_phone (@existing_dids) {
      $error = $self->insert_did($svc_phone, $svc_x);
      return "$me $error ordering DID ".$svc_phone->phonenum
        if $error;
    }

  } elsif ( $role eq 'did' ) {

    my $svc_acct = $self->svc_with_role($svc_x, 'subacct');
    return if !$svc_acct;
 
    my $error = $self->insert_did($svc_x, $svc_acct);
    return "$me $error" if $error;

  }
  '';
}

sub _export_replace {
  my ($self, $svc_new, $svc_old) = @_;
  my $role = $self->svc_role($svc_new);
  my $error;
  if ( $role eq 'subacct' ) {
    $error = $self->replace_subacct($svc_new, $svc_old);
  } elsif ( $role eq 'did' ) {
    $error = $self->replace_did($svc_new, $svc_old);
  }
  return "$me $error" if $error;
  '';
}

sub _export_delete {
  my ($self, $svc_x) = (shift, shift);
  my $role = $self->svc_role($svc_x);
  if ( $role eq 'subacct' ) {

    my @existing_dids = ( $self->svc_with_role($svc_x, 'did') );

    my $error;
    foreach my $svc_phone (@existing_dids) {
      $error = $self->delete_did($svc_phone);
      return "$me $error canceling DID ".$svc_phone->phonenum
        if $error;
    }

    $error = $self->delete_subacct($svc_x);
    return "$me $error" if $error;

  } elsif ( $role eq 'did' ) {

    my $svc_acct = $self->svc_with_role($svc_x, 'subacct');
    return if !$svc_acct;
 
    my $error = $self->delete_did($svc_x);
    return "$me $error" if $error;

  }
  '';
}

sub _export_suspend {
  my $self = shift;
  my $svc_x = shift;
  my $role = $self->svc_role($svc_x);
  return if $role ne 'subacct'; # can't suspend DIDs directly

  my $error = $self->replace_subacct($svc_x, $svc_x); # will disable it
  return "$me $error" if $error;
  '';
}

sub _export_unsuspend {
  my $self = shift;
  my $svc_x = shift;
  my $role = $self->svc_role($svc_x);
  return if $role ne 'subacct'; # can't suspend DIDs directly

  $svc_x->set('unsuspended', 1); # hack to tell replace_subacct to do it
  my $error = $self->replace_subacct($svc_x, $svc_x); #same
  return "$me $error" if $error;
  '';
}

################
# PROVISIONING #
################

sub insert_subacct {
  my ($self, $svc_acct) = @_;
  my $method = 'createSubAccount';
  my $content = $self->subacct_content($svc_acct);

  my $result = $self->api_request($method, $content);
  if ( $result->{status} ne 'success' ) {
    return $result->{status}; # or look up the error message string?
  }

  # result includes the account ID and the full username, but we don't
  # really need to keep those; we can look them up later
  '';
}

sub insert_did {
  my ($self, $svc_phone, $svc_acct) = @_;
  my $method = 'orderDID';
  my $content = $self->did_content($svc_phone, $svc_acct);
  my $result = $self->api_request($method, $content);
  if ( $result->{status} ne 'success' ) {
    return $result->{status}; # or look up the error message string?
  }
  '';
}

sub delete_subacct {
  my ($self, $svc_acct) = @_;
  my $account = $self->option('account') . '_' . $svc_acct->username;

  my $id = $self->subacct_id($svc_acct);
  if ( $id =~ /\D/ ) {

    return $id; # it's an error

  } elsif ( $id eq '' ) {

    return ''; # account doesn't exist, don't need to delete

  } # else it's numeric

  warn "$me deleting account $account with ID $id\n" if $DEBUG;
  my $result = $self->api_request('delSubAccount', { id => $id });
  if ( $result->{status} ne 'success' ) {
    return $result->{status};
  }
  '';
}

sub delete_did {
  my ($self, $svc_phone) = @_;
  my $phonenum = $svc_phone->phonenum;

  my $result = $self->api_request('cancelDID', { did => $phonenum });
  if ( $result->{status} ne 'success' and $result->{status} ne 'invalid_did' )
  {
    return $result->{status};
  }
  '';
}

sub replace_subacct {
  my ($self, $svc_new, $svc_old) = @_;
  if ( $svc_new->username ne $svc_old->username ) {
    return "can't change account username; delete and recreate the account instead";
  }
  
  my $id = $self->subacct_id($svc_new);
  if ( $id =~ /\D/ ) {

    return $id;

  } elsif ( $id eq '' ) {

    # account doesn't exist; provision it anew
    return $self->insert_subacct($svc_new);

  }

  my $content = $self->subacct_content($svc_new);
  delete $content->{username};
  $content->{id} = $id;

  my $result = $self->api_request('setSubAccount', $content);
  if ( $result->{status} ne 'success' ) {
    return $result->{status};
  }

  '';
}

sub replace_did {
  my ($self, $svc_new, $svc_old) = @_;
  if ( $svc_new->phonenum ne $svc_old->phonenum ) {
    return "can't change DID phone number";
  }
  # check that there's a subacct set up
  my $svc_acct = $self->svc_with_role($svc_new, 'subacct')
    or return '';

  # check for the existing DID
  my $result = $self->api_request('getDIDsInfo',
    { did => $svc_new->phonenum }
  );
  if ( $result->{status} eq 'invalid_did' ) {

    # provision the DID
    return $self->insert_did($svc_new, $svc_acct);

  } elsif ( $result->{status} ne 'success' ) {

    return $result->{status};

  }

  my $existing = $result->{dids}[0];

  my $content = $self->did_content($svc_new, $svc_acct);
  if ( $content->{billing_type} == $existing->{billing_type} ) {
    delete $content->{billing_type}; # confuses the server otherwise
  }
  $result = $self->api_request('setDIDInfo', $content);
  if ( $result->{status} ne 'success' ) {
    return $result->{status};
  }

  return '';
}

#######################
# CONVENIENCE METHODS #
#######################

sub subacct_id {
  my ($self, $svc_acct) = @_;
  my $account = $self->option('account') . '_' . $svc_acct->username;

  # look up the subaccount's numeric ID
  my $result = $self->api_request('getSubAccounts', { account => $account });
  if ( $result->{status} eq 'invalid_account' ) {
    return '';
  } elsif ( $result->{status} ne 'success' ) {
    return "$result->{status} looking up account ID";
  } else {
    return $result->{accounts}[0]{id};
  }
}

sub subacct_content {
  my ($self, $svc_acct) = @_;

  my $cust_pkg = $svc_acct->cust_svc->cust_pkg;

  my $desc = $svc_acct->finger || $svc_acct->username;
  my $intl = $self->option('international_route');
  my $lockintl = 0;
  if ($intl == 0) {
    $intl = 1; # can't send zero
    $lockintl = 1;
  }

  my %auth;
  if ( $cust_pkg and $cust_pkg->susp > 0 and !$svc_acct->get('unsuspended') ) {
    # we can't explicitly suspend their account, so just set its password to 
    # a partially random string that satisfies the password rules
    # (we still have their real password in the svc_acct record)
    %auth = ( auth_type => 1,
              password  => sprintf('Suspend-%08d', int(rand(100000000)) ),
            );
  } else {
    %auth = ( auth_type => $self->option('auth_type'),
              password  => $svc_acct->_password,
              ip        => $svc_acct->slipip,
            );
  }
  return {
    username            => $svc_acct->username,
    protocol            => $self->option('protocol'),
    description         => $desc,
    %auth,
    device_type         => $self->option('device_type'),
    canada_routing      => $self->option('canada_routing'),
    lock_international  => $lockintl,
    international_route => $intl,
    # sensible defaults for these
    music_on_hold       => 'default', # silence
    allowed_codecs      => 'ulaw;g729;gsm',
    dtmf_mode           => 'AUTO',
    nat                 => 'yes',
  };
}

sub did_content {
  my ($self, $svc_phone, $svc_acct) = @_;

  my $account = $self->option('account') . '_' . $svc_acct->username;
  my $phonenum = $svc_phone->phonenum;
  # look up POP number (for some reason this is assigned per DID...)
  my $sip_server = $svc_phone->sip_server
    or return "SIP server required";
  my $popnum = $self->cache('server_popnum')->{ $svc_phone->sip_server }
    or return "SIP server '$sip_server' is unknown";
  return {
    did                 => $phonenum,
    routing             => "account:$account",
    # secondary routing options (failovers, voicemail) are outside our 
    # scope here
    # though we could support them using the "forwarddst" field?
    pop                 => $popnum,
    dialtime            => 60, # sensible default, add an option if needed
    cnam                => ($self->option('cnam_lookup') ? 1 : 0),
    note                => $svc_phone->phone_name,
    billing_type        => $self->option('billing_type'),
  };
}

#################
# DID SELECTION #
#################

sub get_dids_npa_select { 0 } # all Canadian VoIP providers seem to have this

sub get_dids {
  my $self = shift;
  my %opt = @_;

  my ($exportnum) = $self->exportnum =~ /^(\d+)$/;

  if ( $opt{'region'} ) {

    # return numbers (probably shouldn't cache this)
    my ($ratecenter, $province) = $opt{'region'} =~ /^(.*), (..)$/;
    my $country = $self->cache('province_country')->{ $province };
    my $result;
    if ( $country eq 'CAN' ) {
      $result = $self->api_insist('getDIDsCAN',
                                  { province => $province,
                                    ratecenter => $ratecenter
                                  }
                                 );
    } elsif ( $country eq 'USA' ) {
      $result = $self->api_insist('getDIDsUSA',
                                  { state => $province,
                                    ratecenter => $ratecenter
                                  }
                                 );
    }
    my @return = map { $_->{did} } @{ $result->{dids} };
    return \@return;
  } else {

    if ( $opt{'state'} ) {
      my $province = $opt{'state'};

      # cache() will refresh the cache if necessary, and die on failure.
      # default here is only in case someone gives us a state that
      # doesn't exist.
      return $self->cache('province_city', $province) || [];

    } else {

      # return a list of provinces
      return [
        @{ $self->cache('country_province')->{CAN} },
        @{ $self->cache('country_province')->{USA} },
      ];
    }
  }
}

sub get_sip_servers {
  my $self = shift;
  return [ sort keys %{ $self->cache('server_popnum') } ];
}

sub cache {
  my $self = shift;
  my $element = shift or return;
  my $province = shift;

  $CACHE ||= Cache::FileCache->new({
    'cache_root' => $FS::UID::cache_dir.'/cache.'.$FS::UID::datasrc,
    'namespace'  => __PACKAGE__,
    'default_expires_in' => $cache_timeout,
  });

  if ( $element eq 'province_city' ) {
    $element .= ".$province";
  }
  return $CACHE->get($element) || $self->reload_cache($element);
}

sub reload_cache {
  my $self = shift;
  my $element = shift;
  if ( $element eq 'province_country' or $element eq 'country_province' ) {
    # populate provinces/states

    my %province_country;
    my %country_province = ( CAN => [], USA => [] );

    my $result = $self->api_insist('getProvinces');
    foreach my $province (map { $_->{province} } @{ $result->{provinces} }) {
      $province_country{$province} = 'CAN';
      push @{ $country_province{CAN} }, $province;
    }

    $result = $self->api_insist('getStates');
    foreach my $state (map { $_->{state} } @{ $result->{states} }) {
      $province_country{$state} = 'USA';
      push @{ $country_province{USA} }, $state;
    }

    $CACHE->set('province_country', \%province_country);
    $CACHE->set('country_province', \%country_province);
    return $CACHE->get($element);

  } elsif ( $element eq 'server_popnum' ) {

    my $result = $self->api_insist('getServersInfo');
    my %server_popnum;
    foreach (@{ $result->{servers} }) {
      $server_popnum{ $_->{server_hostname} } = $_->{server_pop};
    }

    $CACHE->set('server_popnum', \%server_popnum);
    return \%server_popnum;

  } elsif ( $element =~ /^province_city\.(\w+)$/ ) {

    my $province = $1;

    # then get the ratecenters for that province
    my $country = $self->cache('province_country')->{$province};
    my @ratecenters;

    if ( $country eq 'CAN' ) {

      my $result = $self->api_insist('getRateCentersCAN',
                                   { province => $province });

      foreach (@{ $result->{ratecenters} }) {
        my $ratecenter = $_->{ratecenter} . ", $province"; # disambiguate
        push @ratecenters, $ratecenter;
      }

    } elsif ( $country eq 'USA' ) {

      my $result = $self->api_insist('getRateCentersUSA',
                                   { state => $province });
      foreach (@{ $result->{ratecenters} }) {
        my $ratecenter = $_->{ratecenter} . ", $province";
        push @ratecenters, $ratecenter;
      }

    }

    $CACHE->set($element, \@ratecenters);
    return \@ratecenters;

  } else {
    return;
  }
}

################
# CALL DETAILS #
################

=item import_cdrs START, END

Retrieves CDRs for calls in the date range from START to END and inserts them
as a new CDR batch. On success, returns a new cdr_batch object. On failure,
returns an error message. If there are no new CDRs, returns nothing.

=cut

sub import_cdrs {
  my ($self, $start, $end) = @_;
  $start ||= 0; # all CDRs ever
  $end ||= time;
  $DEBUG ||= $self->option('debug');

  my $oldAutoCommit = $FS::UID::AutoCommit;
  local $FS::UID::AutoCommit = 0;

  ($start, $end) = ($end, $start) if $end < $start;
  $start = DateTime->from_epoch(epoch => $start, time_zone => 'local');
  $end = DateTime->from_epoch(epoch => $end, time_zone => 'local');
  my $accountnum = $self->option('account');
  my $cdr_batch;
  # can't retrieve more than 92 days at a time
  # actually, it's even less than that; on large batches their server
  # sometimes cuts off in mid-sentence. so set the chunk size smaller.
  while ( $start < $end ) {

    my $this_end = $start->clone;
    $this_end->add(days => 14);
    if ($this_end > $end) {
      $this_end = $end;
    }

    my $date_from = $start->strftime('%F');
    my $date_to = $this_end->strftime('%F');
    warn "retrieving CDRs from $date_from to $date_to\n" if $DEBUG;
    my $timezone = $start->strftime('%z') / 100; # integer number of hours
    my $result = $self->api_request('getCDR', {
        date_from => $date_from,
        date_to   => $date_to,
        answered  => 1,
        noanswer  => 1,
        busy      => 1,
        failed    => 1,
        timezone  => $timezone,
    });
    if ( $result->{status} eq 'success' ) {
      if (!$cdr_batch) {
        # then create one
        my $cdrbatchname = 'voip_ms-' . $self->exportnum . '-' . $end->epoch;
        $cdr_batch = FS::cdr_batch->new({ cdrbatch => $cdrbatchname });
        my $error = $cdr_batch->insert;
        if ( $error ) {
          dbh->rollback if $oldAutoCommit;
          return $error;
        }
      }

      foreach ( @{ $result->{cdr} } ) {
        my $uniqueid = $_->{uniqueid};
        # download ranges may overlap; avoid double-importing CDRs
        if ( FS::cdr->row_exists("uniqueid = ?", $uniqueid) ) {
          warn "skipped call with uniqueid = '$uniqueid' (already imported)\n"
            if $DEBUG;
          next;
        }
        # in this case, and probably in other cases in the near future,
        # easier to do this than to create a FS::cdr::* format module
        my $hash = {
          disposition             => $_->{disposition},
          calldate                => $_->{date},
          dst                     => $_->{destination},
          uniqueid                => $_->{uniqueid},
          upstream_price          => $_->{total},
          upstream_dst_regionname => $_->{description},
          clid                    => $_->{callerid},
          duration                => $_->{seconds},
          billsec                 => $_->{seconds},
          cdrbatchnum             => $cdr_batch->cdrbatchnum,
        };
        if ( $_->{date} ) {
          $hash->{startdate} = parse_datetime($_->{date});
        }
        if ( $_->{account} eq $accountnum ) {
          # calls made from the master account, not a subaccount
          # charged_party will be set to the source number
          $hash->{charged_party} = '';
        } elsif ( $_->{account} =~ /^${accountnum}_(\w+)$/ ) {
          $hash->{charged_party} = $1;
        } else {
          warn "skipped call with account = '$_->{account}'\n";
          next;
        }
        if ( $_->{callerid} =~ /<(\w+)>$/ ) {
          $hash->{src} = $1;
        } elsif ( $_->{callerid} =~ /^(\w+)$/ ) {
          $hash->{src} = $1;
        } else {
          # else what? they don't have a source number anywhere else
          warn "skipped call with unparseable callerid '$_->{callerid}'\n";
          next;
        }

        my $cdr = FS::cdr->new($hash);
        my $error = $cdr->insert;
        if ( $error ) {
          dbh->rollback if $oldAutoCommit;
          return "$error (uniqueid $_->{uniqueid})";
        }
      } # foreach @{ $result->{cdr} }

    } elsif ( $result->{status} eq 'no_cdr' ) {
      # normal result if there are no CDRs, duh
      next; # there may still be more CDRs later
    } else {
      dbh->rollback if $oldAutoCommit;
      return "$me error retrieving CDRs: $result->{status}";
    }

    # we've retrieved and inserted this sub-batch of CDRs
    $start->add(days => 15);
  } # while ( $start < $end )

  if ( $cdr_batch ) {
    dbh->commit if $oldAutoCommit;
    return $cdr_batch;
  } else {
    # no CDRs were ever found
    return;
  }
}

##############
# API ACCESS #
##############

=item api_request METHOD, CONTENT

Makes a REST request with method name METHOD, and POST content CONTENT (as
a hashref).

=cut

sub api_request {
  my $self = shift;
  my ($method, $content) = @_;
  $DEBUG ||= 1 if $self->option('debug');
  my $url = URI->new($base_url);
  $url->query_form(
    'method'        => $method,
    'api_username'  => $self->option('username'),
    'api_password'  => $self->option('password'),
    %$content
  );

  my $request = GET($url,
    'Accept'        => 'text/json',
  );

  warn "$me $method\n" if $DEBUG;
  warn $request->as_string ."\n" if $DEBUG > 1;
  my $ua = LWP::UserAgent->new;
  my $response = $ua->request($request);
  warn "$me received\n" . $response->as_string ."\n" if $DEBUG > 1;
  if ( !$response->is_success ) {
    return { status => $response->content };
  }

  local $@;
  my $decoded_response = eval { decode_json($response->content) };
  if ( $@ ) {
    die "Error parsing response:\n" . $response->content . "\n\n";
  }
  return $decoded_response;
}

=item api_insist METHOD, CONTENT

Exactly like L</api_request>, but if the returned "status" is not "success",
throws an exception.

=cut

sub api_insist {
  my $self = shift;
  my $method = $_[0];
  my $result = $self->api_request(@_);
  if ( $result->{status} eq 'success' ) {
    return $result;
  } elsif ( $result->{status} ) {
    die "$me $method: $result->{status}\n";
  } else {
    die "$me $method: no status returned\n";
  }
}

1;