package Math::Prime::Util::ChaCha;
use strict;
use warnings;
use Carp qw/carp croak confess/;

BEGIN {
  $Math::Prime::Util::ChaCha::AUTHORITY = 'cpan:DANAJ';
  $Math::Prime::Util::ChaCha::VERSION = '0.73';
}

###############################################################################
# Begin ChaCha core, reference RFC 7539
# with change to make blockcount/nonce be 64/64 from 32/96
# Dana Jacobsen, 9 Apr 2017

BEGIN {
  use constant ROUNDS => 20;
  use constant BUFSZ  => 1024;
  use constant BITS   => (~0 == 4294967295) ? 32 : 64;
}

#  State is:
#       cccccccc  cccccccc  cccccccc  cccccccc
#       kkkkkkkk  kkkkkkkk  kkkkkkkk  kkkkkkkk
#       kkkkkkkk  kkkkkkkk  kkkkkkkk  kkkkkkkk
#       bbbbbbbb  nnnnnnnn  nnnnnnnn  nnnnnnnn
#
#     c=constant k=key b=blockcount n=nonce

# We have to take care with 32-bit Perl so it sticks with integers.
# Unfortunately the pragma "use integer" means signed integer so
# it ruins right shifts.  We also must ensure we save as unsigned.

sub _core {
  my($j, $blocks) = @_;
  my $ks = '';
  $blocks = 1 unless defined $blocks;

  while ($blocks-- > 0) {
    my($x0,$x1,$x2,$x3,$x4,$x5,$x6,$x7,$x8,$x9,$x10,$x11,$x12,$x13,$x14,$x15) = @$j;
    for (1 .. ROUNDS/2) {
      use integer;
      if (BITS == 64) {
        $x0 =($x0 +$x4 )&0xFFFFFFFF; $x12^=$x0 ; $x12=(($x12<<16)|($x12>>16))&0xFFFFFFFF;
        $x8 =($x8 +$x12)&0xFFFFFFFF; $x4 ^=$x8 ; $x4 =(($x4 <<12)|($x4 >>20))&0xFFFFFFFF;
        $x0 =($x0 +$x4 )&0xFFFFFFFF; $x12^=$x0 ; $x12=(($x12<< 8)|($x12>>24))&0xFFFFFFFF;
        $x8 =($x8 +$x12)&0xFFFFFFFF; $x4 ^=$x8 ; $x4 =(($x4 << 7)|($x4 >>25))&0xFFFFFFFF;
        $x1 =($x1 +$x5 )&0xFFFFFFFF; $x13^=$x1 ; $x13=(($x13<<16)|($x13>>16))&0xFFFFFFFF;
        $x9 =($x9 +$x13)&0xFFFFFFFF; $x5 ^=$x9 ; $x5 =(($x5 <<12)|($x5 >>20))&0xFFFFFFFF;
        $x1 =($x1 +$x5 )&0xFFFFFFFF; $x13^=$x1 ; $x13=(($x13<< 8)|($x13>>24))&0xFFFFFFFF;
        $x9 =($x9 +$x13)&0xFFFFFFFF; $x5 ^=$x9 ; $x5 =(($x5 << 7)|($x5 >>25))&0xFFFFFFFF;
        $x2 =($x2 +$x6 )&0xFFFFFFFF; $x14^=$x2 ; $x14=(($x14<<16)|($x14>>16))&0xFFFFFFFF;
        $x10=($x10+$x14)&0xFFFFFFFF; $x6 ^=$x10; $x6 =(($x6 <<12)|($x6 >>20))&0xFFFFFFFF;
        $x2 =($x2 +$x6 )&0xFFFFFFFF; $x14^=$x2 ; $x14=(($x14<< 8)|($x14>>24))&0xFFFFFFFF;
        $x10=($x10+$x14)&0xFFFFFFFF; $x6 ^=$x10; $x6 =(($x6 << 7)|($x6 >>25))&0xFFFFFFFF;
        $x3 =($x3 +$x7 )&0xFFFFFFFF; $x15^=$x3 ; $x15=(($x15<<16)|($x15>>16))&0xFFFFFFFF;
        $x11=($x11+$x15)&0xFFFFFFFF; $x7 ^=$x11; $x7 =(($x7 <<12)|($x7 >>20))&0xFFFFFFFF;
        $x3 =($x3 +$x7 )&0xFFFFFFFF; $x15^=$x3 ; $x15=(($x15<< 8)|($x15>>24))&0xFFFFFFFF;
        $x11=($x11+$x15)&0xFFFFFFFF; $x7 ^=$x11; $x7 =(($x7 << 7)|($x7 >>25))&0xFFFFFFFF;
        $x0 =($x0 +$x5 )&0xFFFFFFFF; $x15^=$x0 ; $x15=(($x15<<16)|($x15>>16))&0xFFFFFFFF;
        $x10=($x10+$x15)&0xFFFFFFFF; $x5 ^=$x10; $x5 =(($x5 <<12)|($x5 >>20))&0xFFFFFFFF;
        $x0 =($x0 +$x5 )&0xFFFFFFFF; $x15^=$x0 ; $x15=(($x15<< 8)|($x15>>24))&0xFFFFFFFF;
        $x10=($x10+$x15)&0xFFFFFFFF; $x5 ^=$x10; $x5 =(($x5 << 7)|($x5 >>25))&0xFFFFFFFF;
        $x1 =($x1 +$x6 )&0xFFFFFFFF; $x12^=$x1 ; $x12=(($x12<<16)|($x12>>16))&0xFFFFFFFF;
        $x11=($x11+$x12)&0xFFFFFFFF; $x6 ^=$x11; $x6 =(($x6 <<12)|($x6 >>20))&0xFFFFFFFF;
        $x1 =($x1 +$x6 )&0xFFFFFFFF; $x12^=$x1 ; $x12=(($x12<< 8)|($x12>>24))&0xFFFFFFFF;
        $x11=($x11+$x12)&0xFFFFFFFF; $x6 ^=$x11; $x6 =(($x6 << 7)|($x6 >>25))&0xFFFFFFFF;
        $x2 =($x2 +$x7 )&0xFFFFFFFF; $x13^=$x2 ; $x13=(($x13<<16)|($x13>>16))&0xFFFFFFFF;
        $x8 =($x8 +$x13)&0xFFFFFFFF; $x7 ^=$x8 ; $x7 =(($x7 <<12)|($x7 >>20))&0xFFFFFFFF;
        $x2 =($x2 +$x7 )&0xFFFFFFFF; $x13^=$x2 ; $x13=(($x13<< 8)|($x13>>24))&0xFFFFFFFF;
        $x8 =($x8 +$x13)&0xFFFFFFFF; $x7 ^=$x8 ; $x7 =(($x7 << 7)|($x7 >>25))&0xFFFFFFFF;
        $x3 =($x3 +$x4 )&0xFFFFFFFF; $x14^=$x3 ; $x14=(($x14<<16)|($x14>>16))&0xFFFFFFFF;
        $x9 =($x9 +$x14)&0xFFFFFFFF; $x4 ^=$x9 ; $x4 =(($x4 <<12)|($x4 >>20))&0xFFFFFFFF;
        $x3 =($x3 +$x4 )&0xFFFFFFFF; $x14^=$x3 ; $x14=(($x14<< 8)|($x14>>24))&0xFFFFFFFF;
        $x9 =($x9 +$x14)&0xFFFFFFFF; $x4 ^=$x9 ; $x4 =(($x4 << 7)|($x4 >>25))&0xFFFFFFFF;
      } else { # 32-bit
        $x0 +=$x4 ; $x12^=$x0 ; $x12=($x12<<16)|(($x12>>16)& 0xFFFF);
        $x8 +=$x12; $x4 ^=$x8 ; $x4 =($x4 <<12)|(($x4 >>20)& 0xFFF);
        $x0 +=$x4 ; $x12^=$x0 ; $x12=($x12<< 8)|(($x12>>24)& 0xFF);
        $x8 +=$x12; $x4 ^=$x8 ; $x4 =($x4 << 7)|(($x4 >>25)& 0x7F);
        $x1 +=$x5 ; $x13^=$x1 ; $x13=($x13<<16)|(($x13>>16)& 0xFFFF);
        $x9 +=$x13; $x5 ^=$x9 ; $x5 =($x5 <<12)|(($x5 >>20)& 0xFFF);
        $x1 +=$x5 ; $x13^=$x1 ; $x13=($x13<< 8)|(($x13>>24)& 0xFF);
        $x9 +=$x13; $x5 ^=$x9 ; $x5 =($x5 << 7)|(($x5 >>25)& 0x7F);
        $x2 +=$x6 ; $x14^=$x2 ; $x14=($x14<<16)|(($x14>>16)& 0xFFFF);
        $x10+=$x14; $x6 ^=$x10; $x6 =($x6 <<12)|(($x6 >>20)& 0xFFF);
        $x2 +=$x6 ; $x14^=$x2 ; $x14=($x14<< 8)|(($x14>>24)& 0xFF);
        $x10+=$x14; $x6 ^=$x10; $x6 =($x6 << 7)|(($x6 >>25)& 0x7F);
        $x3 +=$x7 ; $x15^=$x3 ; $x15=($x15<<16)|(($x15>>16)& 0xFFFF);
        $x11+=$x15; $x7 ^=$x11; $x7 =($x7 <<12)|(($x7 >>20)& 0xFFF);
        $x3 +=$x7 ; $x15^=$x3 ; $x15=($x15<< 8)|(($x15>>24)& 0xFF);
        $x11+=$x15; $x7 ^=$x11; $x7 =($x7 << 7)|(($x7 >>25)& 0x7F);
        $x0 +=$x5 ; $x15^=$x0 ; $x15=($x15<<16)|(($x15>>16)& 0xFFFF);
        $x10+=$x15; $x5 ^=$x10; $x5 =($x5 <<12)|(($x5 >>20)& 0xFFF);
        $x0 +=$x5 ; $x15^=$x0 ; $x15=($x15<< 8)|(($x15>>24)& 0xFF);
        $x10+=$x15; $x5 ^=$x10; $x5 =($x5 << 7)|(($x5 >>25)& 0x7F);
        $x1 +=$x6 ; $x12^=$x1 ; $x12=($x12<<16)|(($x12>>16)& 0xFFFF);
        $x11+=$x12; $x6 ^=$x11; $x6 =($x6 <<12)|(($x6 >>20)& 0xFFF);
        $x1 +=$x6 ; $x12^=$x1 ; $x12=($x12<< 8)|(($x12>>24)& 0xFF);
        $x11+=$x12; $x6 ^=$x11; $x6 =($x6 << 7)|(($x6 >>25)& 0x7F);
        $x2 +=$x7 ; $x13^=$x2 ; $x13=($x13<<16)|(($x13>>16)& 0xFFFF);
        $x8 +=$x13; $x7 ^=$x8 ; $x7 =($x7 <<12)|(($x7 >>20)& 0xFFF);
        $x2 +=$x7 ; $x13^=$x2 ; $x13=($x13<< 8)|(($x13>>24)& 0xFF);
        $x8 +=$x13; $x7 ^=$x8 ; $x7 =($x7 << 7)|(($x7 >>25)& 0x7F);
        $x3 +=$x4 ; $x14^=$x3 ; $x14=($x14<<16)|(($x14>>16)& 0xFFFF);
        $x9 +=$x14; $x4 ^=$x9 ; $x4 =($x4 <<12)|(($x4 >>20)& 0xFFF);
        $x3 +=$x4 ; $x14^=$x3 ; $x14=($x14<< 8)|(($x14>>24)& 0xFF);
        $x9 +=$x14; $x4 ^=$x9 ; $x4 =($x4 << 7)|(($x4 >>25)& 0x7F);
      }
    }
    $ks .= pack("V16",$x0 +$j->[ 0],$x1 +$j->[ 1],$x2 +$j->[ 2],$x3 +$j->[ 3],
                      $x4 +$j->[ 4],$x5 +$j->[ 5],$x6 +$j->[ 6],$x7 +$j->[ 7],
                      $x8 +$j->[ 8],$x9 +$j->[ 9],$x10+$j->[10],$x11+$j->[11],
                      $x12+$j->[12],$x13+$j->[13],$x14+$j->[14],$x15+$j->[15]);
    if (++$j->[12] > 4294967295) {
      $j->[12] = 0;
      $j->[13]++;
    }
  }
  $ks;
}
sub _test_core {
  return unless ROUNDS == 20;
  my $init_state = '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001090000004a00000000000000';
  my @state = map { hex("0x$_") } unpack "a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8", $init_state;
  my $instr = join("",map { sprintf("%08x",$_) } @state);
  die "Block function fail test 2.3.2 input" unless $instr eq '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001090000004a00000000000000';
  my @out = unpack("V16", _core(\@state));
  my $outstr = join("",map { sprintf("%08x",$_) } @out);
  #printf "  %08x  %08x  %08x  %08x\n  %08x  %08x  %08x  %08x\n  %08x  %08x  %08x  %08x\n  %08x  %08x  %08x  %08x\n", @state;
  die "Block function fail test 2.3.2 output" unless $outstr eq 'e4e7f11015593bd11fdd0f50c47120a3c7f4d1c70368c0339aaa22044e6cd4c3466482d209aa9f0705d7c214a2028bd9d19c12b5b94e16dee883d0cb4e3c50a2';
}
_test_core();

