package Crypt::MultiKey::LockMechanism;
our $VERSION = '0.000_002'; # TRIAL VERSION
# ABSTRACT: Implementation of a key-wrapping-scheme used by Coffer and Vault


use v5.12;
use warnings;
use Carp;
use Scalar::Util qw( blessed );
use MIME::Base64 qw( encode_base64 decode_base64 );
use Crypt::SecretBuffer qw( secret );
sub _isa_secret { blessed($_[0]) && $_[0]->isa('Crypt::SecretBuffer') }


our %_attr_pri;
sub new {
   my $class= shift;
   my %attrs= @_ == 1? %{$_[0]} : @_;
   my $self= bless { locks => [] }, $class;
   # Hook for subclasses to process attributes
   $self->_init(\%attrs) if $self->can('_init');
   # Every remaining attribute must have a setter accessor
   for (sort { ($_attr_pri{$a}||0) <=> ($_attr_pri{$b}||0) } keys %attrs) {
      my $setter= "_set_$_";
      $self->$setter($attrs{$_})
   }
   return $self;
}


sub primary_skey { @_ > 1? shift->_set_primary_skey(@_) : $_[0]{primary_skey} }

sub locked { $_[0]->initialized && !defined $_[0]{primary_skey} }

sub initialized { defined $_[0]{primary_skey} || $_[0]{locks} && @{$_[0]{locks}} }

sub _set_primary_skey {
   my ($self, $val)= @_;
   croak "Not a SecretBuffer"
      unless _isa_secret($val);
   $self->{primary_skey}= $val;
   $self;
}

