Much wider support for Catacomb in all its glory.

[catacomb-perl] / Catacomb / EC.pm

# -*-perl-*-
#
# $Id$
#
# Elliptic curves
#
# (c) 2004 Straylight/Edgeware
#

#----- Licensing notice -----------------------------------------------------
#
# This file is part of the Perl interface to Catacomb.
#
# Catacomb/Perl is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# Catacomb/Perl is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with Catacomb/Perl; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#----- Elliptic curves ------------------------------------------------------

package Catacomb::EC::Curve;
use Carp;
use Catacomb::Base;
use Catacomb::Cache;
use Catacomb::Field;

$cache = Catacomb::Cache->new();

sub intern {
  croak("Usage: Catacomb::EC::Curve::intern(c)") unless @_ == 1;
  my ($c) = @_;
  return $cache->intern($c);
}

sub pt {
  croak("Usage: Catacomb::EC::Curve::pt(c, [x, y | p])")
    unless @_ >= 1 && @_ <= 3;
  return Catacomb::EC::Pt->new(@_);
}

sub a {
  croak("Usage: Catacomb::EC::Curve::a(c)") unless @_ == 1;
  my ($c) = @_;
  return $c->field()->elt($c->_a());
}

sub b {
  croak("Usage: Catacomb::EC::Curve::b(c)") unless @_ == 1;
  my ($c) = @_;
  return $c->field()->elt($c->_b());
}

sub inf {
  croak("Usage: Catacomb::EC::Curve::inf(c)") unless @_ == 1;
  return Catacomb::EC::Pt->new($_[0]);
}

sub getraw {
  croak("Usage: Catacomb::EC::Curve::getraw(c, s)") unless @_ == 2;
  my ($c, $s) = @_;
  my ($p, $rest) = $c->_getraw($s);
  $p = Catacomb::EC::Pt->new($c, $p);
  return !wantarray() ? $p : ($p, $rest);
}

sub find {
  croak("Usage: Catacomb::EC::Curve::find(c, x)") unless @_ == 2;
  my ($c, $x) = @_;
  my $p = $c->_find($x);
  return undef unless defined $p;
  return Catacomb::EC::Pt->new($c, $p);
}

sub rand {
  croak("Usage: Catacomb::EC::Curve::rand(c, [rng])")
    unless @_ >= 1 && @_ <= 2;
  my ($c, $rng) = @_;
  $rng ||= $Catacomb::random;
  my $p = $c->_rand($rng);
  return Catacomb::EC::Pt->new($c, $p);
}

sub mmul {
  croak("Usage: Catacomb::EC::Curve::mmul(c, p_0, x_0, p_1, x_1, ...)")
    unless @_ >= 3 && @_ % 2 == 1;
  my $c = pop(@_);
  my $i;
  my @v = ();
  my @r = ();
  for ($i = 0; $i < @_; $i += 2) {
    my $p = $_[$i];
    my $n = $_[$i + 1];
    if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) {
      $p->[1] == $c or croak("curve mismatch");
      @r or @r = @$p[1, 2, 3, 4];
      $p = $p->[0];
    } elsif (UNIVERSAL::isa($p, Catacomb::EC::Point)) {
      $p = $c->in($p);
    } else {
      croak("not a curve point");
    }
    push(@v, $p, $n);
  }
  unless (@r) {
    my ($cr, $f, $fr);
    ($c, $cr) = $c->intern();
    ($f, $fr) = $c->field()->intern();
    @r = ($c, $cr, $f, $fr);
  }
  return Catacomb::EC::Pt::_pt(immul($c, @v), $c, $cr, $f, $fr);
}

sub getinfo {
  croak("Usage: Catacomb::EC::Curve::getinfo(me, spec)") unless @_ == 2;
  my ($me, $spec) = @_;
  my ($c, $p, $r, $h) = _getinfo($me, $spec);
  my $cr;
  ($c, $cr) = $c->intern();
  return $c, $c->pt($p), $r, $h;
}

sub ecgroup {
  croak("Usage: Catacomb::EC::Curve::ecgroup(c, p, r, h)") unless @_ == 4;
  return Catacomb::Group->ec(@_);
}

#----- Elliptic curve points ------------------------------------------------

package Catacomb::EC::Point;

sub tostring {
  croak("Usage: Catacomb::EC::Point::tostring(p)") unless @_ == 1;
  my ($p) = @_;
  if ($p->atinfp()) {
    return "inf";
  } else {
    return "0x" . $p->x()->tostring(16) . ", 0x" . $p->y()->tostring(16);
  }
}

package Catacomb::EC::Pt;
use Carp;
use Catacomb::Base;
use Catacomb::Field;

sub _pt { bless [@_], Catacomb::EC::Pt; }

sub _convert {
  my ($c, $cr, $f, $fr, $x) = @_;
  if (UNIVERSAL::isa($x, Catacomb::EC::Pt)) {
    croak("curve mismatch") unless $c == $x->[1];
    return $x;
  }
  if (UNIVERSAL::isa($x, Catacomb::EC::Point)) {
    return _pt($x, $c, $cr, $f, $fr);
  }
  croak("can't convert to curve point");
}