# Returns integral number of 64-byte blocks.
sub _keystream {
  my($nbytes, $rstate) = @_;
  croak "Keystream invalid state" unless scalar(@$rstate) == 16;
  _core($rstate, ($nbytes+63) >> 6);
}
sub _test_keystream {
  return unless ROUNDS == 20;
  my $init_state = '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001000000004a00000000000000';
  my @state = map { hex("0x$_") } unpack "a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8a8", $init_state;
  my $instr = join("",map { sprintf("%08x",$_) } @state);
  die "Block function fail test 2.4.2 input" unless $instr eq '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000001000000004a00000000000000';
  my $keystream = _keystream(114, \@state);
  # Verify new state
  my $outstr = join("",map { sprintf("%08x",$_) } @state);
  die "Block function fail test 2.4.2 output" unless $outstr eq '617078653320646e79622d326b20657403020100070605040b0a09080f0e0d0c13121110171615141b1a19181f1e1d1c00000003000000004a00000000000000';
  my $ksstr = unpack("H*",$keystream);
  die "Block function fail test 2.4.2 keystream" unless substr($ksstr,0,2*114) eq '224f51f3401bd9e12fde276fb8631ded8c131f823d2c06e27e4fcaec9ef3cf788a3b0aa372600a92b57974cded2b9334794cba40c63e34cdea212c4cf07d41b769a6749f3f630f4122cafe28ec4dc47e26d4346d70b98c73f3e9c53ac40c5945398b6eda1a832c89c167eacd901d7e2bf363';
}
_test_keystream();

