THRIFT-5591 Add uuid type to IDL and implement reference code (+ improved self-tests)
Client: compiler general, netstd, Delphi
Patch: Jens Geyer
diff --git a/lib/delphi/src/Thrift.Protocol.Compact.pas b/lib/delphi/src/Thrift.Protocol.Compact.pas
index 3a1dbfd..02a19ea 100644
--- a/lib/delphi/src/Thrift.Protocol.Compact.pas
+++ b/lib/delphi/src/Thrift.Protocol.Compact.pas
@@ -77,7 +77,8 @@
       LIST          = $09,
       SET_          = $0A,
       MAP           = $0B,
-      STRUCT        = $0C
+      STRUCT        = $0C,
+      UUID          = $0D
     );
 
   private type
@@ -100,7 +101,8 @@
       Types.STRUCT,         // Struct  = 12,
       Types.MAP,            // Map     = 13,
       Types.SET_,           // Set_    = 14,
-      Types.LIST            // List    = 15,
+      Types.LIST,           // List    = 15,
+      Types.UUID            // Uuid    = 16
     );
 
     tcompactTypeToType : array[Types] of TType = (
@@ -116,7 +118,8 @@
       TType.List,       // LIST
       TType.Set_,       // SET_
       TType.Map,        // MAP
-      TType.Struct      // STRUCT
+      TType.Struct,     // STRUCT
+      TType.Uuid        // UUID
     );
 
   strict private
@@ -173,6 +176,7 @@
     procedure WriteI64( const i64: Int64); override;
     procedure WriteDouble( const dub: Double); override;
     procedure WriteBinary( const b: TBytes); overload; override;
+    procedure WriteUuid( const uuid: TGuid); override;
 
   private  // unit visible stuff
     class function  DoubleToInt64Bits( const db : Double) : Int64;
@@ -219,6 +223,7 @@
     function  ReadI64: Int64; override;
     function  ReadDouble:Double; override;
     function  ReadBinary: TBytes; overload; override;
+    function  ReadUuid: TGuid; override;
 
   private
     // Internal Reading methods
@@ -537,6 +542,14 @@
   Transport.Write( b);
 end;
 
+procedure TCompactProtocolImpl.WriteUuid( const uuid: TGuid);
+var network : TGuid;  // in network order (Big Endian)
+begin
+  ASSERT( SizeOf(uuid) = 16);
+  network := uuid.SwapByteOrder;
+  Transport.Write( @network, 0, SizeOf(network));
+end;
+
 procedure TCompactProtocolImpl.WriteMessageEnd;
 begin
   // nothing to do
@@ -850,6 +863,14 @@
   then Transport.ReadAll( result, 0, length);
 end;
 
+function TCompactProtocolImpl.ReadUuid: TGuid;
+var network : TGuid;  // in network order (Big Endian)
+begin
+  ASSERT( SizeOf(result) = 16);
+  FTrans.ReadAll( @network, SizeOf(network), 0, SizeOf(network));
+  result := network.SwapByteOrder;
+end;
+
 
 procedure TCompactProtocolImpl.ReadMessageEnd;
 begin
@@ -994,6 +1015,7 @@
     TType.Map:     result := SizeOf(Byte);  // element count
     TType.Set_:    result := SizeOf(Byte);  // element count
     TType.List:    result := SizeOf(Byte);  // element count
+    TType.Uuid:    result := SizeOf(TGuid);
   else
     raise TTransportExceptionBadArgs.Create('Unhandled type code');
   end;
diff --git a/lib/delphi/src/Thrift.Protocol.JSON.pas b/lib/delphi/src/Thrift.Protocol.JSON.pas
index 52909b7..2a9682c 100644
--- a/lib/delphi/src/Thrift.Protocol.JSON.pas
+++ b/lib/delphi/src/Thrift.Protocol.JSON.pas
@@ -198,6 +198,7 @@
     procedure WriteDouble( const d: Double); override;
     procedure WriteString( const s: string );   override;
     procedure WriteBinary( const b: TBytes); override;
+    procedure WriteUuid( const uuid: TGuid); override;
     //
     function ReadMessageBegin: TThriftMessage; override;
     procedure ReadMessageEnd(); override;
@@ -219,6 +220,7 @@
     function ReadDouble:Double; override;
     function ReadString : string;  override;
     function ReadBinary: TBytes; override;
+    function ReadUuid: TGuid; override;
 
 
   strict private
