package Lemonldap::NG::Common::Conf::RESTServer;

use strict;
use JSON 'from_json';
use Mouse;
use Lemonldap::NG::Common::Conf::Constants;
use Lemonldap::NG::Common::Conf::ReConstants;

our $VERSION = '2.0.12';

extends 'Lemonldap::NG::Common::Conf::AccessLib';

#######################
# I. PRIVATE METHODS #
#######################

## @method scalar getConfKey($req, $key)
# Return key value
#
# Return the value of $key key in current configuration. If cfgNum is set to
# `latest`, get before last configuration number.
#
# Errors: set an error in $req->error and return undef if:
#  * query does not have a cfgNum parameter (set by Common/PSGI/Router.pm)
#  * cfgNum is not a number
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param $key Key name
#@return keyvalue (string, int or hashref)
sub getConfKey {
    my ( $self, $req, $key, @args ) = @_;
    $self->logger->debug("Search for $key in conf");

    # Verify that cfgNum has been asked
    unless ( defined $req->params('cfgNum') ) {
        $req->error("Missing configuration number");
        return undef;
    }
    $self->logger->debug( "Cfgnum set to " . $req->params('cfgNum') );

    # when 'latest' => replace by last cfgNum
    if ( $req->params('cfgNum') eq 'latest' ) {
        my $tmp = $self->confAcc->lastCfg;
        $req->set_param( 'cfgNum', $tmp );
        unless ($tmp) {
            $req->error($Lemonldap::NG::Common::Conf::msg)
              if ($Lemonldap::NG::Common::Conf::msg);
            return undef;
        }
    }
    elsif ( $req->params('cfgNum') !~ /^\d+$/ ) {
        $req->error("cfgNum must be a number");
        return undef;
    }
    unless (
        defined $self->getConfByNum( scalar( $req->params('cfgNum') ), @args ) )
    {
        $req->error( "Configuration "
              . $req->params('cfgNum')
              . " is not available ("
              . $Lemonldap::NG::Common::Conf::msg
              . ')' );
        return undef;
    }

    # TODO: insert default values
    # Set an error if key is not defined
    return $self->currentConf->{$key};
}

sub getConfByNum {
    my ( $self, $cfgNum, @args ) = @_;
    unless ($self->currentConf
        and %{ $self->currentConf }
        and $cfgNum == $self->currentConf->{cfgNum} )
    {
        my $tmp = $self->confAcc->getConf(
            { cfgNum => $cfgNum, raw => 1, noCache => 1, @args } );
        return undef unless ( $tmp and ref($tmp) and %$tmp );
        $self->currentConf($tmp);
    }
    return $cfgNum;
}

########################
# II. Display methods #
########################

# Values are send depending of the /path/info/. For example,
# /confs/1/portal to get portal value.

# This section contains several methods:
#  - complex nodes:
#    * complexNodesRoot() call for root queries (no subkeys) to display the list
#    * virtualHosts()
#    * _samlMetaDataNodes() is called by saml(IDP|RP)MetaDataNode
#    * _oidcMetaDataNodes() is called by oidc(OP|RP)MetaDataNodes
#  - other special nodes:
#    * authChoiceModules()
#    * grantSessionRules()
#    * openIdIDPList() (old OpenID)
#    * applicationList()
#  - root:
#    root query (/confs/latest for example) is redirected to metadata()
#  - other requests:
#    they are managed by getKey()
#  - newRSAKey() returns a new RSA key pair if /confs/newRSAKey is called in a
#    POST request
#  - prx() load a request and return the content (for SAML/OIDC metadata)

# 31 - Complex subnodes
#      ----------------

## @method PSGI-JSON-response complexNodesRoot($req, $query, $tpl)
# Respond to root requests for virtual hosts and SAMLmetadata
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param $query Configuration root key
#@param $tpl Javascript template to use (see JS/JSON generator script)
#@return PSGI JSON response
sub complexNodesRoot {
    my ( $self, $req, $query, $tpl ) = @_;
    $self->logger->debug("Query for $query template keys");

    my $tmp = $self->getConfKey( $req, $query );
    return $self->sendError( $req, undef, 400 ) if ( $req->error );

    my @res;
    if ( ref($tmp) ) {
        foreach my $f ( sort keys %$tmp ) {
            push @res,
              {
                id       => "${tpl}s/$f",
                title    => $f,
                type     => $tpl,
                template => $tpl
              };
        }
    }
    return $self->sendJSONresponse( $req, \@res );
}