sub new {
  croak("Usage: Catacomb::EC::Pt::new(me, c, [x, y | p])")
    unless @_ >= 2 && @_ <= 4;
  my ($me, $c, $p);
  if (@_ == 2) {
    ($me, $c) = @_;
    $p = Catacomb::EC::Point->new();
  } elsif (@_ == 3) {
    ($me, $c, $p) = @_;
    if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) {
      $p = $p->point();
    } elsif (!UNIVERSAL::isa($p, Catacomb::EC::Point)) {
      croak("not a curve point");
    }
  } else {
    my ($x, $y);
    ($me, $c, $x, $y) = @_;
    $p = Catacomb::EC::Point->new($x, $y);
  }
  my ($cr, $f, $fr);
  ($c, $cr) = $c->intern();
  ($f, $fr) = $c->field()->intern();
  return _pt($c->in($p), $c, $cr, $f, $fr);
}

sub point {
  croak("Usage: Catacomb::EC::Pt::point(p)") unless @_ == 1;
  return $_[0][1]->out($_[0][0]);
}

sub curve {
  croak("Usage: Catacomb::EC::Pt::curve(p)") unless @_ == 1;
  return $_[0][1];
}

sub field {
  croak("Usage: Catacomb::EC::Pt::field(p)") unless @_ == 1;
  return $_[0][3];
}

sub atinfp {
  croak("Usage: Catacomb::EC::Pt::atinfp(p)") unless @_ == 1;
  return $_[0]->point()->atinfp();
}

sub x {
  croak("Usage: Catacomb::EC::Pt::x(p)") unless @_ == 1;
  return $_[0][3]->elt($_[0]->point()->x());
}

sub y {
  croak("Usage: Catacomb::EC::Pt::y(p)") unless @_ == 1;
  return $_[0][3]->elt($_[0]->point()->y());
}

sub check {
  croak("Usage: Catacomb::EC::Curve::check(c)") unless @_ == 1;
  return $_[0][1]->check($_[0][0]);
}

sub pt {
  croak("Usage: Catacomb::EC::Pt::pt(pp, [x, y | p])")
    unless @_ >= 1 && @_ <= 3;
  my ($pp, $p);
  if (@_ == 1) {
    ($pp) = @_;
    $p = Catacomb::EC::Point->new();
  } elsif (@_ == 2) {
    ($pp, $p) = @_;
    if (UNIVERSAL::isa($p, Catacomb::EC::Pt)) {
      $p = $p->point();
    } elsif (!UNIVERSAL::isa($p, Catacomb::EC::Point)) {
      croak("not a curve point");
    }
  } else {
    my ($x, $y);
    ($pp, $x, $y) = @_;
    $p = Catacomb::EC::Point->new($x, $y);
  }
  my (undef, $c, $cr, $f, $fr) = @$pp;
  return _pt($c->in($p), $c, $cr, $f, $fr);
}

sub _binop {
  my ($op, $x, $y, $swap) = @_;
  my (undef, $c, $cr, $f, $fr) = @$x;
  $y = _convert($c, $cr, $f, $fr, $y);
  my $z = $swap ?
    &$op($c, $x->[0], $y->[0]) :
    &$op($c, $y->[0], $x->[0]);
  return _pt($z, $c, $cr, $f, $fr);
}

sub _unop {
  my ($op, $x) = @_;
  my (undef, $c, $cr, $f, $fr) = @$x;
  my $z =  &$op($c, $x->[0]);
  return _pt($z, $c, $cr, $f, $fr);
}

sub _eq {
  my ($x, $y) = @_;
  my (undef, $c, $cr, $f, $fr) = @$x;
  $y = _convert($c, $cr, $f, $fr, $y);
  return Catacomb::EC::Point::eq($c->out($x), $c->out($y));
}

sub mul {
  croak("Usage: Catacomb::EC::Pt::mul(p, n)") unless @_ == 2;
  my ($p, $x) = @_;
  my ($pp, $c, $cr, $f, $fr) = @$p;
  return _pt($c->imul($pp, $x), $c, $cr, $f, $fr);
}

use overload
  '+' => sub { _binop(\&Catacomb::EC::Curve::iadd, @_); },
  '-' => sub { _binop(\&Catacomb::EC::Curve::isub, @_); },
  '*' => sub { mul($_[0], $_[1]); },
  '==' => sub { _eq(@_); },
  '!=' => sub { !_eq(@_); },
  'eq' => sub { _eq(@_); },
  'ne' => sub { !_eq(@_); },
  '""' => sub { $_[0]->point()->tostring(); },
  '0+' => sub { $_[0]->point()->x()->toint(); },
  'neg' => sub { _unop(\&Catacomb::EC::Curve::ineg, @_); };

#----- That's all, folks ----------------------------------------------------