@@ -288,6 +290,7 @@
   NAME_MAP    = 'map';
   NAME_LIST   = 'lst';
   NAME_SET    = 'set';
+  NAME_UUID   = 'uid';
 
   INVARIANT_CULTURE : TFormatSettings
                     = ( ThousandSeparator: ',';
@@ -317,6 +320,7 @@
     TType.Map:      result := NAME_MAP;
     TType.Set_:     result := NAME_SET;
     TType.List:     result := NAME_LIST;
+    TType.Uuid:     result := NAME_UUID;
   else
     raise TProtocolExceptionNotImplemented.Create('Unrecognized type ('+IntToStr(Ord(typeID))+')');
   end;
@@ -336,6 +340,7 @@
   else if name = NAME_MAP    then result := TType.Map
   else if name = NAME_LIST   then result := TType.List
   else if name = NAME_SET    then result := TType.Set_
+  else if name = NAME_UUID   then result := TType.Uuid
   else raise TProtocolExceptionNotImplemented.Create('Unrecognized type ('+name+')');
 end;
 
@@ -831,6 +836,11 @@
   WriteJSONBase64( b);
 end;
 
+procedure TJSONProtocolImpl.WriteUuid( const uuid: TGuid);
+begin
+  WriteString( Copy( GuidToString(uuid), 2, 36));  // strip off the { braces }
+end;
+
 
 function TJSONProtocolImpl.ReadJSONString( skipContext : Boolean) : TBytes;
 var buffer : TThriftMemoryStream;
@@ -1237,6 +1247,12 @@
 end;
 
 
+function TJSONProtocolImpl.ReadUuid: TGuid;
+begin
+  result := StringToGUID( '{' + ReadString + '}');
+end;
+
+
 function TJSONProtocolImpl.GetMinSerializedSize( const aType : TType) : Integer;
 // Return the minimum number of bytes a type will consume on the wire
 begin
@@ -1254,6 +1270,7 @@
     TType.Map:     result := 2;  // empty map
     TType.Set_:    result := 2;  // empty set
     TType.List:    result := 2;  // empty list
+    TType.Uuid:    result := 36; // "E236974D-F0B0-4E05-8F29-0B455D41B1A1"
   else
     raise TTransportExceptionBadArgs.Create('Unhandled type code');
   end;
diff --git a/lib/delphi/src/Thrift.Protocol.pas b/lib/delphi/src/Thrift.Protocol.pas
index 9f2cac8..636f201 100644
--- a/lib/delphi/src/Thrift.Protocol.pas
+++ b/lib/delphi/src/Thrift.Protocol.pas
@@ -49,7 +49,8 @@
     Struct = 12,
     Map = 13,
     Set_ = 14,
-    List = 15
+    List = 15,
+    Uuid = 16
   );
 
   TMessageType = (
@@ -62,7 +63,7 @@
 const
   VALID_TTYPES = [
     TType.Stop, TType.Void,
-    TType.Bool_, TType.Byte_, TType.Double_, TType.I16, TType.I32, TType.I64, TType.String_,
+    TType.Bool_, TType.Byte_, TType.Double_, TType.I16, TType.I32, TType.I64, TType.String_, TType.Uuid,
     TType.Struct, TType.Map, TType.Set_, TType.List
   ];
 
@@ -221,6 +222,7 @@
     procedure WriteAnsiString( const s: AnsiString);
     procedure WriteBinary( const b: TBytes); overload;
     procedure WriteBinary( const b: IThriftBytes); overload;
+    procedure WriteUuid( const uuid: TGuid);
 
     function ReadMessageBegin: TThriftMessage;
     procedure ReadMessageEnd();
@@ -242,6 +244,7 @@
     function ReadDouble:Double;
     function ReadBinary: TBytes;  // IMPORTANT: this is NOT safe across module boundaries
     function ReadBinaryCOM : IThriftBytes;
+    function ReadUuid: TGuid;
     function ReadString: string;
     function ReadAnsiString: AnsiString;
 
@@ -297,6 +300,7 @@
     procedure WriteString( const s: string ); virtual;
     procedure WriteAnsiString( const s: AnsiString); virtual;
     procedure WriteBinary( const b: TBytes); overload; virtual; abstract;
+    procedure WriteUuid( const b: TGuid); virtual; abstract;
 
     function ReadMessageBegin: TThriftMessage; virtual; abstract;
     procedure ReadMessageEnd(); virtual; abstract;
@@ -317,6 +321,7 @@
     function ReadI64: Int64; virtual; abstract;
     function ReadDouble:Double; virtual; abstract;
     function ReadBinary: TBytes; virtual; abstract;
+    function ReadUuid: TGuid; virtual; abstract;
     function ReadString: string; virtual;
     function ReadAnsiString: AnsiString; virtual;
 
@@ -415,6 +420,7 @@
     procedure WriteI64( const i64: Int64); override;
     procedure WriteDouble( const d: Double); override;
     procedure WriteBinary( const b: TBytes); override;
+    procedure WriteUuid( const uuid: TGuid); override;
 
     function ReadMessageBegin: TThriftMessage; override;
     procedure ReadMessageEnd(); override;
@@ -435,6 +441,7 @@
     function ReadI64: Int64; override;
     function ReadDouble:Double; override;
     function ReadBinary: TBytes; override;
+    function ReadUuid: TGuid; override;
 
   end;
 
@@ -479,6 +486,7 @@
     procedure WriteString( const s: string ); override;
     procedure WriteAnsiString( const s: AnsiString); override;
     procedure WriteBinary( const b: TBytes); override;
+    procedure WriteUuid( const uuid: TGuid); override;
 
     function ReadMessageBegin: TThriftMessage; override;
     procedure ReadMessageEnd(); override;
@@ -499,6 +507,7 @@
     function ReadI64: Int64; override;
     function ReadDouble:Double; override;
     function ReadBinary: TBytes; override;
+    function ReadUuid: TGuid; override;
     function ReadString: string; override;
     function ReadAnsiString: AnsiString; override;
   end;
@@ -800,6 +809,7 @@
     TType.I64     :  prot.ReadI64();
     TType.Double_ :  prot.ReadDouble();
     TType.String_ :  prot.ReadBinary();// Don't try to decode the string, just skip it.
+    TType.Uuid    :  prot.ReadUuid();
 
     // structured types
     TType.Struct :  begin
@@ -874,6 +884,14 @@
   Result := buf;
 end;
 
+function TBinaryProtocolImpl.ReadUuid : TGuid;
+var network : TGuid;  // in network order (Big Endian)
+begin
+  ASSERT( SizeOf(result) = 16);
+  FTrans.ReadAll( @network, SizeOf(network), 0, SizeOf(network));
+  result := network.SwapByteOrder;
+end;
+
 function TBinaryProtocolImpl.ReadBool: Boolean;
 begin
   Result := (ReadByte = 1);
@@ -1042,6 +1060,14 @@
   if iLen > 0 then FTrans.Write(b, 0, iLen);
 end;
 
+procedure TBinaryProtocolImpl.WriteUuid( const uuid: TGuid);
+var network : TGuid;  // in network order (Big Endian)
+begin
+  ASSERT( SizeOf(uuid) = 16);
+  network := uuid.SwapByteOrder;
+  Transport.Write( @network, 0, SizeOf(network));
+end;
+
 procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
 begin
   if b then begin
@@ -1191,6 +1217,7 @@
     TType.Map:     result := SizeOf(Int32);  // element count
     TType.Set_:    result := SizeOf(Int32);  // element count
     TType.List:    result := SizeOf(Int32);  // element count
+    TType.Uuid:    result := SizeOf(TGuid);
   else
     raise TTransportExceptionBadArgs.Create('Unhandled type code');
   end;
@@ -1437,6 +1464,12 @@
 end;
 
 
+procedure TProtocolDecorator.WriteUuid( const uuid: TGuid);
+begin
+  FWrappedProtocol.WriteUuid( uuid);
+end;
+
+
 function TProtocolDecorator.ReadMessageBegin: TThriftMessage;
 begin
   result := FWrappedProtocol.ReadMessageBegin;
@@ -1551,6 +1584,12 @@
 end;
 
 
+function TProtocolDecorator.ReadUuid: TGuid;
+begin
+  result := FWrappedProtocol.ReadUuid;
+end;
+
+
 function TProtocolDecorator.ReadString: string;
 begin
   result := FWrappedProtocol.ReadString;
diff --git a/lib/delphi/src/Thrift.Utils.pas b/lib/delphi/src/Thrift.Utils.pas
index 4a75af8..1226535 100644
--- a/lib/delphi/src/Thrift.Utils.pas
+++ b/lib/delphi/src/Thrift.Utils.pas
@@ -84,11 +84,34 @@
     class function IsHtmlDoctype( const fourBytes : Integer) : Boolean; static;
   end;
 
+
+  IntegerUtils = class sealed
+  strict private
+    class procedure SwapBytes( var one, two : Byte); static; inline;
+    class procedure Swap2( const pValue : Pointer); static;
+    class procedure Swap4( const pValue : Pointer); static;
+    class procedure Swap8( const pValue : Pointer); static;
+  public
+    class procedure SwapByteOrder( const pValue : Pointer; const size : Integer); overload; static;
+  end;
+
+
+  TGuidHelper = record helper for System.TGuid
+  public
+    function SwapByteOrder : TGuid;
+
+    {$IFDEF Debug}
+    class procedure SelfTest; static;
+    {$ENDIF}
+  end;
+
+
   EnumUtils<T> = class sealed
   public
     class function ToString(const value : Integer) : string;  reintroduce; static; inline;
   end;
 
+
   StringUtils<T> = class sealed
   public
     class function ToString(const value : T) : string;  reintroduce; static; inline;
@@ -283,6 +306,97 @@
   result := (UpCase(pc^) = HTML_BEGIN[3]);
 end;
 
+{ IntegerUtils }
+
+
+class procedure IntegerUtils.SwapBytes( var one, two : Byte);
+var tmp : Byte;
+begin
+  tmp := one;
+  one := two;
+  two := tmp;
+end;
+
+
+class procedure IntegerUtils.Swap2( const pValue : Pointer);
+var pData : PByteArray absolute pValue;
+begin
+  SwapBytes( pData^[0], pData^[1]);
+end;
+
+
+class procedure IntegerUtils.Swap4( const pValue : Pointer);
+var pData : PByteArray absolute pValue;
+begin
+  SwapBytes( pData^[0], pData^[3]);
+  SwapBytes( pData^[1], pData^[2]);
+end;
+
+
+class procedure IntegerUtils.Swap8( const pValue : Pointer);
+var pData : PByteArray absolute pValue;
+begin
+  SwapBytes( pData^[0], pData^[7]);
+  SwapBytes( pData^[1], pData^[6]);
+  SwapBytes( pData^[2], pData^[5]);
+  SwapBytes( pData^[3], pData^[4]);
+end;
+
+
+class procedure IntegerUtils.SwapByteOrder( const pValue : Pointer; const size : Integer);
+begin
+  case size of
+    2 : Swap2( pValue);
+    4 : Swap4( pValue);
+    8 : Swap8( pValue);
+  else
+    raise EArgumentException.Create('Unexpected size');
+  end;
+end;
+
+
+{ TGuidHelper }
+
+
+function TGuidHelper.SwapByteOrder : TGuid;
+// convert to/from network byte order
+// - https://www.ietf.org/rfc/rfc4122.txt
+// - https://stackoverflow.com/questions/10850075/guid-uuid-compatibility-issue-between-net-and-linux
+// - https://lists.gnu.org/archive/html/bug-parted/2002-01/msg00099.html
+begin
+  result := Self;
+
+  IntegerUtils.SwapByteOrder( @result.D1, SizeOf(result.D1));
+  IntegerUtils.SwapByteOrder( @result.D2, SizeOf(result.D2));
+  IntegerUtils.SwapByteOrder( @result.D3, SizeOf(result.D3));
+  //result.D4 = array of byte -> implicitly correct
+end;
+
+
+{$IFDEF Debug}
+class procedure TGuidHelper.SelfTest;
+var guid   : TGuid;
+    pBytes : PByteArray;
+    i, expected : Integer;
+const TEST_GUID : TGuid = '{00112233-4455-6677-8899-aabbccddeeff}';
+begin
+  // host to network
+  guid := TEST_GUID;
+  guid := guid.SwapByteOrder;
+
+  // validate network order
+  pBytes := @guid;
+  for i := 0 to $F do begin
+    expected := i * $11;
+    ASSERT( pBytes^[i] = expected);
+  end;
+
+  // network to host and final validation
+  guid := guid.SwapByteOrder;
+  ASSERT( IsEqualGuid( guid, TEST_GUID));
+end;
+{$ENDIF}
+
 
 
 {$IFDEF Win64}
@@ -378,4 +492,8 @@
 end;
 
 
+begin
+  {$IFDEF Debug}
+  TGuid.SelfTest;
+  {$ENDIF}
 end.