#!/usr/bin/env perl
#
# Basically just ensure that examples/usertoken/with_help_digest.pl will work.
#
use warnings;
use strict;

use Test::More tests => 33;

use MIME::Base64            qw/decode_base64/;

use XML::Compile::WSDL11;
use XML::Compile::SOAP11;
use XML::Compile::Transport::SOAPHTTP;
use XML::Compile::SOAP::WSS;
use XML::Compile::WSS::Util qw/:wss11 :utp11/;

use XML::LibXML::XPathContext;

my $myns   = 'http://msgsec.wssecfvt.ws.ibm.com';
my ($username, $password, $operation) = qw/username password version/;
my $usernameId  = 'foo';
my $timestampId = 'baz';

## How to get a relative path right??
my $wsdl = XML::Compile::WSDL11->new( 'examples/wsse/example.wsdl');
my $wss  = XML::Compile::SOAP::WSS->new( version => 1.1, schema => $wsdl);
ok($wss, 'Created a WSS object');

my $getVersion = $wsdl->compileClient
  ( $operation

  # to overrule server as in wsdl, for testing only
    , transport_hook => \&test_server
  );
ok( $getVersion, "$operation compiled with test server" );

my $now   = '2012-08-17T12:02:26Z';
my $then  = '2012-08-17T12:02:31Z';
my $nonce = 'insecure';

my $usernameToken = $wss->wsseBasicAuth($username, $password, UTP11_PDIGEST
					, nonce => $nonce, created => $now
 					, wsu_Id => $usernameId
				       );
ok($usernameToken, 'PasswordDigest returns something sensible');

my $timestampToken = $wss->wsseTimestamp( $now, $then, wsu_Id => $timestampId );
ok($timestampToken, 'Timestamp is sensible');

my $theCorrectAnswer = 42;

my ($answer, $trace) = $getVersion->
  ( wsse_Security => { %$usernameToken, %$timestampToken }
  , () # %payload
  );

is( $answer->{body}, $theCorrectAnswer, 'Round-trip to server worked' );
# print $trace->printRequest;
# use Data::Dumper;
# print Dumper $answer;

{
    # Ticket 79315 notes that "text" passwords just skip Nonce and
    # Created.  This seems like a reasonable place to check that
    # (although maybe the filename should change from "digest").
    my $usernameToken = $wss->wsseBasicAuth($username, $password, UTP11_PTEXT
      , nonce => $nonce, created => $now, wsu_Id => $usernameId);
    ok($usernameToken, 'PasswordText returns something sensible');
    
    my ($answer, $trace) = $getVersion->
        ( wsse_Security => { %$usernameToken, %$timestampToken }
              , () # %payload
          );

    is($answer->{body}, $theCorrectAnswer, 'Round-trip to server worked');
}

#### HELPERS, for testing only

sub test_server
{   my ($request, $trace) = @_;
    my $content = $request->decoded_content;

    eval {
      my $contentDoc = XML::LibXML->load_xml( string => $content );
      ok( $contentDoc, 'Content is parseable' );

      my $xpc       = XML::LibXML::XPathContext->new;
      $xpc->registerNs( 'wsu'  => WSU_10 );
      $xpc->registerNs( 'wsse' => WSSE_10 );

      my ($securityElt, @extras) = $xpc->findnodes( '//wsse:Security', $contentDoc );
      ok( $securityElt, 'Security element is present' );
      is( @extras, 0, 'There is only one security element' );

      my ($unTokenElt) = $xpc->findnodes( 'wsse:UsernameToken', $securityElt );
      ok( $unTokenElt, 'UsernameToken is present' );

      ok( $unTokenElt->hasAttributeNS(WSU_10,'Id'), 'wsse:UsernameToken/@wsu:Id is present' );
      is( $unTokenElt->getAttributeNS(WSU_10,'Id'), $usernameId, 'UsernameToken has the right ID' );
      # Search for Nonce
      my ($nonceElt) = $xpc->findnodes( 'wsse:UsernameToken/wsse:Nonce', $securityElt );
      ok( $nonceElt, 'Nonce element exists' );
      is( decode_base64($nonceElt->textContent), $nonce, 'Nonce is the right encoding' );

      my ($createdElt) = $xpc->findnodes( 'wsse:UsernameToken/wsu:Created', $securityElt );
      ok( $createdElt, 'Created element exists under UsernameToken' );
      is( $createdElt->textContent, $now, 'Created element has the right content' );

      # Search for wsu:Timestamp
      my ($tsElt) = $xpc->findnodes( '//wsu:Timestamp', $contentDoc );
      ok( $tsElt, 'Timestamp element exists' );

      # Search for wsu:Timestamp/@wsu:Id
      ok( $tsElt->hasAttributeNS(WSU_10,'Id'), 'wsu:Timestamp/@wsu:Id is present' );
      is( $tsElt->getAttributeNS(WSU_10,'Id'), $timestampId, 'Timestamp has the right ID' );
    } || diag( "Something went wrong with the content: $!" );

    my $answer = <<_ANSWER;
<?xml version="1.0" encoding="UTF-8"?>
<SOAP-ENV:Envelope
   xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
   xmlns:x0="$myns">
  <SOAP-ENV:Body>
     <x0:hasVersion>$theCorrectAnswer</x0:hasVersion>
  </SOAP-ENV:Body>
</SOAP-ENV:Envelope>
_ANSWER

    use HTTP::Response;

    HTTP::Response->new
      ( HTTP::Status::RC_OK
      , 'answer manually created'
      , [ 'Content-Type' => 'text/xml' ]
      , $answer
      );
}