# End ChaCha core
###############################################################################

# Simple PRNG used to fill small seeds
sub _prng_next {
  my($s) = @_;
  my $word;
  my $oldstate = $s->[0];
  if (BITS == 64) {
    $s->[0] = ($s->[0] * 747796405 + $s->[1]) & 0xFFFFFFFF;
    $word = ((($oldstate >> (($oldstate >> 28) + 4)) ^ $oldstate) * 277803737) & 0xFFFFFFFF;
  } else {
    { use integer; $s->[0] = unpack("L",pack("L", $s->[0] * 747796405 + $s->[1] )); }
    $word = (($oldstate >> (($oldstate >> 28) + 4)) ^ $oldstate) & 0xFFFFFFFF;
    { use integer; $word = unpack("L",pack("L", $word * 277803737)); }
  }
  ($word >> 22) ^ $word;
}
sub _prng_new {
  my($a,$b,$c,$d) = @_;
  my @s = (0, (($b << 1) | 1) & 0xFFFFFFFF);
  _prng_next(\@s);
  $s[0] = ($s[0] + $a) & 0xFFFFFFFF;
  _prng_next(\@s);
  $s[0] = ($s[0] ^ $c) & 0xFFFFFFFF;
  _prng_next(\@s);
  $s[0] = ($s[0] ^ $d) & 0xFFFFFFFF;
  _prng_next(\@s);
  \@s;
}
###############################################################################