sub cipher_skey {
   my ($self, $size)= @_;
   my $skey= $self->primary_skey || croak "Object is locked";
   return Crypt::MultiKey::hkdf(
      { size => $size//32, kdf_info => 'Crypt::MultiKey/cipher_skey', kdf_salt => '' },
      $skey
   );
}
sub hmac_skey {
   my ($self, $size)= @_;
   my $skey= $self->primary_skey || croak "Object is locked";
   return Crypt::MultiKey::hkdf(
      { size => $size//32, kdf_info => 'Crypt::MultiKey/hmac_skey', kdf_salt => '' },
      $skey
   );
}


sub generate_primary_skey {
   my $self= shift;
   my ($old_locks, $empty_locks)= $self->insert_keys;
   croak "Generating a new primary_skey requires all existing locks to have public keys inserted"
      if @$empty_locks;
   my $new_skey= secret(append_random => 64);
   my @new_locks;
   # If any locks exist, need to create new tumblers
   if (@$old_locks) {
      local $self->{primary_skey}= $new_skey;
      local $self->{locks}= \@new_locks;
      for (@$old_locks) {
         $self->add_access(map $_->{key}, @{ $_->{tumblers} });
      }
   }
   # Nothing crashed, so probably safe to proceeed.
   $self->{primary_skey}= $new_skey;
   @{$self->{locks}}= @new_locks;
   # Likewise for ciphertext fields, but the subclasses manage that.
   $self;
}


sub locks { @_ > 1? shift->_set_locks(@_) : $_[0]{locks} }
sub _set_locks {
   my ($self, $val)= @_;
   $self->_validate_locks($val);
   $self->{locks}= $val;
   $self;
}


sub add_access {
   my ($self, @keys)= @_;
   @keys= @{$keys[0]} if @keys == 1 && ref $keys[0] eq 'ARRAY';
   croak "Require one or more PKey objects"
      unless @keys > 0;
   # No existing encrypted data, so create a new key
   $self->generate_primary_skey
      unless $self->initialized;
   # Ensure we have the key now
   croak "Object must be unlocked in order to ->add_access"
      if $self->locked;
   my @tumblers= map +{ key => $_, key_fingerprint => $_->fingerprint }, @keys;
   my $key_material= secret;
   $_->{key}->generate_key_material($_, $key_material)
      for @tumblers;
   my %lock= ( tumblers => \@tumblers );
   my $symmetric_key= $self->_hkdf_for_lock(\%lock, $key_material);
   # Use the keyslot's aes key to encrypt the primary key
   $lock{ciphertext}= Crypt::MultiKey::symmetric_encrypt(\%lock, $symmetric_key, $self->primary_skey);
   push @{$self->locks}, \%lock;
   return \%lock;
}


sub insert_keys {
   my ($self, @keys)= @_;
   my %by_fingerprint= map +($_->fingerprint => $_), @keys;
   my (@complete, @incomplete);
   for (@{ $self->locks }) {
      my $dest= \@complete;
      for (@{ $_->{tumblers} }) {
         if (my $k= $by_fingerprint{$_->{key_fingerprint}}) {
            # prefer an existing key if it has a private half and the new one does not
            next if $_->{key} && !$k->has_private && $_->{key}->has_private;
            $_->{key}= $k;
         }
         elsif (!$_->{key}) {
            $dest= \@incomplete;
         }
      }
      push @$dest, $_;
   }
   return (\@complete, \@incomplete);
}


sub unlock {
   my ($self, @keys)= @_;
   return if defined $self->{primary_skey};
   @keys= @{$keys[0]} if @keys == 1 && ref $keys[0] eq 'ARRAY';
   for my $pkey (@keys) {
      croak "Expected PKey object"
         unless blessed($pkey) && $pkey->can('has_private');
      croak "key ".$pkey->fingerprint." does not have the private half loaded"
         unless $pkey->has_private;
   }
   my ($complete, $incomplete)= $self->insert_keys(@keys);
   # "complete" is a list of all locks where all keys are present, but might just be the
   # public keys.  Further filter that by which ones have all private keys present.
   my ($primary_skey, @failures);
   for my $lock (@$complete) {
      my $tumblers= $lock->{tumblers};
      next if grep !$_->{key}->has_private, @$tumblers;
      # All private keys are present.  Reconstruct the shared secret key material from
      # the private key and the tumbler of each key in order.
      last if defined eval {
            my $key_material= secret();
            $_->{key}->recreate_key_material($_, $key_material)
               for @$tumblers;
            my $aes_key= $self->_hkdf_for_lock($lock, $key_material);
            $primary_skey= Crypt::MultiKey::symmetric_decrypt($lock, $aes_key, $lock->{ciphertext});
         };
      push @failures, $@;
   }
   if (@failures) {
      if (defined $primary_skey) {
         # If this lock succeeded but others failed, the user should know about that.
         # A lock with all keys present should always succeed, unless perhaps a subclass
         # adds an interactive feature to recreate_key_material...
         carp scalar(@failures)." locks failed to decrypt even though the supplied keys matched";
      } else {
         chomp(@failures);
         croak join "\n  ", map scalar(@failures)." matching locks failed to open using the supplied keys:",
            @failures;
      }
   }
   croak "No lock can be opened using the available keys"
      unless defined $primary_skey;
   $self->primary_skey($primary_skey);
   $self;
}

sub _hkdf_for_lock {
   my ($self, $lock, $key_material)= @_;
   # Use local to set defaults temporarily so they don't get exported.
   local $lock->{kdf_info}= 'Crypt::MultiKey/lock' unless defined $lock->{kdf_info};
   # Salt isn't very useful when the tumbers are made from nonces and single-use ephemeral keys
   local $lock->{kdf_salt}= '' unless defined $lock->{kdf_salt};
   return Crypt::MultiKey::hkdf($lock, $key_material);
}


sub interactive_unlock {
   my ($self, %options)= @_;
   require Crypt::MultiKey::InteractiveUnlock;
   my $iu= Crypt::MultiKey::InteractiveUnlock->new(target => $self, %options);
   $iu->run;
}


sub lock {
   my $self= shift;
   # Make sure there is a way to unlock it!
   croak "Can't lock() when no locks are defined!  (you would lose your data)"
      unless @{ $self->locks };
   delete $self->{primary_skey};
   $self;
}

our %_known_lock_fields= map +($_ => 1),
   qw( cipher kdf_salt ciphertext tumblers );
our %_known_tumbler_fields= map +($_ => 1),
   qw( key key_fingerprint ephemeral_pubkey rsa_key_ciphertext kem_ciphertext );
sub _validate_locks {
   my ($self, $locks)= @_;
   croak "locks must be an arrayref"
      unless ref $locks eq 'ARRAY';
   my @unknown;
   for my $lock_i (0..$#$locks) {
      my $lock= $locks->[$lock_i];
      for (qw( cipher ciphertext )) {
         croak "Missing '$_' in lock $lock_i"
            unless defined $lock->{$_};
      }
      croak "lock[$lock_i]{tumblers} must be an arrayref"
         unless ref $lock->{tumblers} eq 'ARRAY';
      for my $tmbl_i (0..$#{$lock->{tumblers}}) {
         my $tmbl= $lock->{tumblers}[$tmbl_i];
         # Need to be able to identify the key
         croak "No key details for tumbler $tmbl_i"
            unless defined $tmbl->{key} || defined $tmbl->{key_fingerprint};
         # Need either ephemeral_pubkey or rsa_key_ciphertext
         croak "tumbler $tmbl_i must have rsa_key_ciphertext or ephemeral_pubkey or kem_ciphertext"
            unless 1 == defined($tmbl->{rsa_key_ciphertext})
                      + defined($tmbl->{ephemeral_pubkey})
                      + defined($tmbl->{kem_ciphertext});
         @unknown= grep !$_known_tumbler_fields{$_}, keys %$tmbl;
         carp "Unknown tumbler[$tmbl_i] attributes: ".join(', ', @unknown)
            if @unknown;
      }
      @unknown= grep !$_known_lock_fields{$_}, keys %$lock;
      carp "Unknown lock[$lock_i] attributes: ".join(', ', @unknown)
         if @unknown;
   }
   return 1;
}

# Export attributes to JSON-friendly data structure.
# The only attribute right now is 'locks'.
sub _export_attrs {
   my $self= shift;
   # Perform deep clone of locks, and convert binary strings to base64.
   # Also exclude PKey objects and only export the key fingerprint.
   my @locks= @{ $self->locks };
   for my $lock (@locks) {
      $lock= { %$lock };
      for (qw( kdf_salt ciphertext )) {
         $lock->{$_}= encode_base64($lock->{$_}, '')
            if defined $lock->{$_};
      }
      for my $tmbl (@{ $lock->{tumblers}= [ @{$lock->{tumblers}} ] }) {
         $tmbl= { %$tmbl };
         # Need to remove the key objects from the locks definition before serializing.
         delete $tmbl->{key};
         for (qw( ephemeral_pubkey rsa_key_ciphertext kem_ciphertext )) {
            $tmbl->{$_}= encode_base64($tmbl->{$_}, '')
               if defined $tmbl->{$_};
         }
      }
   }
   return { locks => \@locks };
}

# Import attributes from text-friendly structure to actual runtime structure.
# which can be passed to constructor.  This *removes* and modifies a subset of
# the provided attribute hash.
sub _import_attrs {
   my ($self, $attrs)= @_;
   my $locks= delete $attrs->{locks};
   # Ensure structure of locks is valid
   $self->_validate_locks($locks);
   # base64-decode the byte strings
   for my $lock (@$locks) {
      # base64 decode binary fields
      for (qw( kdf_salt ciphertext )) {
         $lock->{$_}= decode_base64($lock->{$_})
            if defined $lock->{$_};
      }
      for my $tmbl (@{$lock->{tumblers}}) {
         for (qw( ephemeral_pubkey rsa_key_ciphertext kem_ciphertext )) {
            $tmbl->{$_}= decode_base64($tmbl->{$_})
               if defined $tmbl->{$_};
         }
      }
   }
   if (ref $self) {
      @{$self->locks}= @$locks;
      return $self;
   } else {
      return { locks => $locks };
   }
}

# Avoid dependency on namespace::clean
delete @Crypt::MultiKey::LockMechanism::{qw(
   blessed carp croak confess
   secret encode_base64 decode_base64
)};

__END__

=pod

=encoding UTF-8

=head1 NAME

Crypt::MultiKey::LockMechanism - Implementation of a key-wrapping-scheme used by Coffer and Vault

=head1 DESCRIPTION

This class implements the "Multi Key" behavior of L<Coffer|Crypt::MultiKey::Coffer> and
L<Vault|Crypt::MultiKey::Vault>.  The basic structure of the C<LockMechanism> is an array of
"locks", each of which has an array of "tumblers".

  # conceptually:
  [
    [ $key1, $key2 ],        # lock 0
    [ $key3 ],               # lock 1
    [ $key4, $key5, $key6 ]  # lock 2
  ]

Each lock independently provides access to the primary symmetric key secret.  A lock can be
opened by inserting one L<PKey|Crypt::MultiKey::PKey> (with private key available) into each of
its tumblers, and calling L</unlock>.

Since each key is a public/private keypair, you can also encrypt a new primary symmetric key
secret when only the public halves of the PKeys are available.  You can also take an existing
C<LockMechanism> and add new locks to it so long as you have the primary symmetric key
decrypted.

This class is only the lock mechanism, and does not handle serialization.

=head1 CONSTRUCTORS

=head2 new

Basic constructor.  Attributes C<locks> and C<primary_skey> can be provided.

=head1 ATTRIBUTES

=head2 primary_skey

A L<Crypt::SecretBuffer> holding the symmetric key used to derive L</cipher_skey> and
L</hmac_skey>.  This is the main secret that is encrypted and decrypted by the locks.

The C<LockMechanism> is logically "locked" when locks are defined but C<primary_skey> is not.
A fresh, uninitialized object is not considered locked.

=over

=item locked

Convenience accessor that returns true if locks exist and C<primary_skey> is not defined.

=item initialized

Convenience accessor that returns true if C<primary_skey> is defined, or if any L</locks> are
defined.

=back

=head2 cipher_skey

A L<Crypt::SecretBuffer> holding the symmetric key to be used for AES encryption of content.

=head2 hmac_skey

A L<Crypt::SecretBuffer> holding the symmetric key to be used for authenticating metadata.

=head2 locks

An arrayref of lock definitions, B<each> of which is sufficient to open the C<LockMechanism>.
Locks are created with L</add_access> method to emphasize that each one I<adds> access to the
secret rather than restricting it.

Each lock is a key-wrapping-scheme that contains an encryption of the L</primary_skey> using a
symmetric key derived from the public half of a list of component public/private keypairs.
During the creation process, one "tumbler" L<is generated|Crypt::MultiKey::PKey/generate_key_material>
for each public/private keypair such that the original symmetric key can only be
L<recreated|Crypt::MultiKey::PKey/recreate_key_material> by engaging the tumbler with the
private half of its key.

  locks => [
    { cipher        => 'AES-256-GCM',
      ciphertext    => $encrypted_bytes,
      tumblers      => [
        { key_fingerprint    => $hashname_and_base64,
          ephemeral_pubkey   => $pubkey_bytes,
          rsa_key_ciphertext => $encrypted_bytes,
        },
        ...
      ],
    },
    ...
  ]

The private half must be present to open the tumbler, but only the public half is needed to
create the tumbler.  This means the C<primary_skey> can be updated even when the private half
of the keys are not available.

=head1 METHODS

=head2 generate_primary_skey

Generate a new L</primary_skey>.  This can only be done when all locks (if any) have at least
their public keys L<inserted|/insert_keys>.

=head2 add_access

  $lockmech->add_access($key1, ... $keyN);

This creates a new L</locks> entry, which provides a new way to access the Coffer/Vault
independent of other locks.
The new lock can be opened when the private half of all N keys are passed to the L</unlock>
method (or L</insert_keys> method).

=head2 insert_keys

  (\@complete_locks, \@incomplete_locks)= $lockmech->insert_keys(@pkeys);

When deserialized from a PEM file, the tumblers of the L</locks> attribute reference keys by
their C<SHA-256> fingerprint.  Those need matched to L<PKey objects|Crypt::MultiKey::PKey>
before L</unlock> can run (though you can also provide the objects at that time).
This method adds PKey objects to the tumblers so that they are already available when you call
L</unlock>, very analogous to inserting a physical key into a keyhole but not turning it.

The references persist in the L</locks> attribute, allowing you to call C<insert_keys> multiple
times if desired to populate additional tumblers.
If a tumbler already contains a C<PKey> object, it will be replaced by the new object in this
list unless the previous included the private half and the new one lacks the private half.

The return value is a pair of arrayrefs, one with the locks which have all PKeys inserted, and
the other of any locks still lacking a PKey object.  This is unrelated to whether the PKey
objects include their private half, needed for L</unlock>.

=head2 unlock

  $lockmech->unlock($key1, ... $keyN);
  # or if you used insert_keys,
  $lockmech->unlock;

This attempts to find a lock which can be unlocked by this list of keys, or a subset of them.
If found, the L</primary_skey> attribute is set, after which decryption and encryption methods
can be used.  All keys provided as parameters must have the private halves available.

=head2 interactive_unlock

  $bool= $lockmech->interactive_unlock(%options);

Shortcut for

  Crypt::MultiKey::InteractiveUnlock
    ->new(target => $lockmech, %options)
    ->run

=head2 lock

Delete the L</primary_skey> attribute and any attributes holding unencrypted secrets.
If this mechanism is part of a Coffer or Vault, you should call the method of the same name on
that object to purge any other unencrypted secrets that object might be holding.

=head1 VERSION

version 0.000_002

=head1 AUTHOR

Michael Conrad <mike@nrdvana.net>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2026 by Michael Conrad.

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

=cut