# 311 - Virtual hosts
#       -------------

## @method PSGI-JSON-response virtualHosts($req, @path)
# Respond to virtualhosts sub requests
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `virtualhosts`
#@return PSGI JSON response
sub virtualHosts {
    my ( $self, $req, @path ) = @_;

    return $self->complexNodesRoot( $req, 'locationRules', 'virtualHost' )
      unless (@path);

    my $vh = shift @path;
    my $query;
    unless ( $query = shift @path ) {
        return $self->sendError( $req,
            'Bad request: virtualHost query must ask for a key', 400 );
    }

    # Send setDefault for new vhosts
    return $self->sendError( $req, 'setDefault', 200 ) if ( $vh =~ /^new__/ );

    # Reject unknown vhosts
    return $self->sendError( $req, "Unknown virtualhost ($vh)", 400 )
      unless ( defined $self->getConfKey( $req, 'locationRules' )->{$vh} );

    if ( $query =~ /^(?:(?:exportedHeader|locationRule)s|post)$/ ) {
        my ( $id, $resp ) = ( 1, [] );
        my $vhk = eval { $self->getConfKey( $req, $query )->{$vh} } // {};
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        $self->logger->debug("Query for $vh/$query keys");

        # Keys are ordered except 'default' which must be at the end
        foreach my $r (
            sort {
                $query eq 'locationRules'
                  ? (
                    $a eq 'default'
                    ? 1
                    : ( $b eq 'default' ? -1 : $a cmp $b )
                  )
                  : $a cmp $b
            } keys %$vhk
          )
        {
            my $res = {
                id    => "virtualHosts/$vh/$query/" . $id++,
                title => $r,
                data  => $vhk->{$r},
                type  => 'keyText',
            };

            # If rule contains a comment or an AuthLevel, split them
            if ( $query eq 'locationRules' ) {
                $res->{comment} = '';
                $res->{level}   = '';
                $res->{level}   = $1 if ( $r =~ s/\(\?#AuthnLevel=(-?\d+)\)// );
                if ( $r =~ s/\(\?#(.*?)\)// ) {
                    $res->{title} = $res->{comment} = $1;
                }
                $res->{re}   = $r;
                $res->{type} = 'rule';
            }
            elsif ( $query eq 'post' ) {
                $res->{data} = $vhk->{$r};
                $res->{type} = 'post';
            }
            push @$resp, $res;
        }
        return $self->sendJSONresponse( $req, $resp );
    }
    elsif ( $query =~ qr/^$virtualHostKeys$/o ) {
        $self->logger->debug("Query for $vh/$query key");

        # TODO: verify how this is done actually
        my $k1 = $self->getConfKey( $req, 'vhostOptions' );
        return $self->sendError( $req, undef, 400 ) if ( $req->error );

        # Default values are set by JS
        my $res = eval { $k1->{$vh}->{$query} } // undef;
        return $self->sendJSONresponse( $req, { value => $res } );
    }
    else {
        return $self->sendError( $req, "Unknown vhost subkey ($query)", 400 );
    }
}

# 312 - SAML
#       ----

## @method PSGI-JSON-response _samlMetaDataNode($type, $req, @path)
# Respond to SAML metadata subnodes
#
#@param $type `SP` or `IDP`
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `saml{IDP|SP}MetaDataNode`
#@return PSGI JSON response
sub _samlMetaDataNodes {
    my ( $self, $type, $req, @path ) = @_;

    return $self->complexNodesRoot( $req, "saml${type}MetaDataXML",
        "saml${type}MetaDataNode" )
      unless (@path);
    my $partner = shift @path;
    my $query   = shift @path;
    unless ($query) {
        return $self->sendError( $req,
            "Bad request: saml${type}MetaDataNode query must ask for a key",
            400 );
    }

    # setDefault response for new partners
    return $self->sendError( $req, 'setDefault', 200 )
      if ( $partner =~ /^new__/ );

    # Reject unknown partners
    return $self->sendError( $req, "Unknown SAML partner ($partner)", 400 )
      unless (
        defined eval {
            $self->getConfKey( $req, "saml${type}MetaDataXML" )->{$partner};
        }
      );

    my ( $id, $resp ) = ( 1, [] );

    # Return all exported attributes if asked
    if ( $query =~ /^saml${type}MetaDataExportedAttributes$/ ) {
        my $pk =
          eval { $self->getConfKey( $req, $query )->{$partner} } // {};
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        foreach my $h ( sort keys %$pk ) {
            push @$resp,
              {
                id    => "saml${type}MetaDataNodes/$partner/$query/" . $id++,
                title => $h,
                data  => [ split /;/, $pk->{$h} ],
                type  => 'samlAttribute',
              };
        }
        return $self->sendJSONresponse( $req, $resp );
    }
    elsif ( $query eq "samlSPMetaDataMacros" ) {
        my $pk =
          eval { $self->getConfKey( $req, $query )->{$partner} } // {};
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        foreach my $h ( sort keys %$pk ) {
            push @$resp,
              {
                id    => "saml${type}MetaDataNodes/$partner/$query/" . $id++,
                title => $h,
                data  => $pk->{$h},
                type  => 'keyText',
              };
        }
        return $self->sendJSONresponse( $req, $resp );
    }

    # Simple root keys
    elsif ( $query =~ /^saml${type}MetaDataXML$/ ) {
        my $value =
          eval { $self->getConfKey( $req, $query )->{$partner}->{$query}; }
          // undef;
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        return $self->sendJSONresponse( $req, { value => $value } );
    }

    # These regexps are generated by jsongenerator.pl and stored in
    # Lemonldap::NG::Common::Conf::ReConstants
    elsif (
        $query =~ {
            IDP => qr/^$samlIDPMetaDataNodeKeys$/o,
            SP  => qr/^$samlSPMetaDataNodeKeys$/o
        }->{$type}
      )
    {
        my $value = eval {
            $self->getConfKey( $req, "saml${type}MetaDataOptions" )->{$partner}
              ->{$query};
        } // undef;

        # Note that types "samlService" and "samlAssertion" will be splitted by
        # manager.js in an array
        return $self->sendJSONresponse( $req, { value => $value } );
    }
    else {
        return $self->sendError( $req,
            "Bad key for saml${type}MetaDataNode ($query)", 400 );
    }
}

## @method PSGI-JSON-response samlIDPMetaDataNode($req, @path)
# Launch _samlMetaDataNode('IDP', @_)
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `samlIDPMetaDataNode`
#@return PSGI JSON response
sub samlIDPMetaDataNodes {
    my ( $self, $req, @path ) = @_;
    return $self->_samlMetaDataNodes( 'IDP', $req, @path );
}

## @method PSGI-JSON-response samlSPMetaDataNode($req, @path)
# Launch _samlMetaDataNode('SP', @_)
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `samlSPMetaDataNode`
#@return PSGI JSON response
sub samlSPMetaDataNodes {
    my ( $self, $req, @path ) = @_;
    return $self->_samlMetaDataNodes( 'SP', $req, @path );
}

# 313 - OpenID-Connect
#       --------------

## @method PSGI-JSON-response _oidcMetaDataNodes($type, $req, @path)
# Respond to OpenID-Connect metadata subnodes
#
#@param $type `OP` or `RP`
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `oidc{OP|RP}MetaDataNode`
#@return PSGI JSON response
sub _oidcMetaDataNodes {
    my ( $self, $type, $req, @path ) = @_;

    my $refKey =
      ( $type eq 'RP' ? 'oidcRPMetaDataOptions' : 'oidcOPMetaDataJSON' );
    return $self->complexNodesRoot( $req, $refKey, "oidc${type}MetaDataNode" )
      unless (@path);

    my $partner = shift @path;
    my $query   = shift @path;
    unless ($query) {
        return $self->sendError( $req,
            "Bad request: oidc${type}MetaDataNode query must ask for a key",
            400 );
    }

    # setDefault response for new partners
    return $self->sendError( $req, 'setDefault', 200 )
      if ( $partner =~ /^new__/ );

    # Reject unknown partners
    return $self->sendError( $req,
        "Unknown OpenID-Connect partner ($partner)", 400 )
      unless ( defined eval { $self->getConfKey( $req, $refKey )->{$partner}; }
      );

    my ( $id, $resp ) = ( 1, [] );

    # Handle RP Attributes
    if ( $query eq "oidcRPMetaDataExportedVars" ) {
        my $pk = eval { $self->getConfKey( $req, $query )->{$partner} } // {};
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        foreach my $h ( sort keys %$pk ) {

            # Set default values for type and array
            my $data = [ split /;/, $pk->{$h} ];
            unless ( $data->[1] ) {
                $data->[1] = "string";
            }
            unless ( $data->[2] ) {
                $data->[2] = "auto";
            }
            push @$resp,
              {
                id    => "oidc${type}MetaDataNodes/$partner/$query/" . $id++,
                title => $h,
                data  => $data,
                type  => 'oidcAttribute',
              };
        }
        return $self->sendJSONresponse( $req, $resp );
    }

    # Return all exported attributes if asked
    elsif ( $query =~
/^(?:oidc${type}MetaDataExportedVars|oidcRPMetaDataOptionsExtraClaims|oidcRPMetaDataMacros|oidcRPMetaDataScopeRules)$/
      )
    {
        my $pk = eval { $self->getConfKey( $req, $query )->{$partner} } // {};
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        foreach my $h ( sort keys %$pk ) {
            push @$resp,
              {
                id    => "oidc${type}MetaDataNodes/$partner/$query/" . $id++,
                title => $h,
                data  => $pk->{$h},
                type  => 'keyText',
              };
        }
        return $self->sendJSONresponse( $req, $resp );
    }

    # Long text types (OP only)
    elsif ( $query =~ /^oidcOPMetaData(?:JSON|JWKS)$/ ) {
        my $value =
          eval { $self->getConfKey( $req, $query )->{$partner}; } // undef;
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        return $self->sendJSONresponse( $req, { value => $value } );
    }

    # Options
    elsif (
        $query =~ {
            OP => qr/^$oidcOPMetaDataNodeKeys$/o,
            RP => qr/^$oidcRPMetaDataNodeKeys$/o
        }->{$type}
      )
    {
        my $value = eval {
            $self->getConfKey( $req, "oidc${type}MetaDataOptions" )->{$partner}
              ->{$query};
        } // undef;
        return $self->sendJSONresponse( $req, { value => $value } );
    }
    else {
        return $self->sendError( $req,
            "Bad key for oidc${type}MetaDataNode ($query)", 400 );
    }
}

## @method PSGI-JSON-response oidcOPMetaDataNodes($req, @path)
# Launch _oidcMetaDataNodes('SP', @_)
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `oidcOPMetaDataNode`
#@return PSGI JSON response
sub oidcOPMetaDataNodes {
    my ( $self, $req, @path ) = @_;
    return $self->_oidcMetaDataNodes( 'OP', $req, @path );
}

## @method PSGI-JSON-response oidcRPMetaDataNodes($req, @path)
# Launch _oidcMetaDataNodes('SP', @_)
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @path words in path after `oidcRPMetaDataNode`
#@return PSGI JSON response
sub oidcRPMetaDataNodes {
    my ( $self, $req, @path ) = @_;
    return $self->_oidcMetaDataNodes( 'RP', $req, @path );
}

# 314 - CAS
#       ---

sub _casMetaDataNodes {
    my ( $self, $type, $req, @path ) = @_;
    my $refKey =
      ( $type eq 'App' ? 'casAppMetaDataOptions' : 'casSrvMetaDataOptions' );
    return $self->complexNodesRoot( $req, $refKey, "cas${type}MetaDataNode" )
      unless (@path);

    my $partner = shift @path;
    my $query   = shift @path;
    unless ($query) {
        return $self->sendError( $req,
            "Bad request: cas${type}MetaDataNode query must ask for a key",
            400 );
    }

    # setDefault response for new partners
    return $self->sendError( $req, 'setDefault', 200 )
      if ( $partner =~ /^new__/ );

    # Reject unknown partners
    return $self->sendError( $req, "Unknown CAS partner ($partner)", 400 )
      unless ( defined eval { $self->getConfKey( $req, $refKey )->{$partner}; }
      );

    my ( $id, $resp ) = ( 1, [] );

    # Return all exported attributes if asked
    if ( $query =~
/^(?:cas${type}MetaDataExportedVars|casSrvMetaDataOptionsProxiedServices|casAppMetaDataMacros)$/
      )
    {
        my $pk = eval { $self->getConfKey( $req, $query )->{$partner} } // {};
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        foreach my $h ( sort keys %$pk ) {
            push @$resp,
              {
                id    => "cas${type}MetaDataNodes/$partner/$query/" . $id++,
                title => $h,
                data  => $pk->{$h},
                type  => 'keyText',
              };
        }
        return $self->sendJSONresponse( $req, $resp );
    }

    # Options
    if (
        $query =~ {
            App => qr/^$casAppMetaDataNodeKeys$/o,
            Srv => qr/^$casSrvMetaDataNodeKeys$/o
        }->{$type}
      )
    {
        my $value = eval {
            $self->getConfKey( $req, "cas${type}MetaDataOptions" )->{$partner}
              ->{$query};
        } // undef;
        return $self->sendJSONresponse( $req, { value => $value } );
    }
    else {
        return $self->sendError( $req,
            "Bad key for cas${type}MetaDataNode ($query)", 400 );
    }
}

sub casSrvMetaDataNodes {
    my ( $self, $req, @path ) = @_;
    return $self->_casMetaDataNodes( 'Srv', $req, @path );
}

sub casAppMetaDataNodes {
    my ( $self, $req, @path ) = @_;
    return $self->_casMetaDataNodes( 'App', $req, @path );
}

# 32 - Other special nodes
#      -------------------

# 321 - Choice authentication

## @method PSGI-JSON-response authChoiceModules($req,$key)
# Returns authChoiceModules keys splitted in arrays
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param key optional subkey
#@return PSGI JSON response
sub authChoiceModules {
    my ( $self, $req, $key ) = @_;
    my $value = $self->getConfKey( $req, 'authChoiceModules' );
    unless ($key) {
        my @res;
        foreach my $k ( sort keys %$value ) {
            my $data = [ split /;\s*/, $value->{$k} ];
            if ( $data->[5] ) {
                my $over;
                eval { $over = from_json( $data->[5] ) };
                if ($@) {
                    $self->logger->error(
                        "Bad value in choice over parameters, deleted ($@)");
                }
                else {
                    $data->[5] = [ map { [ $_, $over->{$_} ] } keys %{$over} ];
                }
            }
            push @res,
              {
                id    => "authChoiceModules/$k",
                title => "$k",
                data  => $data,
                type  => 'authChoice'
              };
        }
        return $self->sendJSONresponse( $req, \@res );
    }
    else {
        my $r = $value->{$key} ? [ split( /;\s*/, $value->{$key} ) ] : [];
        return $self->sendJSONresponse( $req, { value => $r } );
    }
}

# 322 - Rules to grant sessions

## @method PSGI-JSON-response grantSessionRules($req)
# Split grantSessionRules key=>value into 3 elements
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@return PSGI JSON response
sub grantSessionRules {
    my ( $self, $req, $key ) = @_;
    return $self->sendError( $req, 'Subkeys forbidden for grantSessionRules',
        400 )
      if ($key);
    my $value = $self->getConfKey( $req, 'grantSessionRules' );
    my @res;

    sub _sort {
        my $A = ( $a =~ /^.*?##(.*)$/ )[0];
        my $B = ( $b =~ /^.*?##(.*)$/ )[0];
        return !$A ? 1 : !$B ? -1 : $A cmp $B;
    }
    my $id = 0;
    foreach my $k ( sort _sort keys %$value ) {
        my $r = $k;
        my $c = ( $r =~ s/^(.*)?##(.*)$/$1/ ? $2 : '' );
        $id++;
        push @res,
          {
            id      => "grantSessionRules/$id",
            title   => $c || $r,
            re      => $r,
            comment => $c,
            data    => $value->{$k},
            type    => 'grant'
          };
    }
    return $self->sendJSONresponse( $req, \@res );
}

# 323 - (old)OpenID IDP black/white list

##method PSGI-JSON-response openIdIDPList($req)
# Split openIdIDPList parameter into 2 elements
sub openIdIDPList {
    my ( $self, $req, $key ) = @_;
    return $self->sendError( $req, 'Subkeys forbidden for openIdIDPList', 400 )
      if ($key);
    my $value = $self->getConfKey( $req, 'openIdIDPList' );
    $value //= '0;';
    my ( $type, $v ) = split /;/, $value;
    $v //= '';
    return $self->sendJSONresponse( $req, { value => [ $type, $v ] } );
}

# 324 - Application for menu
#       --------------------

## @method PSGI-JSON-response applicationList($req, @other)
# Return the full menu tree
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param @other words in path after `applicationList`
#@return PSGI JSON response
sub applicationList {
    my ( $self, $req, @other ) = @_;
    return $self->sendError( $req,
        'There is no subkey for applicationList', 400 )
      if (@other);
    my $apps = $self->getConfKey( $req, 'applicationList' );
    return $self->sendError( $req, undef, 400 ) if ( $req->error );
    $apps = {} unless ( ref($apps) eq 'HASH' );
    my $json = $self->_scanCatsAndApps( $apps, 'applicationList' );
    return $self->sendJSONresponse( $req, $json );
}

## @method arrayRef _scanCatsAndApps($apps)
# Recursive method used to build categories & applications menu
#
#@param $apps HashRef pointing to a subnode of catAndApps conf tree
#@return arrayRef
sub _scanCatsAndApps {
    my ( $self, $apps, $baseId ) = @_;
    my @res;

    foreach my $cat (
        sort {
            ( $apps->{$a}->{order} || 0 ) <=> ( $apps->{$b}->{order} || 0 )
              or $a cmp $b
        }
        grep { not /^(?:catname|type|order)$/ } keys %$apps
      )
    {
        my $item = { id => "$baseId/$cat" };
        if ( $apps->{$cat}->{type} eq 'category' ) {
            $item->{title} = $apps->{$cat}->{catname};
            $item->{type}  = 'menuCat';
            $item->{nodes} =
              $self->_scanCatsAndApps( $apps->{$cat}, "$baseId/$cat" );
        }
        else {
            $item->{title} = $apps->{$cat}->{options}->{name};
            $item->{type}  = $apps->{$cat}->{type} = 'menuApp';
            foreach my $o (
                grep { not /^name$/ }
                keys %{ $apps->{$cat}->{options} }
              )
            {
                $item->{data}->{$o} = $apps->{$cat}->{options}->{$o};
            }
        }
        push @res, $item;
    }
    return \@res;
}

# 325 - Combination modules

# Returns raw value, just transform "over" key
sub combModules {
    my ( $self, $req, $key ) = @_;
    return $self->sendError( $req, 'Subkeys forbidden for combModules', 400 )
      if ($key);
    my $val = $self->getConfKey( $req, 'combModules' ) // {};
    my $res = [];
    foreach my $mod ( keys %$val ) {
        my $tmp;
        $tmp->{title}      = $mod;
        $tmp->{id}         = "combModules/$mod";
        $tmp->{type}       = 'cmbModule';
        $tmp->{data}->{$_} = $val->{$mod}->{$_} foreach (qw(type for));
        my $over = $val->{$mod}->{over} // {};
        $tmp->{data}->{over} = [ map { [ $_, $over->{$_} ] } keys %$over ];
        push @$res, $tmp;
    }
    return $self->sendJSONresponse( $req, $res );
}

sub sfExtra {
    my ( $self, $req, $key ) = @_;
    return $self->sendError( $req, 'Subkeys forbidden for sfExtra', 400 )
      if ($key);
    my $val = $self->getConfKey( $req, 'sfExtra' ) // {};
    my $res = [];
    foreach my $mod ( keys %$val ) {
        my $tmp;
        $tmp->{title}      = $mod;
        $tmp->{id}         = "sfExtra/$mod";
        $tmp->{type}       = 'sfExtra';
        $tmp->{data}->{$_} = $val->{$mod}->{$_}
          foreach (qw(type rule logo level label));
        $tmp->{data}->{register} = $val->{$mod}->{register} ? \1 : \0;
        my $over = $val->{$mod}->{over} // {};
        $tmp->{data}->{over} = [ map { [ $_, $over->{$_} ] } keys %$over ];
        push @$res, $tmp;
    }
    return $self->sendJSONresponse( $req, $res );
}

# 33 - Root queries
#      -----------

## @method PSGI-JSON-response metadata($req)
# Respond to `/conf/:cfgNum` requests by sending configuration metadata
#
# NB: if `full=1` is set in the query, configuration is returned directly in
#     JSON
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@return PSGI JSON response
sub metadata {
    my ( $self, $req ) = @_;
    if ( $req->params('full') and $req->params('full') !~ NO ) {
        my $c = $self->getConfKey( $req, 'cfgNum' );
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        if ( $self->can('userId') ) {
            $self->userLogger->notice( 'User '
                  . $self->userId($req)
                  . ' ask for full configuration '
                  . $c );
        }
        else {
            $self->logger->info("REST request to get full configuration $c");
        }
        return $self->sendJSONresponse(
            $req,
            $self->currentConf,
            pretty  => 1,
            headers => [
                'Content-Disposition' => "Attachment; filename=lmConf-$c.json"
            ],
        );
    }
    else {
        my $res = {};
        $res->{cfgNum} = $self->getConfKey( $req, 'cfgNum' );
        return $self->sendError( $req, undef, 400 ) if ( $req->error );
        return $self->sendError( $req, "Configuration without cfgNum", 500 )
          unless ( defined $res->{cfgNum} );
        foreach my $key (qw(cfgAuthor cfgDate cfgAuthorIP cfgLog cfgVersion)) {
            $res->{$key} = $self->getConfKey( $req, $key );
        }

        # Find next and previous conf
        my @a     = $self->confAcc->available;
        my $id    = -1;
        my ($ind) = map { $id++; $_ == $res->{cfgNum} ? ($id) : () } @a;
        if ($ind) { $res->{prev} = $a[ $ind - 1 ]; }
        if ( defined $ind and $ind < $#a ) {
            $res->{next} = $a[ $ind + 1 ];
        }
        if ( $self->can('userId') ) {
            $self->userLogger->info( 'User '
                  . $self->userId($req)
                  . ' ask for configuration metadata ('
                  . $res->{cfgNum}
                  . ')' );
        }
        else {
            $self->logger->info(
                "REST request to get configuration metadata ($res->{cfgNum})");
        }
        return $self->sendJSONresponse( $req, $res );
    }
}

# 34 - Other values
#      ------------

## @method PSGI-JSON-response getKey($req, $key, $subkey)
# Return the value of a root key of current configuration
#
#@param $req Lemonldap::NG::Common::PSGI::Request
#@param $key Name of key requested
#@param $subkey Subkey for hash values
#@return PSGI JSON response
sub getKey {
    my ( $self, $req, $key, $subkey ) = @_;
    unless ($key) {
        return $self->metadata($req);
    }
    if ( $self->can('userId') ) {
        $self->userLogger->info(
            'User ' . $self->userId($req) . " asks for key $key" );
    }
    else {
        $self->logger->info("REST request to get configuration key $key");
    }
    my $value = $self->getConfKey( $req, $key );
    return $self->sendError( $req, undef, 400 ) if ( $req->error );

    # When "hash"
    if ( $key =~ qr/^$simpleHashKeys$/o ) {
        return $self->sendError( $req, 'setDefault', 200 )
          unless defined($value);

        # If a hash key is asked return its value
        if ($subkey) {
            return $self->sendJSONresponse( $req,
                { value => $value->{$subkey} // undef, } );
        }

        # else return the list of keys
        my @res;
        foreach my $k ( sort keys %$value ) {
            push @res,
              {
                id    => "$key/$k",
                title => "$k",
                data  => $value->{$k},
                type  => 'keyText'
              };
        }
        return $self->sendJSONresponse( $req, \@res );
    }
    elsif ( $key =~ qr/^$doubleHashKeys$/o ) {
        my @res;
        $value ||= {};
        foreach my $host ( sort keys %$value ) {
            my @tmp;
            foreach my $k ( sort keys %{ $value->{$host} } ) {
                push @tmp, { k => $k, v => $value->{$host}->{$k} };
            }
            push @res, { k => $host, h => \@tmp };
        }
        return $self->sendJSONresponse( $req, { value => \@res } );
    }

    # When scalar
    return $self->sendError( $req, "Key $key is not a hash", 400 )
      if ($subkey);
    return $self->sendError( $req, 'setDefault', 200 )
      unless defined($value);
    return $self->sendJSONresponse( $req, { value => $value } );

    # TODO authParam key
}

1;
