aws_24.0.0_2b75fe6d/regtests/0071_interoplab_main1/interoplab_main1.adb

------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                     Copyright (C) 2003-2020, AdaCore                     --
--                                                                          --
--  This is free software;  you can redistribute it  and/or modify it       --
--  under terms of the  GNU General Public License as published  by the     --
--  Free Software  Foundation;  either version 3,  or (at your option) any  --
--  later version.  This software 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   --
--  distributed  with  this  software;   see  file COPYING3.  If not, go    --
--  to http://www.gnu.org/licenses for a complete copy of the license.      --
------------------------------------------------------------------------------

with Ada.Calendar;
with Ada.Integer_Text_IO;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with AWS.Config.Set;
with AWS.MIME;
with AWS.Net;
with AWS.Response;
with AWS.Server;
with AWS.Status;
with AWS.Translator;
with SOAP.Message.Payload;
with SOAP.Message.XML;

with Tinteroplab.Client;
with Tinteroplab.Server;
with Tinteroplab.Types;

procedure Interoplab_Main1 is

   use Ada;
   use Ada.Strings.Unbounded;
   use AWS;

   use Tinteroplab.Types;

   H_Server : Server.HTTP;

   function "+" (Str : String) return Unbounded_String
     renames To_Unbounded_String;

   package FIO is new Text_IO.Float_IO (Float);

   ------------
   -- Output --
   ------------

   procedure Output (S : SOAPStruct_Type) is
   begin
      Integer_Text_IO.Put (S.varInt); Text_IO.New_Line;
      FIO.Put (S.VarFloat, Exp => 0, Aft => 2); Text_IO.New_Line;
      Text_IO.Put_Line (To_String (S.varString));
   end Output;

   ---------------------
   -- T_echoString_CB --
   ---------------------

   function T_echoString_CB (inputString : String) return String is
   begin
      return inputString;
   end T_echoString_CB;

   function echoString_CB is
      new Tinteroplab.Server.echoString_CB (T_echoString_CB);

   ------------------
   -- T_echoString --
   ------------------

   procedure T_echoString is
      Res : constant String := TinteropLab.Client.echoString
        ("This is the real value for the string!");
   begin
      Text_IO.Put_Line ("Echo String");

      Text_IO.Put_Line (Res);
      Text_IO.New_Line;
   end T_echoString;

   --------------------------
   -- T_echoStringArray_CB --
   --------------------------

   function T_echoStringArray_CB
      (inputStringArray : ArrayOfstring_Type)
       return echoStringArray_Result is
   begin
      return inputStringArray;
   end T_echoStringArray_CB;

   function echoStringArray_CB is
      new Tinteroplab.Server.echoStringArray_CB (T_echoStringArray_CB);

   -----------------------
   -- T_echoStringArray --
   -----------------------

   procedure T_echoStringArray is
      Arr : constant ArrayOfstring_Type := (+"first", +"second", +"third");

      Res : constant ArrayOfstring_Type
        := TinteropLab.Client.echoStringArray (Arr);
   begin
      Text_IO.Put_Line ("Echo ArrayOfstring");
      for K in Res'Range loop
         Text_IO.Put_Line (Integer'Image (K) & " = " & To_String (Res (K)));
      end loop;
      Text_IO.New_Line;
   end T_echoStringArray;

   ----------------------
   -- T_echoBoolean_CB --
   ----------------------

   function T_echoBoolean_CB
     (inputBoolean : Boolean)
      return Boolean is
   begin
      return inputBoolean;
   end T_echoBoolean_CB;

   function echoBoolean_CB is
      new Tinteroplab.Server.echoBoolean_CB (T_echoBoolean_CB);

   -------------------
   -- T_echoBoolean --
   -------------------

   procedure T_echoBoolean is
      Res : Boolean;
   begin
      Text_IO.Put_Line ("Echo Boolean");

      Res := TinteropLab.Client.echoBoolean (True);
      Text_IO.Put_Line (Boolean'Image (Res));

      Res := TinteropLab.Client.echoBoolean (False);
      Text_IO.Put_Line (Boolean'Image (Res));
      Text_IO.New_Line;
   end T_echoBoolean;

   ---------------------
   -- T_echoBase64_CB --
   ---------------------

   function T_echoBase64_CB
     (inputBase64 : String)
      return String is
   begin
      return inputBase64;
   end T_echoBase64_CB;

   function echoBase64_CB is
      new Tinteroplab.Server.echoBase64_CB (T_echoBase64_CB);

   ------------------
   -- T_echoBase64 --
   ------------------

   procedure T_echoBase64 is
      V   : constant String
        := AWS.Translator.Base64_Encode ("AWS SOAP WSDL implementation");
      Res : constant String := TinteropLab.Client.echoBase64 (V);
   begin
      Text_IO.Put_Line ("Echo Base64");

      Text_IO.Put_Line (V);
      Text_IO.Put_Line (Res);
      Text_IO.New_Line;
   end T_echoBase64;

   ----------------------
   -- T_echoInteger_CB --
   ----------------------

   function T_echoInteger_CB
      (inputInteger : Integer)
       return Integer is
   begin
      return inputInteger;
   end T_echoInteger_CB;

   function echoInteger_CB is
      new Tinteroplab.Server.echoInteger_CB (T_echoInteger_CB);

   -------------------
   -- T_echoInteger --
   -------------------

   procedure T_echoInteger is
   begin
      Text_IO.Put_Line ("Echo Integer");
      Integer_Text_IO.Put (TinteropLab.Client.echoInteger (12));
      Text_IO.New_Line;
      Integer_Text_IO.Put (TinteropLab.Client.echoInteger (9876543));
      Text_IO.New_Line;
      Text_IO.New_Line;
   end T_echoInteger;

   ---------------------------
   -- T_echoIntegerArray_CB --
   ---------------------------

   function T_echoIntegerArray_CB
      (inputIntegerArray : ArrayOfint_Type)
       return echoIntegerArray_Result is
   begin
      return inputIntegerArray;
   end T_echoIntegerArray_CB;

   function echoIntegerArray_CB is
      new Tinteroplab.Server.echoIntegerArray_CB (T_echoIntegerArray_CB);

   ------------------------
   -- T_echoIntegerArray --
   ------------------------

   procedure T_echoIntegerArray is
      Arr : constant ArrayOfint_Type := (34, 67, 98, 54, 78, 65, 1);

      Res : constant ArrayOfint_Type
        := TinteropLab.Client.echoIntegerArray (Arr);
   begin
      Text_IO.Put_Line ("Echo ArrayOfint");
      for K in Res'Range loop
         Text_IO.Put (Integer'Image (K) & " = ");
         Integer_Text_IO.Put (Res (K));
         Text_IO.New_Line;
      end loop;
      Text_IO.New_Line;
   end T_echoIntegerArray;

   --------------------
   -- T_echoFloat_CB --
   --------------------

   function T_echoFloat_CB
      (inputFloat : Float)
       return Float is
   begin
      return inputFloat;
   end T_echoFloat_CB;

   function echoFloat_CB is
      new Tinteroplab.Server.echoFloat_CB (T_echoFloat_CB);

   -----------------
   -- T_echoFloat --
   -----------------

   procedure T_echoFloat is
   begin
      Text_IO.Put_Line ("Echo Float");
      FIO.Put (TinteropLab.Client.echoFloat (2.345), Aft => 5, Exp => 0);
      Text_IO.New_Line;
      FIO.Put (TinteropLab.Client.echoFloat (456.8765));
      Text_IO.New_Line;
      Text_IO.New_Line;
   end T_echoFloat;

   ---------------------
   -- T_echoStruct_CB --
   ---------------------

   function T_echoStruct_CB
      (inputStruct : SOAPStruct_Type)
       return echoStruct_Result is
   begin
      return inputStruct;
   end T_echoStruct_CB;

   function echoStruct_CB is
      new Tinteroplab.Server.echoStruct_CB (T_echoStruct_CB);

   ------------------
   -- T_echoStruct --
   ------------------

   procedure T_echoStruct is
      Struct : constant SOAPStruct_Type
        := (6, 6.6, +"666");
      Res : constant echoStruct_Result
        := TinteropLab.Client.echoStruct (Struct);
   begin
      Text_IO.Put_Line ("Echo Struct");
      Output (Res);
      Text_IO.New_Line;
   end T_echoStruct;

   -------------------
   -- T_echoDate_CB --
   -------------------

   function T_echoDate_CB
      (inputDate : Ada.Calendar.Time)
       return Ada.Calendar.Time is
   begin
      return inputDate;
   end T_echoDate_CB;

   function echoDate_CB is
      new Tinteroplab.Server.echoDate_CB (T_echoDate_CB);

   ----------------
   -- T_echoDate --
   ----------------

   procedure T_echoDate is
      use type Ada.Calendar.Time;

      T   : constant Ada.Calendar.Time
        := Ada.Calendar.Time_Of (2003, 3, 12, 39482.0);
      Res : Ada.Calendar.Time;
   begin
      Text_IO.Put_Line ("Echo Date");
      Res := TinteropLab.Client.echoDate (T);

      if Res = T then
         Text_IO.Put_Line ("ok");
      else
         Text_IO.Put_Line ("nok");
      end if;
      Text_IO.New_Line;
   end T_echoDate;

   -------------------------
   -- T_echoFloatArray_CB --
   -------------------------

   function T_echoFloatArray_CB
      (inputFloatArray : ArrayOffloat_Type)
       return EchoFloatArray_Result is
   begin
      return inputFloatArray;
   end T_echoFloatArray_CB;

   function echoFloatArray_CB is
      new Tinteroplab.Server.echoFloatArray_CB (T_echoFloatArray_CB);

   ----------------------
   -- T_echoFloatArray --
   ----------------------

   procedure T_echoFloatArray is
      Arr : constant ArrayOfFloat_Type
        := (34.1, 67.2, 98.3, 54.4, 78.5, 65.6, 1.7);

      Res : constant ArrayOfFloat_Type
        := TinteropLab.Client.echoFloatArray (Arr);
   begin
      Text_IO.Put_Line ("Echo ArrayOfFloat");

      for K in Res'Range loop
         Text_IO.Put (Integer'Image (K) & " = ");
         FIO.Put (Res (K), Aft => 2, Exp => 0);
         Text_IO.New_Line;
      end loop;
      Text_IO.New_Line;
   end T_echoFloatArray;

   ---------------------
   -- echoStructArray --
   ---------------------

   function T_echoStructArray_CB
      (inputStructArray : ArrayOfSOAPStruct_Type)
       return echoStructArray_Result is
   begin
      return inputStructArray;
   end T_echoStructArray_CB;

   function echoStructArray_CB is
      new Tinteroplab.Server.echoStructArray_CB (T_echoStructArray_CB);

   -----------------------
   -- T_echoStructArray --
   -----------------------

   procedure T_echoStructArray is
      A_Struct : constant ArrayOfSOAPStruct_Type
        := ((1, 1.1, +"one"), (2, 2.2, +"two"), (3, 3.3, +"three"));

      Res : constant ArrayOfSOAPStruct_Type
        := TinteropLab.Client.echoStructArray (A_Struct);
   begin
      Text_IO.Put_Line ("Echo ArrayOfStruct");

      for K in Res'Range loop
         Output (Res (K));
      end loop;

      Text_IO.New_Line;
   end T_echoStructArray;

   -------------------
   -- T_echoVoid_CB --
   -------------------

   procedure T_echoVoid_CB is
   begin
      null;
   end T_echoVoid_CB;

   function echoVoid_CB is
      new Tinteroplab.Server.echoVoid_CB (T_echoVoid_CB);

   ----------------
   -- T_echoVoid --
   ----------------

   procedure T_echoVoid is
   begin
      Text_IO.Put_Line ("Echo Void");
      Tinteroplab.Client.echoVoid;
      Text_IO.New_Line;
   end T_echoVoid;

   --------
   -- CB --
   --------

   function CB (Request : Status.Data) return Response.Data is
      SOAPAction : constant String := Status.SOAPAction (Request);
      P_Str      : aliased constant String := AWS.Status.Payload (Request);
      Payload    : constant SOAP.Message.Payload.Object
        := SOAP.Message.XML.Load_Payload (P_Str, Schema => Tinteroplab.Schema);
   begin
      if SOAPAction = "http://t_soapinterop.org/#echoString" then
         return echoString_CB (SOAPAction, Payload, Request);

      elsif SOAPAction = "http://t_soapinterop.org/#echoVoid" then
         return echoVoid_CB (SOAPAction, Payload, Request);

      elsif SOAPAction = "http://t_soapinterop.org/" then
         declare
            Proc : constant String
              := SOAP.Message.Payload.Procedure_Name (Payload);
         begin
            if Proc = "echoString" then
               return echoString_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoStringArray" then
               return echoStringArray_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoBoolean" then
               return echoBoolean_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoBase64" then
               return echoBase64_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoInteger" then
               return echoInteger_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoIntegerArray" then
               return echoIntegerArray_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoFloat" then
               return echoFloat_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoStruct" then
               return echoStruct_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoDate" then
               return echoDate_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoFloatArray" then
               return echoFloatArray_CB (SOAPAction, Payload, Request);

            elsif Proc = "echoStructArray" then
               return echoStructArray_CB (SOAPAction, Payload, Request);

            else
               return Response.Build
                 (MIME.Text_HTML, "Not a SOAP request, Proc=" & Proc);
            end if;
         end;

      else
         return Response.Build
           (MIME.Text_HTML, "Not a SOAP request, SOAPAction=" & SOAPAction);
      end if;
   end CB;

   CNF : Config.Object;

begin
   Config.Set.Server_Name     (CNF, "WSDL interopLab Server");
   Config.Set.Server_Host     (CNF, "localhost");
   Config.Set.Server_Port     (CNF, Tinteroplab.Server.Port);
   Config.Set.Protocol_Family (CNF, "FAMILY_INET");

   Server.Start (H_Server, CB'Unrestricted_Access, CNF);

   if Net.IPv6_Available then
      Server.Add_Listening
        (H_Server, "localhost", Tinteroplab.Server.Port, Net.FAMILY_INET6);
   end if;

   T_echoVoid;
   T_echoString;
   T_echoStringArray;
   T_echoBoolean;
   T_echoBase64;
   T_echoInteger;
   T_echoIntegerArray;
   T_echoFloat;
   T_echoStruct;
   T_echoDate;
   T_echoFloatArray;
   T_echoStructArray;

   Server.Shutdown (H_Server);
end Interoplab_Main1;