------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                     Copyright (C) 2000-2021, AdaCore                     --
--                                                                          --
--  This library 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 library 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.                    --
--                                                                          --
--  As a special exception under Section 7 of GPL version 3, you are        --
--  granted additional permissions described in the GCC Runtime Library     --
--  Exception, version 3.1, as published by the Free Software Foundation.   --
--                                                                          --
--  You should have received a copy of the GNU General Public License and   --
--  a copy of the GCC Runtime Library Exception along with this program;    --
--  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see   --
--  <http://www.gnu.org/licenses/>.                                         --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Calendar;
with Ada.Streams;
with Ada.Strings.Unbounded;

package AWS.Messages is

   use Ada;
   use Ada.Streams;
   use Ada.Strings.Unbounded;

   -----------------
   -- HTTP tokens --
   -----------------

   HTTP_Token    : constant String := "HTTP/";
   Options_Token : constant String := "OPTIONS";
   Get_Token     : constant String := "GET";
   Head_Token    : constant String := "HEAD";
   Post_Token    : constant String := "POST";
   Put_Token     : constant String := "PUT";
   Delete_Token  : constant String := "DELETE";
   Trace_Token   : constant String := "TRACE";
   Connect_Token : constant String := "CONNECT";
   --  Sorted like in RFC 2616 Method definition

   ------------------------
   -- HTTP header tokens --
   ------------------------

   --  HTTP/2 header tokens RFC 7540

   Status_Token              : constant String := ":status";
   Method_Token              : constant String := ":method";
   Path2_Token               : constant String := ":path";
   Scheme_Token              : constant String := ":scheme";

   H2_Token                  : constant String := "h2";
   H2C_Token                 : constant String := "h2c";

   --  General header tokens RFC 2616
   Cache_Control_Token       : constant String := "Cache-Control";
   Connection_Token          : constant String := "Connection";
   Date_Token                : constant String := "Date";
   Pragma_Token              : constant String := "Pragma";
   Trailer_Token             : constant String := "Trailer";
   Transfer_Encoding_Token   : constant String := "Transfer-Encoding";
   Upgrade_Token             : constant String := "Upgrade";
   Via_Token                 : constant String := "Via";
   Warning_Token             : constant String := "Warning";

   --  Request header tokens RFC 2616
   Accept_Token              : constant String := "Accept";
   Accept_Charset_Token      : constant String := "Accept-Charset";
   Accept_Encoding_Token     : constant String := "Accept-Encoding";
   Accept_Language_Token     : constant String := "Accept-Language";
   Authorization_Token       : constant String := "Authorization";
   Expect_Token              : constant String := "Expect";
   From_Token                : constant String := "From";
   Host_Token                : constant String := "Host";
   If_Match_Token            : constant String := "If-Match";
   If_Modified_Since_Token   : constant String := "If-Modified-Since";
   If_None_Match_Token       : constant String := "If-None-Match";
   If_Range_Token            : constant String := "If-Range";
   If_Unmodified_Since_Token : constant String := "If-Unmodified-Since";
   Max_Forwards_Token        : constant String := "Max-Forwards";
   Proxy_Authorization_Token : constant String := "Proxy-Authorization";
   Range_Token               : constant String := "Range";
   Referer_Token             : constant String := "Referer";
   TE_Token                  : constant String := "TE";
   User_Agent_Token          : constant String := "User-Agent";

   --  Cross-Origin Resource Sharing request header tokens
   Access_Control_Request_Headers_Token : constant String :=
                                            "Access-Control-Request-Headers";
   Access_Control_Request_Method_Token  : constant String :=
                                            "Access-Control-Request-Method";
   Origin_Token                         : constant String := "Origin";

   --  Response header tokens RFC 2616
   Accept_Ranges_Token       : constant String := "Accept-Ranges";
   Age_Token                 : constant String := "Age";
   ETag_Token                : constant String := "ETag";
   Location_Token            : constant String := "Location";
   Proxy_Authenticate_Token  : constant String := "Proxy-Authenticate";
   Retry_After_Token         : constant String := "Retry-After";
   Server_Token              : constant String := "Server";
   Vary_Token                : constant String := "Vary";
   WWW_Authenticate_Token    : constant String := "WWW-Authenticate";

   --  Cross-Origin Resource Sharing response header tokens
   Access_Control_Allow_Credentials_Token : constant String :=
     "Access-Control-Allow-Credentials";
   Access_Control_Allow_Headers_Token     : constant String :=
                                              "Access-Control-Allow-Headers";
   Access_Control_Allow_Methods_Token     : constant String :=
                                              "Access-Control-Allow-Methods";
   Access_Control_Allow_Origin_Token      : constant String :=
                                              "Access-Control-Allow-Origin";
   Access_Control_Expose_Headers_Token    : constant String :=
                                              "Access-Control-Expose-Headers";
   Access_Control_Max_Age_Token           : constant String :=
                                              "Access-Control-Max-Age";

   --  Entity header tokens RFC 2616
   Allow_Token               : constant String := "Allow";
   Content_Encoding_Token    : constant String := "Content-Encoding";
   Content_Language_Token    : constant String := "Content-Language";
   Content_Length_Token      : constant String := "Content-Length";
   Content_Location_Token    : constant String := "Content-Location";
   Content_MD5_Token         : constant String := "Content-MD5";
   Content_Range_Token       : constant String := "Content-Range";
   Content_Type_Token        : constant String := "Content-Type";
   Expires_Token             : constant String := "Expires";
   Last_Modified_Token       : constant String := "Last-Modified";

   --  Cookie token RFC 2109
   Cookie_Token              : constant String := "Cookie";
   Set_Cookie_Token          : constant String := "Set-Cookie";
   Comment_Token             : constant String := "Comment";
   Domain_Token              : constant String := "Domain";
   Max_Age_Token             : constant String := "Max-Age";
   Path_Token                : constant String := "Path";
   Secure_Token              : constant String := "Secure";
   HTTP_Only_Token           : constant String := "HttpOnly";

   --  Other tokens
   Proxy_Connection_Token          : constant String := "Proxy-Connection";
   Content_Disposition_Token       : constant String := "Content-Disposition";
   SOAPAction_Token                : constant String := "SOAPAction";
   Content_Id_Token                : constant String := "Content-ID";
   Content_Transfer_Encoding_Token : constant String :=
                                       "Content-Transfer-Encoding";

   --  WebSockets tokens
   Websocket_Token              : constant String := "WebSocket";
   Sec_WebSocket_Accept_Token   : constant String := "Sec-WebSocket-Accept";
   Sec_WebSocket_Protocol_Token : constant String := "Sec-WebSocket-Protocol";
   Sec_WebSocket_Key_Token      : constant String := "Sec-WebSocket-Key";
   Sec_WebSocket_Key1_Token     : constant String := "Sec-WebSocket-Key1";
   Sec_WebSocket_Key2_Token     : constant String := "Sec-WebSocket-Key2";
   Sec_WebSocket_Version_Token  : constant String := "Sec-WebSocket-Version";
   Sec_WebSocket_Origin_Token   : constant String := "Sec-WebSocket-Origin";
   Sec_WebSocket_Location_Token : constant String := "Sec-WebSocket-Location";
   Chat_Token                   : constant String := "chat";

   S100_Continue : constant String := "100-continue";
   --  Supported expect header value

   --  HTTP2 specific

   HTTP2_Settings : constant String := "HTTP2-Settings";

   -----------------
   -- Status Code --
   -----------------

   type Status_Code is
     (S100, S101, S102,
      --  1xx : Informational - Request received, continuing process

      S200, S201, S202, S203, S204, S205, S206, S207, S208, S226,
      --  2xx : Success - The action was successfully received, understood and
      --  accepted

      S300, S301, S302, S303, S304, S305, S306, S307, S308,
      --  3xx : Redirection - Further action must be taken in order to
      --  complete the request

      S400, S401, S402, S403, S404, S405, S406, S407, S408, S409,
      S410, S411, S412, S413, S414, S415, S416, S417, S418, S421, S422, S423,
      S424, S425, S426, S428, S429, S431, S451,
      --  4xx : Client Error - The request contains bad syntax or cannot be
      --  fulfilled

      S500, S501, S502, S503, S504, S505, S506, S507, S508, S510, S511, S520,
      S521, S522, S523, S524, S525, S526
      --  5xx : Server Error - The server failed to fulfill an apparently
      --  valid request
      );

   subtype Informational is Status_Code range S100 .. S102;
   subtype Success       is Status_Code range S200 .. S226;
   subtype Redirection   is Status_Code range S300 .. S308;
   subtype Client_Error  is Status_Code range S400 .. S451;
   subtype Server_Error  is Status_Code range S500 .. S526;

   function Image (S : Status_Code) return String;
   --  Returns Status_Code image. This value does not contain the leading S

   function Reason_Phrase (S : Status_Code) return String;
   --  Returns the reason phrase for the status code S, see [RFC 2616 - 6.1.1]

   function With_Body (S : Status_Code) return Boolean;
   --  Returns True if message with status can have a body

   ----------------------
   -- Content encoding --
   ----------------------

   type Content_Encoding is (Identity, GZip, Deflate);
   --  Encoding mode for the response, Identity means that no encoding is
   --  done, Gzip/Deflate to select the Gzip or Deflate encoding algorithm.

   -------------------
   -- Cache_Control --
   -------------------

   type Cache_Option is new String;
   --  Cache_Option is a string and any specific option can be specified. We
   --  define four options:
   --
   --  Unspecified   : No cache option will used.
   --  No_Cache      : Ask browser and proxy to not cache data (no-cache,
   --                  max-age, and s-maxage are specified).
   --  No_Store      : Ask browser and proxy to not store any data. This can be
   --                  used to protect sensitive data.
   --  Prevent_Cache : Equivalent to No_Store + No_Cache

   Unspecified   : constant Cache_Option;
   No_Cache      : constant Cache_Option;
   No_Store      : constant Cache_Option;
   Prevent_Cache : constant Cache_Option;

   type Cache_Kind is (Request, Response);

   type Delta_Seconds is new Integer range -1 .. Integer'Last;
   --  Represents a delta-seconds parameter for some Cache_Data fields like
   --  max-age, max-stale (value -1 is used for Unset).

   Unset         : constant Delta_Seconds;
   No_Max_Stale  : constant Delta_Seconds;
   Any_Max_Stale : constant Delta_Seconds;

   type Private_Option is new Unbounded_String;

   All_Private   : constant Private_Option;
   Private_Unset : constant Private_Option;

   --  Cache_Data is a record that represents cache control information

   type Cache_Data (CKind : Cache_Kind) is record
      No_Cache       : Boolean       := False;
      No_Store       : Boolean       := False;
      No_Transform   : Boolean       := False;
      Max_Age        : Delta_Seconds := Unset;

      case CKind is
         when Request =>
            Max_Stale      : Delta_Seconds := Unset;
            Min_Fresh      : Delta_Seconds := Unset;
            Only_If_Cached : Boolean       := False;

         when Response =>
            S_Max_Age        : Delta_Seconds  := Unset;
            Public           : Boolean        := False;
            Private_Field    : Private_Option := Private_Unset;
            Must_Revalidate  : Boolean        := False;
            Proxy_Revalidate : Boolean        := False;
      end case;
   end record;

   function To_Cache_Option (Data : Cache_Data) return Cache_Option;
   --  Returns a cache control value for an HTTP request/response, fields are
   --  described into RFC 2616 [14.9 Cache-Control].

   function To_Cache_Data
     (Kind : Cache_Kind; Value : Cache_Option) return Cache_Data;
   --  Returns a Cache_Data record parsed out of Cache_Option

   ----------
   -- ETag --
   ----------

   type ETag_Value is new String;

   function Create_ETag
     (Name : String; Weak : Boolean := False) return ETag_Value;
   --  Returns an ETag value (strong by default and Weak if specified). For a
   --  discussion about ETag see RFC 2616 [3.11 Entity Tags] and [14.19 ETag].

   -------------------------------
   -- HTTP message constructors --
   -------------------------------

   function Accept_Encoding (Encoding : String) return String with Inline;

   function Accept_Type (Mode : String) return String with Inline;

   function Accept_Language (Mode : String) return String with Inline;

   function Authorization (Mode, Password : String) return String with Inline;

   function Connection (Mode : String) return String with Inline;

   function Content_Length (Size : Stream_Element_Offset) return String
     with Inline;

   function Cookie (Value : String) return String with Inline;

   function Content_Type (Format : String) return String with Inline;

   function Content_Type
     (Format : String; Boundary : String) return String with Inline;

   function Cache_Control (Option : Cache_Option) return String with Inline;

   function Cache_Control (Data : Cache_Data) return String with Inline;

   function Content_Disposition
     (Format, Name, Filename : String) return String with Inline;
   --  Note that this is not part of HTTP/1.1 standard, it is there because
   --  there is a lot of implementation around using it. This header is used
   --  in multipart data.

   function Date (Date : Calendar.Time) return String with Inline;
   --  The date header

   function ETag (Value : ETag_Value) return String with Inline;

   function Expires (Date : Calendar.Time) return String with Inline;
   --  The date should not be more than a year in the future, see RFC 2616
   --  [14.21 Expires].

   function Host (Name : String) return String with Inline;

   function Last_Modified (Date : Calendar.Time) return String with Inline;

   function Location (URL : String) return String with Inline;

   function Proxy_Authorization (Mode, Password : String) return String
     with Inline;

   function Proxy_Connection (Mode : String) return String with Inline;

   function Data_Range (Value : String) return String with Inline;

   function SOAPAction (URI : String) return String with Inline;

   function Status_Line
     (Code          : Status_Code;
      Reason_Phrase : String := "") return String with Inline;
   --  The HTTP status line on the form: HTTP/1.1 <code> <reason>

   function Status_Value
     (Code          : Status_Code;
      Reason_Phrase : String := "") return String with Inline;
   --  As above but only with the values : <code> <reason>

   function Transfer_Encoding (Encoding : String) return String with Inline;

   function User_Agent (Name : String) return String with Inline;

   function WWW_Authenticate (Realm : String) return String with Inline;
   --  Basic authentication request

   function WWW_Authenticate
     (Realm, Nonce : String; Stale : Boolean) return String with Inline;
   --  Digest authentication request

   function Sec_WebSocket_Accept (Key : String) return String with Inline;

   -----------------------
   --  helper functions --
   -----------------------

   function To_HTTP_Date (Time : Calendar.Time) return String;
   --  Returns an Ada time as a string using the HTTP normalized format.
   --  Format is RFC 822, updated by RFC 1123.

   function To_Time (HTTP_Date : String) return Calendar.Time;
   --  Returns an Ada time from an HTTP one. This is To_HTTP_Date opposite
   --  function.

private

   function With_Body (S : Status_Code) return Boolean is
     (S not in Informational | S204 | S304);

   Unspecified   : constant Cache_Option := "";
   No_Cache      : constant Cache_Option := "no-cache, max-age=0, s-maxage=0";
   No_Store      : constant Cache_Option := "no-store";
   Prevent_Cache : constant Cache_Option := No_Store & ", " & No_Cache;

   Unset         : constant Delta_Seconds := -1;
   No_Max_Stale  : constant Delta_Seconds := Unset;
   Any_Max_Stale : constant Delta_Seconds := Delta_Seconds'Last;

   All_Private   : constant Private_Option := To_Unbounded_String ("*");
   Private_Unset : constant Private_Option :=
                     Private_Option (Null_Unbounded_String);

   function Content_Type (Format : String) return String is
     (Content_Type (Format, ""));

end AWS.Messages;