# These variables are not accessible outside this file by standard means.
{
  my $_goodseed;     # Did we get a long seed
  my $_state;        # the cipher state.  40 bytes user data, 64 total.
  my $_str;          # buffered to-be-sent output.

  sub _is_csprng_well_seeded { $_goodseed }

  sub csrand {
    my($seed) = @_;
    $_goodseed = length($seed) >= 16;
    while (length($seed) % 4) { $seed .= pack("C",0); }  # zero pad end word
    my @seed = unpack("V*",substr($seed,0,40));
    # If not enough data, fill rest using simple RNG
    if ($#seed < 9) {
      my $rng = _prng_new(map { $_ <= $#seed ? $seed[$_] : 0 } 0..3);
      push @seed, _prng_next($rng) while $#seed < 9;
    }
    croak "Seed count failure" unless $#seed == 9;
    $_state = [0x61707865, 0x3320646e, 0x79622d32, 0x6b206574,
               @seed[0..7],
               0, 0, @seed[8..9]];
    $_str = '';
  }
  sub srand {
    my $seed = shift;
    $seed = CORE::rand unless defined $seed;
    if ($seed <= 4294967295) { csrand(pack("V",$seed)); }
    else                     { csrand(pack("V2",$seed,$seed>>32)); }
    $seed;
  }
  sub irand {
    $_str .= _keystream(BUFSZ,$_state) if length($_str) < 4;
    return unpack("V",substr($_str, 0, 4, ''));
  }
  sub irand64 {
    return irand() if ~0 == 4294967295;
    $_str .= _keystream(BUFSZ,$_state) if length($_str) < 8;
    ($a,$b) = unpack("V2",substr($_str, 0, 8, ''));
    return ($a << 32) | $b;
  }
  sub random_bytes {
    my($bytes) = @_;
    $bytes = (defined $bytes) ? int abs $bytes : 0;
    $_str .= _keystream($bytes-length($_str),$_state) if length($_str) < $bytes;
    return substr($_str, 0, $bytes, '');
  }
}

1;

__END__


# ABSTRACT:  Pure Perl ChaCha20 CSPRNG

=pod

=encoding utf8

=head1 NAME

Math::Prime::Util::ChaCha - Pure Perl ChaCha20 CSPRNG


=head1 VERSION

Version 0.73


=head1 SYNOPSIS

=head1 DESCRIPTION

A pure Perl implementation of ChaCha20 with a CSPRNG interface.

=head1 FUNCTIONS

=head2 csrand

Takes a binary string as input and seeds the internal CSPRNG.

=head2 srand

A method for sieving the CSPRNG with a small value.  This will not be secure
but can be useful for simulations and emulating the system C<srand>.

With no argument, chooses a random number, seeds and returns the number.
With a single integer argument, seeds and returns the number.

=head2 irand

Returns a random 32-bit integer.

=head2 irand64

Returns a random 64-bit integer.

=head2 random_bytes

Takes an unsigned number C<n> as input and returns that many random bytes
as a single binary string.

=head2

=head1 AUTHORS

Dana Jacobsen E<lt>dana@acm.orgE<gt>

=head1 ACKNOWLEDGEMENTS

Daniel J. Bernstein wrote the ChaCha family of stream ciphers in 2008 as
an update to the popular Salsa20 cipher from 2005.

RFC7539: "ChaCha20 and Poly1305 for IETF Protocols" was used to create both
the C and Perl implementations.  Test vectors from that document are used
here as well.

For final optimizations I got ideas from Christopher Madsen's
L<Crypt::Salsa20> for how to best work around some of Perl's aggressive
dynamic typing.
Our core is still about 20% slower than Salsa20.

=head1 COPYRIGHT

Copyright 2017 by Dana Jacobsen E<lt>dana@acm.orgE<gt>

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut