SynMongoDB.pas

/// MongoDB document-oriented database direct access classes
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynMongoDB;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2017 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2017
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - BBackSoon
  - Sabbiolina
  - Zed


  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Version 1.18
  - first public release, corresponding to mORMot Framework 1.18
    and feature request [0fee1d995c]


  TODO:
  - handle BULK commands support for MongoDB >=2.6 for faster writes
    see http://blog.mongodb.org/post/84922794768
  - GridFS support


}

interface

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 SQLITE3_FASTCALL

uses
  {$ifdef MSWINDOWS}
  Windows,
  {$else}
  {$ifdef KYLIX3}
  SynKylix,
  LibC,
  {$else}
  SynFPCLinux,
  {$endif}
  {$endif}
  Classes,
  Variants,  // this unit expects Variants to be available for storage
  SysUtils,
  SynCrtSock,
  SynCrypto, // MD5 and SHA1 needed for OpenAuth()
  SynCommons,
  SynLog;



{ ************ BSON (Binary JSON) process }

type
  /// binary representation of a 128 bit decimal, stored as 16 bytes
  // - i.e. IEEE 754-2008 128-bit decimal floating point as used in the
  // BSON Decimal128 format, and processed by the TDecimal128 object
  TDecimal128Bits = record
    case integer of
    0: (lo, hi: QWord);
    1: (b: array[0..15] of byte);
    2: (c: array[0..3] of cardinal);
  end;
  /// points to a 128 bit decimal binary
  PDecimal128Bits = ^TDecimal128Bits;

  /// enough characters to contain any TDecimal128 text representation
  TDecimal128Str = array[0..42] of AnsiChar;

  /// some special 128 bit decimal values
  // - see TDecimal128.SetSpecial to set the corresponding value
  // - dsvError is returned by TDecimal128.FromText() on parsing error
  // - dsvValue indicates that this is not a known "special" value, but some
  // valid decimal number
  TDecimal128SpecialValue = (
    dsvError, dsvValue, dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax);

  /// handles a 128 bit decimal value
  // - i.e. IEEE 754-2008 128-bit decimal floating point as used in the
  // BSON Decimal128 format, i.e. betDecimal128 TBSONElementType
  // - the betFloat BSON format stores a 64-bit floating point value, which
  // doesn't have exact decimals, so may suffer from rounding or approximation
  // - for instance, if you work with Delphi currency values, you may store
  // betDecimal128 values in MongoDB - the easiest way is to include it as a
  // TBSONVariant instance, via the NumberDecimal() function
  // - there is no mathematical operator/methods for Decimal128 Value Objects,
  // as required by MongoDB specifications: any computation must be done
  // explicitly on native language value representation (e.g. currency, TBCD or
  // any BigNumber library) - use ToCurr/FromCurr or ToText/FromText to make
  // the appropriate safe conversions
  {$ifndef UNICODE}
  TDecimal128 = object
  {$else}
  TDecimal128 = record
  {$endif}
  public
    /// the raw binary storage
    Bits: TDecimal128Bits;
    /// fills with the Zero value
    // - note: under IEEE 754, Zero can have sign and exponents, so is not Hi=Lo=0
    // - is the same as Fill(dsvZero)
    procedure SetZero;
    /// fills with a special value
    // - dsvError or dsvValue will set dsvNan binary content
    procedure SetSpecial(special: TDecimal128SpecialValue);
    /// checks if the value matches one of the known special values
    // - will search for dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax
    function IsSpecial: TDecimal128SpecialValue;
    /// fills with a 32-bit signed value
    procedure FromInt32(value: integer);
    /// fills with a 32-bit unsigned value
    procedure FromUInt32(value: cardinal);
      {$ifdef HASINLINE}inline;{$endif}
    /// fills with a 64-bit signed value
    procedure FromInt64(value: Int64);
    /// fills with a 64-bit unsigned value
    procedure FromQWord(value: QWord);
      {$ifdef HASINLINE}inline;{$endif}
    /// fills with a fixed decimal value, as stored in currency
    // - will store the content with explictly four decimals, as in currency
    // - by design, this method is very fast and accurate
    procedure FromCurr(const value: Currency);
    /// fills from the text representation of a decimal value
    // - returns dsvValue or one of the dsvNan, dsvZero, dsvPosInf, dsvNegInf
    // special value indicator otherwise on succes
    // - returns dsvError on parsing failure
    function FromText(text: PUTF8Char; textlen: integer): TDecimal128SpecialValue; overload;
    /// fills from the text representation of a decimal value
    // - returns dsvValue or one of the dsvNan, dsvZero, dsvPosInf, dsvNegInf
    // special value indicator otherwise on succes
    // - returns dsvError on parsing failure
    function FromText(const text: RawUTF8): TDecimal128SpecialValue; overload;
    /// convert a variant into one Decimal128 value
    // - will first check for a TBSONVariant containing a betDecimal128 (e.g.
    // as retrieved via the ToVariant method)
    // - then will try to convert the variant from its string value, expecting
    // a floating-point text content
    // - returns TRUE if conversion was made, FALSE on any error
    function FromVariant(const value: variant): boolean;
    /// fills with a native floating-point value
    // - note that it doesn't make much sense to use this method: you should
    // rather use the native betFloat BSON format, with native double precision
    // - this method is just a wrapper around ExtendedToString and ToText,
    // so you should provide the expected precision, from the actual storage
    // variable (you may specify e.g. SINGLE_PRECISION or EXTENDED_PRECISION if
    // you don't use a double kind of value)
    function FromFloat(const value: TSynExtended; precision: integer=0): boolean;
    /// fast bit-per-bit value comparison
    function Equals(const other: TDecimal128): boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// converts the value to its string representation
    // - returns the number of AnsiChar written to Buffer
    function ToText(out Buffer: TDecimal128Str): integer; overload;
    /// converts this Decimal128 value to its string representation
    function ToText: RawUTF8; overload;
    /// converts this Decimal128 value to its string representation
    procedure ToText(var result: RawUTF8); overload;
    /// convert this Decimal128 value to its TBSONVariant custom variant value
    function ToVariant: variant; overload;
    /// convert this Decimal128 value to its TBSONVariant custom variant value
    procedure ToVariant(out result: variant); overload;
    /// converts this Decimal128 value to a floating-point value
    // - by design, some information may be lost during conversion
    // - note that it doesn't make much sense to use this method: you should
    // rather use the native betFloat BSON format, with native double precision
    function ToFloat: TSynExtended;
    /// converts this Decimal128 value to a fixed decimal value
    // - by design, some information may be lost during conversion, unless the
    // value has been stored previously via the FromCurr() method - in this
    // case, conversion is immediate and accurate
    function ToCurr: currency; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// converts this Decimal128 value to a fixed decimal value
    // - by design, some information may be lost during conversion, unless the
    // value has been stored previously via the FromCurr() method - in this
    // case, conversion is immediate and accurate
    procedure ToCurr(out result: currency); overload;
    /// converts this Decimal128 value to its string representation
    procedure AddText(W: TTextWriter);
  end;
  /// points to a 128 bit decimal value
  PDecimal128 = ^TDecimal128;

const
  /// the textual representation of the TDecimal128 special values
  DECIMAL128_SPECIAL_TEXT: array[TDecimal128SpecialValue] of RawUTF8 = (
    // dsvError, dsvValue, dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax
    '', '', 'NaN', '0', 'Infinity', '-Infinity',
    '-9.999999999999999999999999999999999E+6144',
     '9.999999999999999999999999999999999E+6144');

  BSON_DECIMAL128_HI_NAN        = $7c00000000000000;
  BSON_DECIMAL128_HI_INT64POS   = $3040000000000000; // 0 fixed decimals
  BSON_DECIMAL128_HI_INT64NEG   = $b040000000000000;
  BSON_DECIMAL128_HI_CURRPOS    = $3038000000000000; // 4 fixed decimals
  BSON_DECIMAL128_HI_CURRNEG    = $b038000000000000;
  BSON_DECIMAL128_EXPONENT_MAX  = 6111;
  BSON_DECIMAL128_EXPONENT_MIN  = -6176;
  BSON_DECIMAL128_EXPONENT_BIAS = 6176;
  BSON_DECIMAL128_MAX_DIGITS    = 34;


type
  /// exception type used for BSON process
  EBSONException = class(ESynException);

  /// storage of a BSON binary document
  // - a specific type is defined for consistency with this unit classes
  // - binary content should follow the "int32 e_list #0" standard layout
  TBSONDocument = RawByteString;

  /// dynamic array of BSON binary document storage
  TBSONDocumentDynArray = array of TBSONDocument;

  /// element types for BSON internal representation
  TBSONElementType = (
    betEOF, betFloat, betString, betDoc, betArray, betBinary,
    betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
    betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
    betJSScope, betInt32, betTimeStamp, betInt64, betDecimal128);

  /// points to an element type for BSON internal representation
  PBSONElementType = ^TBSONElementType;

  /// sub-types for betBinary element BSON internal representation
  TBSONElementBinaryType = (
    bbtGeneric, bbtFunction, bbtOldBinary, bbtOldUUID, bbtUUID, bbtMD5,
    bbtUser = $80);

  /// 24-bit storage, mapped as a 3 bytes buffer
  // - as used fo TBSONObjectID.MachineID and TBSONObjectID.Counter
  TBSON24 = record
    b1,b2,b3: byte;
  end;
  /// points to 24-bit storage, mapped as a 3 bytes buffer
  PBSON24 = ^TBSON24;

  /// BSON ObjectID internal binary representation
  // - in MongoDB, documents stored in a collection require a unique _id field
  // that acts as a primary key: by default, it uses such a 12-byte ObjectID
  // - by design, sorting by _id: ObjectID is roughly equivalent to sorting by
  // creation time, so ease sharding and BTREE storage
  // - match betObjectID TBSONElementType
  {$A-}
  {$ifndef UNICODE}
  TBSONObjectID = object
  {$else}
  TBSONObjectID = record
  {$endif}
    /// big-endian 4-byte value representing the seconds since the Unix epoch
    // - time is expressed in Coordinated Universal Time (UTC), not local time
    UnixCreateTime: cardinal;
    /// 3-byte machine identifier
    // - ComputeNew will use a hash of ExeVersion.Host and ExeVersion.User
    MachineID: TBSON24;
    /// 2-byte process id
    // - ComputeNew will derivate it from MainThreadID
    ProcessID: word;
    /// 3-byte counter, starting with a random value
    // - used to avoid collision 
    Counter: TBSON24;
    /// ObjectID content be filled with some unique values
    // - this implementation is thread-safe
    procedure ComputeNew;
    /// convert an hexadecimal string value into one ObjectID
    // - returns TRUE if conversion was made, FALSE on any error
    function FromText(const Text: RawUTF8): boolean; overload;
    /// convert an hexadecimal string value into one ObjectID
    // - returns TRUE if conversion was made, FALSE on any error
    function FromText(Text: PUTF8Char): boolean; overload;
    /// convert a variant into one ObjectID
    // - will first check for a TBSONVariant containing a betObjectID
    // - then will try to convert the variant from its string value, expecting
    // an hexadecimal text content
    // - returns TRUE if conversion was made, FALSE on any error
    function FromVariant(const value: variant): boolean;
    /// convert this ObjectID to its hexadecimal string value
    function ToText: RawUTF8; overload;
    /// convert this ObjectID to its hexadecimal string value
    procedure ToText(var result: RawUTF8); overload;
    /// convert this ObjectID to its TBSONVariant custom variant value
    function ToVariant: variant;
    /// returns the timestamp portion of the ObjectId() object as a Delphi date
    // - time is expressed in Coordinated Universal Time (UTC), not local time
    // so you can compare it to NowUTC returned time
    function CreateDateTime: TDateTime;
    /// compare two Object IDs
    function Equal(const Another: TBSONObjectID): boolean;
      {$ifdef HASINLINE}inline;{$endif}
  end;

  /// points to a BSON ObjectID internal binary representation
  PBSONObjectID = ^TBSONObjectID;

  /// memory structure used for some special BSON storage as variant
  // - betObjectID kind will store a TBSONObjectID
  // - betBinary kind will store a BLOB content as RawByteString
  // - betDoc and betArray kind will store a BSON document, in its original
  // binary format as RawByteString (TBSONDocument)
  // - betDeprecatedDbptr, betJSScope, betTimeStamp and betRegEx will store the
  // raw original BSON content as RawByteString
  // - betJS and betDeprecatedSymbol will store the UTF-8 encoded string
  // as a RawUTF8
  // - betDeprecatedUndefined or betMinKey/betMaxKey do not contain any data
  // - betDecimal128 will store the TDecimal128 16 bytes binary buffer 
  // - warning: VBlob/VText use should match BSON_ELEMENTVARIANTMANAGED constant
  TBSONVariantData = packed record
    /// the variant type
    VType: TVarType;
    /// the kind of element stored
    case VKind: TBSONElementType of
    betObjectID: (
      {$HINTS OFF} // does not complain if Filler is declared but never used
      VFiller: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(TBSONElementType)
        -SizeOf(TBSONObjectID)] of byte;
      {$HINTS ON}
      VObjectID: TBSONObjectID
    );
    betBinary, betDoc, betArray, betRegEx, betDeprecatedDbptr, betTimeStamp,
    betJSScope, betDecimal128: (
      /// store the raw binary content as a RawByteString (or TBSONDocument for
      // betDoc/betArray, i.e. the "int32 e_list #0" standard layout)
      // - you have to use RawByteString(VBlob) when accessing this field
      // - e.g. for betRegEx, it will contain raw [cstring cstring] content
      VBlob: pointer;
    );
    betJS, betDeprecatedSymbol: (
      /// store here a RawUTF8 with the associated text
      // - you have to use RawUF8(VText) when accessing this field
      VText: pointer;
    );
  end;
  {$A+}

  /// custom variant type used to store some special BSON elements
  // - internal layout will follow TBSONVariantData
  // - handled kind of item are complex BSON types, like betObjectID, betBinary
  // or betDoc/betArray
  // - it will allow conversion to/from string (and to date for ObjectID)
  TBSONVariant = class(TSynInvokeableVariantType)
  protected
    function GetNewDoc(const BSONDoc: TBSONDocument): variant;
  public
    /// customization of JSON conversion into TBSONVariant kind of variants
    function TryJSONToVariant(var JSON: PUTF8Char; var Value: variant;
      EndOfObject: PUTF8Char): boolean; override;
    /// variant serialization will use modMongoStrict JSON-compatible mode
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;
    /// handle type conversion
    // - only types processed by now are string/OleStr/UnicodeString/date
    procedure Cast(var Dest: TVarData; const Source: TVarData); override;
    /// handle type conversion
    // - only types processed by now are string/OleStr/UnicodeString/date
    procedure CastTo(var Dest: TVarData; const Source: TVarData;
      const AVarType: TVarType); override;
    /// clear the instance
    procedure Clear(var V: TVarData); override;
    /// copy one instance
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
    /// compare two variant values
    // - handle comparison of any variant, including TBSONVariant, via a
    // temporary JSON conversion, and case-sensitive comparison
    // - it uses case-sensitive text (hexadecimal) comparison for betObjectID
    procedure Compare(const Left, Right: TVarData;
      var Relationship: TVarCompareResult); override;
    /// convert a TBSONDocument binary content into a TBSONVariant of kind
    // betDoc or betArray
    // - see also all BSONVariant() overloaded functions, which also create
    // a TBSONVariant betDoc instance
    procedure FromBSONDocument(const BSONDoc: TBSONDocument; var result: variant;
      Kind: TBSONElementType=betDoc);
    /// convert a BLOB binary content into a TBSONVariant of kind betBinary
    // - if Bin is '', will store a NULL variant
    procedure FromBinary(const Bin: RawByteString; BinType: TBSONElementBinaryType;
      var result: variant);
    /// convert a JSON content into a TBSONVariant of kind betDoc or betArray
    // - warning: the supplied JSON buffer will be modified in-place
    // - will create a plain variant value if the JSON doesn't start with [ or {
    procedure FromJSON(json: PUTF8Char; var result: variant);
    /// returns TRUE if the supplied variant stores the supplied BSON kind of value
    function IsOfKind(const V: variant; Kind: TBSONElementType): boolean;
    /// retrieve a betBinary content stored in a TBSONVariant instance
    // - returns TRUE if the supplied variant is a betBinary, and set the
    // binary value into the supplied Blob variable
    // - returns FALSE otherwise
    function ToBlob(const V: Variant; var Blob: RawByteString): boolean;
    /// convert a TBSONDocument binary content into a TBSONVariant of kind betDoc
    // - is the default property, so that you can write:
    // ! BSONVariantType[BSON(['BSON',_Arr(['awesome',5.05, 1986])])]
    // - see also all BSONVariant() overloaded functions, which also create
    // a TBSONVariant betDoc instance
    property NewDoc[const BSONDoc: TBSONDocument]: variant read GetNewDoc; default;
  end;

  /// define how betDoc/betArray BSON elements will be converted as variants
  // - by default a TBSONVariant custom type will be returned, containing the
  // raw BSON binary content of the embedded document or array
  // - asDocVariantPerValue or asDocVariantPerReference could be used to
  // create a tree of TDocVariant custom kind of variant, able to access
  // to its nested properties via late-binding (asDocVariantPerReference being
  // also much faster in some cases - but less safe - than asDocVariantPerValue)
  // - asDocVariantPerValue will set JSON_OPTIONS[false] settings:
  // ! [dvoReturnNullForUnknownProperty]
  // - asDocVariantPerReference will set JSON_OPTIONS[true]/JSON_OPTIONS_FAST
  // settings:
  // ! [dvoValueCopiedByReference,dvoReturnNullForUnknownProperty]
  // - asDocVariantInternNamesPerValue and asDocVariantInternNamesPerReference
  // will include dvoInternalNames to the TDocVariant.Options 
  TBSONDocArrayConversion = (
    asBSONVariant, asDocVariantPerValue, asDocVariantPerReference,
    asDocVariantInternNamesPerValue, asDocVariantInternNamesPerReference);

  /// how TBSONElement.AddMongoJSON() method and AddMongoJSON() and
  // VariantSaveMongoJSON() functions will render their JSON content
  // - modMongoStrict and modNoMongo will follow the JSON RFC specifications
  // - modMongoShell will use a syntax incompatible with JSON RFC, but more
  // common to MongoDB daily use - as 'ObjectId()' or '{ field: /acme.*corp/i }'
  // - modMongoStrict will use the MongoDB Extended JSON syntax
  // - modNoMongo will serialize dates as ISO-8601 strings, ObjectID as hexadecimal
  // string and other MongoDB special objects in WrBase64() format
  // - see http://docs.mongodb.org/manual/reference/mongodb-extended-json
  TMongoJSONMode = (modNoMongo, modMongoStrict, modMongoShell);

  /// data structure used during BSON binary decoding of one BSON element
  // - will be retrieved by FromVariant() or FromNext()
  // - see http://bsonspec.org/#/specification
  // - this structure has been optimized to map the BSON binary content,
  // without any temporary memory allocation (the SAX way)
  {$ifndef UNICODE}
  TBSONElement = object
  protected
  {$else}
  TBSONElement = record
  private
  {$endif}
    /// used internally to set the TBSONElement content, once Kind has been set
    procedure FromBSON(bson: PByte);
  public
    /// index of this element in the original sequence list
    // - is correct only when the element has been reset before the parsing
    // loop, e.g.:
    // ! item.Index := -1; // so item.Index will count starting at 0
    // ! while item.FromNext(elem.Document) do
    // !   writeln(item.Index,' ',Item.Name,' ',Item.ValueBytes);
    Index: integer;
    /// the UTF-8 encoded name of this element
    Name: PUTF8Char;
    /// the name length (in chars) of this element
    NameLen: integer;
    /// the element type
    Kind: TBSONElementType;
    /// number of bytes in the BSON element
    // - will include the trailing #0 for string element
    ElementBytes: integer;
    /// pointer to the BSON element value
    // - is the raw value, without any parsing, e.g. points to a double value or
    // a document: "int32 e_list #0" standard layout (same as TBSONDocument)
    // - you may cast it for simple types:
    // ! PDouble(Element)^   PBoolean(Element)^        PInteger(Element)^
    // ! PInt64(Element)^    PBSONObjectID(Element)^   PDecimal128(Element)^
    // - or use the nested Data variant record to access more complex content
    // - warning: equals nil for betString/betJS after FromVariant()
    Element: pointer;
    /// depending on the Kind, will point to parsed complex sub-data
    // - since variable records can't have properties, we nest this information
    // within this main Data variable record
    // - not all Kind are handled here, only any complex data
    Data: record
    case TBSONElementType of
    betFloat, betBoolean, betInt32, betDateTime, betInt64: (
      /// this variable is not to be used directly, but for some internal
      // temporary storage, e.g. with FromVariant()
      // - use P*(Element)^ typecast instead
      InternalStorage: Int64;
    );
    betString, betJS: (
      /// points to the #0 ending string
      Text: PUTF8Char;
      /// number of bytes in Text (excluding trailing #0)
      TextLen: integer;
    );
    betDoc, betArray: (
      /// points to a "e_list #0" standard layout
      DocList: PByte;
    );
    betBinary: (
      /// points to the binary content
      Blob: pointer;
      /// number of bytes in Blob
      BlobLen: integer;
      /// corresponding sub-type of this Blob
      BlobSubType: TBSONElementBinaryType;
    );
    betRegEx: (
      RegEx: PUTF8Char;
      RegExLen: integer;
      RegExOptions: PUTF8Char;
      RegExOptionsLen: integer;
    );
    betJSScope: (
      JavaScript: PUTF8Char;
      JavaScriptLen: integer;
      ScopeDocument: PByte;
    );
    betTimeStamp: (
      { map InternalStorage: Int64 }
      time_t: cardinal;
      ordinal: cardinal;
    );
    end;
    /// fill a BSON Element structure from a variant content and associated name
    // - perform the reverse conversion as made with ToVariant()
    // - since the result won't store any data but points to the original binary
    // content, the supplied Name/Value instances should remain available as long as
    // you will access to the result content
    // - aName here is just for conveniency, and could be left void
    // - supplied aTemp variable will be used for temporary storage, private to
    // this initialized TBSONElement
    procedure FromVariant(const aName: RawUTF8; const aValue: Variant;
      var aTemp: RawByteString);
    /// fill a BSON Element structure from a BSON document
    // - will check the document length then set Kind := betDoc and Data.DocList
    // - will return TRUE if the supplied doc has a valid length, FALSE otherwise
    // - you can later on use DocItemToVariant, DocItemToRawUTF8 or
    // DocItemToInteger methods
    // - the supplied "doc" variable should remain available until you are done
    // with this TBSONElement wrapper
    function FromDocument(const doc: TBSONDocument): boolean;
    /// fill a BSON Element structure from a BSON encoded binary buffer list
    // - parse the next BSON element: BSON parameter should point to the
    // "e_list" of the "int32 e_list #0" BSON document
    // - will decode the supplied binary buffer into the BSON element structure,
    // then it will let BSON point to the next element, and return TRUE
    // - returns FALSE when you reached betEOF, so that you can use it in a loop,
    // and retrieve all the content as consecutive events, without any memory
    // allocation (the SAX way):
    // ! var bson: PByte;
    // !     item: TBSONElement;
    // ! ...
    // ! BSONParseLength(bson);
    // ! while item.FromNext(bson) do
    // !   writeln(item.Name);
    // - will raise an EBSONException if BSON content is not correct
    // - as an alternative, consider using TBSONIterator, which wrap both a
    // PByte and a TBSONElement into one convenient item
    function FromNext(var BSON: PByte): boolean;
    /// search for a given name in a BSON encoded binary buffer list
    // - BSON parameter should point to the first "e_list" item of the
    // "int32 e_list #0" BSON document
    // - returns false if the item was not found (with case-insensitive search)
    // - otherwise returns TRUE and the matching element content has been
    // decoded within this TBSONElement structure
    function FromSearch(BSON: PByte; const aName: RawUTF8): boolean;
    /// convert a BSON element, as retrieved by TBSONElement.FromNext(),
    // into a variant
    // - it will return either standard variant values, or TBSONVariant custom type
    // for most complex kind of elements (see TBSONVariantData type definition)
    // - note that betString types will be stored as RawUTF8 varString
    // - by default, it will return TBSONVariant custom variants for documents or
    // arrays - but if storeDocArrayAsDocVariant is set, it will return a
    // TDocVariant custom kind of variant, able to access to its nested
    // properties via late-binding
    function ToVariant(DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): variant; overload;
    /// convert a BSON element, as retrieved by TBSONElement.FromNext(),
    // into a variant
    // - same as the other ToVariant() overloaded function, but avoiding a copy
    // of the resulting variant
    procedure ToVariant(var result: variant;
      DocArrayConversion: TBSONDocArrayConversion=asBSONVariant); overload;
    /// convert a BSON element into an UTF-8 string
    // - any complex types (e.g. nested documents) will be converted via a
    // variant
    function ToRawUTF8: RawUTF8;
    /// convert a BSON element into an integer value
    // - will work only for betBoolean/betInt32/betInt64 types
    // - any other kind of values will return the supplied default value
    function ToInteger(const default: Int64=0): Int64;
    /// search a variant property value within the BSON element as document
    // - returns true if aName has been found as property in the BSON element,
    // and fills aValue with the corresponding value
    // - returns false if aName was not found, or if Kind is not betDoc or betArray
    function DocItemToVariant(const aName: RawUTF8; var aValue: variant;
      DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): boolean;
    /// search an UTF-8 property value within the BSON element as document
    // - returns the value if aName has been found as property in the BSON element
    // - returns '' if aName was not found, or if Kind is not betDoc or betArray
    function DocItemToRawUTF8(const aName: RawUTF8): RawUTF8;
    /// search an integer property value within the BSON element as document
    // - returns the value if aName has been found as property in the BSON element
    // - returns default if aName was not found, or if Kind is not betDoc or betArray
    function DocItemToInteger(const aName: RawUTF8; const default: Int64=0): Int64;
    /// convert a BSON element, as retrieved by TBSONElement.FromNext(), into
    // its JSON representation
    // - this method will use by default the MongoDB Extended JSON syntax for
    // specific MongoDB objects but you may use modMongoShell if needed
    // - will raise an EBSONException if element is not correct
    procedure AddMongoJSON(W: TTextWriter; Mode: TMongoJSONMode=modMongoStrict); overload;
  end;
  PBSONElement = ^TBSONElement;

  /// data structure used for iterating over a BSON binary buffer
  // - is just a wrapper around a PByte value, to be used with a TBSONDocument
  {$ifndef UNICODE}
  TBSONIterator = object
  protected
  {$else}
  TBSONIterator = record
  private
  {$endif}
    fBson: PByte;
  public
    /// map the current item, after the Next method did return TRUE
    // - map the global document, after Init() but before the first Next call
    Item: TBSONElement;
    /// initialize the iteration on the supplied BSON document
    // - will check the document length and returns TRUE if it is correct
    // - only accepted kind are betDoc and betArray (but not used later)
    // - you can then use the Next method to iterate over the Item elements
    // - after this call, the Item property map to the global BSON document
    // (note that after any call to the Next method, Item will map the current
    // iterated value, and not the global BSON document any more)
    function Init(const doc: TBSONDocument; kind: TBSONElementType=betArray): boolean;
    /// will iterate on the BSON document
    // - returns TRUE if the item has been retrieved into the Item property
    // - returns FALSE if we reached the end of the supplied BSON buffer
    function Next: boolean;
      {$ifdef HASINLINE}inline;{$endif}
  end;

  /// used to write the BSON context
  TBSONWriter = class(TFileBufferWriter)
  { note: inlining methods generates 70% SLOWER code due to inefficient compiler :( }
  protected
    fDocumentCount: integer;
    fDocument: array of record
      Offset: cardinal;
      Length: cardinal;
    end;
    fDocumentStack: integer;
    fDocumentStackOffset: TCardinalDynArray;
    fDocumentArray: integer;
    procedure WriteCollectionName(Flags: integer; const CollectionName: RawUTF8);
  public
    /// rewind the Stream to the position when Create() was called
    // - this will also reset the internal document offset table
    procedure CancelAll; override;

    /// write a boolean value
    procedure BSONWrite(const name: RawUTF8; const value: boolean); overload;
    /// write a floating point value
    procedure BSONWrite(const name: RawUTF8; const value: Double); overload;
    /// write a 32 bit integer value
    procedure BSONWrite(const name: RawUTF8; const value: integer); overload;
    /// write a 64 bit integer value
    procedure BSONWrite(const name: RawUTF8; const value: Int64); overload;
    /// write a string (UTF-8) value
    procedure BSONWrite(const name: RawUTF8; const value: RawUTF8; isJavaScript: boolean=false); overload;
    /// write a string (UTF-8) value from a memory buffer
    procedure BSONWrite(const name: RawUTF8; value: PUTF8Char); overload;
    /// write a string (UTF-8) value from a memory buffer
    procedure BSONWriteString(const name: RawUTF8; value: PUTF8Char; valueLen: integer);
    /// write a binary (BLOB) value
    procedure BSONWrite(const name: RawUTF8; Data: pointer; DataLen: integer); overload;
    /// write an ObjectID value
    procedure BSONWrite(const name: RawUTF8; const value: TBSONObjectID); overload;
    /// write a RegEx value
    procedure BSONWriteRegEx(const name: RawUTF8; const RegEx,Options: RawByteString);
    /// write a data/time value
    procedure BSONWriteDateTime(const name: RawUTF8; const value: TDateTime);
    /// write an element with no value
    // - elemType can be either betNull, betMinKey or betMaxKey
    procedure BSONWrite(const name: RawUTF8; elemtype: TBSONElementType); overload;
    /// write an element with no value
    procedure BSONWrite(const name: RawUTF8; const elem: TBSONElement); overload;
    /// write a BSONVariant instance value
    procedure BSONWrite(const name: RawUTF8; const bson: TBSONVariantData); overload;
    /// write a DocVariant instance value
    procedure BSONWrite(const name: RawUTF8; const doc: TDocVariantData); overload;
    /// write a TDecimal128 value
    procedure BSONWrite(const name: RawUTF8; const value: TDecimal128); overload;
    /// write a variant value
    // - handle simple types (numbers, strings...) and custom types (TDocVariant
    // and TBSONVariant, trying a translation to JSON for other custom types)
    procedure BSONWriteVariant(const name: RawUTF8; const value: variant); overload;
    /// write an open array (const Args: array of const) argument
    // - handle simple types (numbers, strings...) and custom types (TDocVariant)
    procedure BSONWrite(const name: RawUTF8; const value: TVarRec); overload;
    /// write a value from the supplied JSON content
    // - is able to handle any kind of values, including nested documents or
    // BSON extended syntax (if DoNotTryExtendedMongoSyntax=false)
    // - this method is used recursively by BSONWriteDocFromJSON(), and should
    // not be called directly
    // - will return JSON=nil in case of unexpected error in the supplied JSON
    procedure BSONWriteFromJSON(const name: RawUTF8; var JSON: PUTF8Char;
      EndOfObject: PUTF8Char; DoNotTryExtendedMongoSyntax: boolean=false);

    /// recursive writing of a BSON document or value from a TDocVariant
    // object or array, used e.g. by BSON(const doc: TDocVariantData) function
    // - caller should execute BSONAdjustDocumentsSize() on the resulting buffer
    // - this method will call BSONDocumentBegin/BSONDocumentEnd internally
    // - will raise an EBSONException if doc is not a valid TDocVariant or null
    // or if the resulting binary content is bigger than BSON_MAXDOCUMENTSIZE
    procedure BSONWriteDoc(const doc: TDocVariantData);
    /// write an object specified as name/value pairs as a BSON document
    // - data must be supplied two by two, as Name,Value pairs, e.g.
    // ! aBSONWriter.BSONWriteObject(['name','John','year',1972]);
    // - this method wil be faster than using a BSONWriteDoc(_ObjFast(...))
    procedure BSONWriteObject(const NameValuePairs: array of const);
    /// write a projection specified as fieldname:1 pairs as a BSON document
    procedure BSONWriteProjection(const FieldNamesCSV: RawUTF8);
    /// write an object as query parameter
    // - will handle all SQL operators, including IN (), IS NULL or LIKE
    // - see @http://docs.mongodb.org/manual/reference/operator/query
    // - inverted should be TRUE e.g. for a NOT ... expression
    // - returns TRUE on success, FALSE if the operator is not implemented yet
    function BSONWriteQueryOperator(name: RawUTF8; inverted: boolean;
      operator: TSynTableStatementOperator; const Value: variant): boolean;
    /// write one array item, i.e. the ASCII index name as text
    // - only one level of array should be used per TBSONWriter class
    procedure BSONWriteArray(const kind: TBSONElementType); overload;
    /// write an array specified as a list of items as a BSON document
    // - data must be supplied as a list of values e.g.
    // ! aBSONWriter.BSONWriteArray(['John',1972]);
    // - this method wil be faster than using a BSONWriteDoc(_ArrFast(...))
    procedure BSONWriteArray(const Items: array of const); overload;
    /// write an array of integers as a BSON Document
    procedure BSONWriteArrayOfInteger(const Integers: array of integer);
    /// write an array of integers as a BSON Document
    procedure BSONWriteArrayOfInt64(const Integers: array of Int64);
    /// write some BSON document from a supplied (extended) JSON array or object
    // - warning: the incoming JSON buffer will be modified in-place: so you
    // should make a private copy before running this method (see e.g. TSynTempBuffer)
    // - will handle only '{ ... }', '[ ... ]' or 'null' input, with the standard
    // strict JSON format, or BSON-like extensions, e.g. unquoted field names:
    // $ {id:10,doc:{name:"John",birthyear:1972}}
    // - if DoNotTryExtendedMongoSyntax is default FALSE, then the MongoDB Shell
    // syntax will also be recognized to create BSON custom types, like
    // $ new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
    // see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
    // $ {id:new ObjectId(),doc:{name:"John",date:ISODate()}}
    // $ {name:"John",field:/acme.*corp/i}
    // - if DoNotTryExtendedMongoSyntax is TRUE, process may be slightly faster
    // - will create the BSON binary without any temporary TDocVariant storage
    function BSONWriteDocFromJSON(JSON: PUTF8Char; aEndOfObject: PUTF8Char;
      out Kind: TBSONElementType; DoNotTryExtendedMongoSyntax: boolean=false): PUTF8Char;

    /// to be called before a BSON document will be written
    // - each BSONDocumentBegin should be followed by its nested BSONDocumentEnd
    procedure BSONDocumentBegin; overload;
    /// to be called before a BSON document will be written
    // - each BSONDocumentBegin should be followed by its nested BSONDocumentEnd
    // - you could create a new BSON object by specifying a name and its
    // type, i.e. either betDoc or betArray
    procedure BSONDocumentBegin(const name: RawUTF8; kind: TBSONElementType=betDoc); overload;
    /// to be called before a BSON document will be written in an array
    // - only one level of array should be used per TBSONWriter class
    procedure BSONDocumentBeginInArray(const name: RawUTF8; kind: TBSONElementType=betDoc);
    /// to be called when a BSON document has been written
    // - it will store the current stream position into an internal array,
    // which will be written when you call AdjustDocumentsSize()
    // - you can optional specify how many nested documents should be closed,
    // and/or if it should not write an ending betEof item
    procedure BSONDocumentEnd(CloseNumber: integer=1; WriteEndingZero: boolean=true);
    /// after all content has been written, call this method on the resulting
    // memory buffer to store all document size as expected by the standard
    procedure BSONAdjustDocumentsSize(BSON: PByteArray); virtual;
    /// flush the content and return the whole binary encoded stream
    // - call BSONAdjustDocumentsSize() to adjust all internal document sizes
    // - expect the TBSONWriter instance to have been created as such:
    // ! TBSONWriter.Create(TRawByteStringStream);
    procedure ToBSONDocument(var result: TBSONDocument); virtual;
    /// flush the content and return the whole document as a TBSONVariant
    // - call ToBSONDocument() to adjust all internal document sizes
    // - expect the TBSONWriter instance to have been created as such:
    // ! TBSONWriter.Create(TRawByteStringStream);
    procedure ToBSONVariant(var result: variant; Kind: TBSONElementType=betDoc);
  end;


const
  /// fake BSON element type which compares lower than all other possible values
  // - element type sounds to be stored as shortint, so here $ff=-1<0=betEOF
  betMinKey = TBSONElementType($ff);
  /// fake BSON element type which compares higher than all other possible values
  // - element type sounds to be stored as shortint, so here betInt64=$12<$7f
  betMaxKey = TBSONElementType($7f);

  /// kind of elements which will store a RawByteString/RawUTF8 content
  // within its TBSONVariant kind
  // - i.e. TBSONVariantData.VBlob/VText field is to be managed
  BSON_ELEMENTVARIANTMANAGED =
   [betBinary, betDoc, betArray, betRegEx, betDeprecatedDbptr, betTimeStamp,
    betJSScope, betJS, betDeprecatedSymbol, betDecimal128];

  /// by definition, maximum MongoDB document size is 16 MB
  BSON_MAXDOCUMENTSIZE = 16*1024*1024;

  /// special JSON string content which will be used to store a betDeprecatedUndefined item
  // - *[false] is for strict JSON, *[true] for MongoDB Extended JSON
  BSON_JSON_UNDEFINED: array[boolean] of string[23] =
    ('{"$undefined":true}','undefined');
  /// special JSON string content which will be used to store a betMinKey item
  // - *[false] is for strict JSON, *[true] for MongoDB Extended JSON
  BSON_JSON_MINKEY: array[boolean] of string[15] = ('{"$minKey":1}','MinKey');
  /// special JSON string content which will be used to store a betMaxKey item
  // - *[false] is for strict JSON, *[true] for MongoDB Extended JSON
  BSON_JSON_MAXKEY: array[boolean] of string[15] = ('{"$maxKey":1}','MaxKey');
  /// special JSON patterns which will be used to format a betObjectID item
  // - *[false,*] is to be written before the hexadecimal ID, *[true,*] after
  BSON_JSON_OBJECTID: array[boolean,TMongoJSONMode] of string[15] = (
    ('"','{"$oid":"','ObjectId("'),('"','"}','")'));
  /// special JSON patterns which will be used to format a betBinary item
  // - *[false,*] is for strict JSON, *[true,*] for MongoDB Extended JSON
  BSON_JSON_BINARY: array[boolean,boolean] of string[15] = (
    ('{"$binary":"','","$type":"'),('BinData(',',"'));
  /// special JSON string content which will be used to store a betDeprecatedDbptr
  // - *[false,*] is for strict JSON, *[true,*] for MongoDB Extended JSON
  // - (not used by now for this deprecated content)
  BSON_JSON_DBREF: array[boolean,0..2] of string[15] = (
    ('{"$ref":"','","$id":"','"}'),('DBRef("','","','")'));
  /// special JSON string content which will be used to store a betRegEx
  BSON_JSON_REGEX: array[0..2] of string[15] =
    ('{"$regex":"','","$options":"','"}');
  /// special JSON patterns which will be used to format a betDateTime item
  // - *[*,false] is to be written before the date value, *[*,true] after
  BSON_JSON_DATE: array[TMongoJSONMode,boolean] of string[15] = (
    ('"','"'),('{"$date":"','"}'),('ISODate("','")'));
  /// special JSON patterns which will be used to format a betDecimal128 item
  // - *[false,*] is to be written before the decimal value, *[true,*] after
  BSON_JSON_DECIMAL: array[boolean,TMongoJSONMode] of string[23] = (
    ('"','{"$numberDecimal":"','NumberDecimal("'),('"','"}','")'));

var
  /// global TCustomVariantType used to register BSON variant types
  // - if you use this unit, both TDocVariant and TBSONVariant custom types
  // will be registered, since they are needed for any MongoDB / BSON process
  BSONVariantType: TBSONVariant;

/// ready-to-be displayed text of a TBSONElementType value
function ToText(kind: TBSONElementType): PShortString; overload;

/// create a TBSONVariant custom variant type containing a BSON Object ID
// - will be filled with some unique values, ready to create a new document key
// - will store a BSON element of betObjectID kind
function ObjectID: variant; overload;

/// create a TBSONVariant Object ID custom variant type from a supplied text
// - will raise an EBSONException if the supplied text is not valid hexadecimal
// - will set a BSON element of betObjectID kind
function ObjectID(const Hexa: RaWUTF8): variant; overload;

/// convert a TBSONVariant Object ID custom variant into a TBSONObjectID
// - raise an exception if the supplied variant is not a TBSONVariant Object ID
function BSONObjectID(const aObjectID: variant): TBSONObjectID;

/// create a TBSONVariant JavaScript custom variant type from a supplied code
// - will set a BSON element of betJS kind
function JavaScript(const JS: RawUTF8): variant; overload;

/// create a TBSONVariant JavaScript and associated scope custom variant type
// from a supplied code and document
// - will set a BSON element of betJSScope kind
function JavaScript(const JS: RawUTF8; const Scope: TBSONDocument): variant; overload;

/// create a TBSONVariant Decimal128 from some text corresponding to
// a floating-point number
// - will store internally a TDecimal128 storage
function NumberDecimal(const Value: RawUTF8): variant; overload;

/// create a TBSONVariant Decimal128 from a currency fixed decimal
// - will store internally a TDecimal128 storage, with explictly 4 decimals
// - if you want to store some floating-point value, use plain BSON double format
function NumberDecimal(const Value: currency): variant; overload;

/// store some object content into BSON encoded binary
// - object will be initialized with data supplied two by two, as Name,Value
// pairs, e.g.:
// ! aBson := BSON(['name','John','year',1972]);
// - you can define nested arrays or objects as TDocVariant, e.g:
// ! aBSON := BSON(['bsonDat',_Arr(['awesome',5.05, 1986])]);
// - or you can specify nested arrays or objects with '['..']' or '{'..'}':
// ! aBSON := BSON(['BSON','[','awesome',5.05,1986,']'])
// ! u := BSONToJSON(BSON(['doc','{','name','John','year',1982,'}','id',123]));
// ! assert(u='{"doc":{"name":"John","year":1982},"id":123}');
// ! u := BSONToJSON(BSON(['doc','{','name','John','abc','[','a','b','c',']','}','id',123]));
// ! assert(u='{"doc":{"name":"John","abc":["a","b","c"]},"id":123}');
// - will create the BSON binary without any temporary TDocVariant storage
function BSON(const NameValuePairs: array of const): TBSONDocument; overload;

/// create a fields selector BSON document from a field names list
// - can be used via a TBSONVariant instance for the projection parameter of
// a TMongoRequestQuery, e.g.:
// ! BSONToJSON(BSONFieldSelector(['a','b','c']))='{"a":1,"b":1,"c":1}'
function BSONFieldSelector(const FieldNames: array of RawUTF8): TBSONDocument; overload;

/// create a fields selector BSON document from a CSV field names list
// - can be used via a TBSONVariant instance for the projection parameter of
// a TMongoRequestQuery, e.g.:
// ! BSONToJSON(BSONFieldSelector('a,b,c'))='{"a":1,"b":1,"c":1}'
function BSONFieldSelector(const FieldNamesCSV: RawUTF8): TBSONDocument; overload;

/// store some object content, supplied as (extended) JSON, into BSON encoded binary
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names:
// ! BSON('{id:10,doc:{name:"John",birthyear:1972}}');
// - MongoDB Shell syntax will also be recognized to create TBSONVariant, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// ! BSON('{id:new ObjectId(),doc:{name:"John",date:ISODate()}}');
// ! BSON('{name:"John",field:/acme.*corp/i}');
// - will create the BSON binary without any temporary TDocVariant storage, by
// calling JSONBufferToBSONDocument() on a temporary copy of the supplied JSON
function BSON(const JSON: RawUTF8; kind: PBSONElementType=nil): TBSONDocument; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// store some object content, supplied as (extended) JSON and parameters,
// into BSON encoded binary
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names
// - MongoDB Shell syntax will also be recognized to create TBSONVariant, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// - typical use could be:
// ! BSON('{%:{$in:[?,?]}}',['type'],['food','snack']);
// ! BSON('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
// ! BSON('{%:[?,?,?]}',['BSON'],['awesome',5.05,1986])
// ! BSON('{%:?}',['BSON'],[_Arr(['awesome',5.05,1986])])
// ! BSON('{name:?,field:/%/i}',['acme.*corp'],['John']);
// ! BSON('{id:new ObjectId(),doc:{name:?,date:ISODate(?)}}',[],['John',NowUTC]);
// - will create the BSON binary without any temporary TDocVariant storage,
// by calling JSONBufferToBSONDocument() on the generated JSON content
// - since all content will be transformed into JSON internally, use this
// method only if the supplied parameters are simple types, and identified
// explicitely via BSON-like extensions: any complex value (e.g. a TDateTime
// or a BSONVariant binary) won't be handled as expected - use the overloaded
// BSON() with explicit BSONVariant() name/value pairs instead
function BSON(const Format: RawUTF8; const Args,Params: array of const;
  kind: PBSONElementType=nil): TBSONDocument; overload;

/// store some TDocVariant custom variant content into BSON encoded binary
// - will write either a BSON object or array, depending of the internal
// layout of this TDocVariantData instance (i.e. Kind property value)
// - if supplied variant is not a TDocVariant, raise an EBSONException
function BSON(const doc: TDocVariantData): TBSONDocument; overload;

/// store an array of integer into BSON encoded binary
// - object will be initialized with data supplied e.g. as a TIntegerDynArray
function BSONFromIntegers(const Integers: array of integer): TBSONDocument;

/// store an array of 64 bit integer into BSON encoded binary
// - object will be initialized with data supplied e.g. as a TIntegerDynArray
function BSONFromInt64s(const Integers: array of Int64): TBSONDocument;

/// store some object content, supplied as (extended) JSON into BSON binary
// - warning: the supplied JSON buffer will be modified in-place, if necessary:
// so you should create a temporary copy before calling this function, or call
// BSON(const JSON: RawUTF8) function instead
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names
// - if DoNotTryExtendedMongoSyntax is FALSE, then MongoDB Shell syntax will
// also be recognized to create BSON custom values, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// ! BSON('{id:new ObjectId(),doc:{name:"John",date:ISODate()}}');
// ! BSON('{name:"John",field:/acme.*corp/i}');
// - will create the BSON binary without any temporary TDocVariant storage
// - will return the kind of BSON document created, i.e. either betDoc or betArray
function JSONBufferToBSONDocument(JSON: PUTF8Char; var doc: TBSONDocument;
  DoNotTryExtendedMongoSyntax: boolean=false): TBSONElementType;

/// store one JSON array into an array of BSON binary
// - since BSON documents are limited to 16 MB by design, this function
// will allow to process huge data content, as soon as it is provided as array
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names
// - if DoNotTryExtendedMongoSyntax is FALSE, then MongoDB Shell syntax will
// be recognized to create BSON custom values - but it will be slightly slower
function JSONBufferToBSONArray(JSON: PUTF8Char; out docs: TBSONDocumentDynArray;
  DoNotTryExtendedMongoSyntax: boolean=false): boolean;

/// store some object content into a TBSONVariant betDoc type instance
// - object will be initialized with data supplied two by two, as Name,Value
// pairs, as expected by the corresponding overloaded BSON() function
function BSONVariant(const NameValuePairs: array of const): variant; overload;

/// create a fields selector BSON document from a field names list
// - can be used for the projection parameter of a TMongoRequestQuery, e.g.:
// ! VariantToJSON(BSONVariantFieldSelector(['a','b','c']))='{"a":1,"b":1,"c":1}'
function BSONVariantFieldSelector(const FieldNames: array of RawUTF8): variant; overload;

/// create a fields selector BSON document from a CSV field names list
// - can be used for the projection parameter of a TMongoRequestQuery, e.g.:
// ! VariantToJSON(BSONVariantFieldSelector('a,b,c'))='{"a":1,"b":1,"c":1}'
function BSONVariantFieldSelector(const FieldNamesCSV: RawUTF8): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// store some object content, supplied as (extended) JSON, into a TBSONVariant
// betDoc type instance
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, as with the overloaded BSON() function
function BSONVariant(const JSON: RawUTF8): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// store some object content, supplied as (extended) JSON, into a TBSONVariant
// betDoc type instance
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, as with the overloaded BSON() function
// - warning: this overloaded method will mofify the supplied JSON buffer
// in-place: you can use the overloaded BSONVariant(const JSON: RawUTF8) function
// instead if you do not want to modify the input buffer content
procedure BSONVariant(JSON: PUTF8Char; var result: variant); overload;

/// store some object content, supplied as (extended) JSON and parameters,
// into a TBSONVariant betDoc type instance
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, as with the overloaded BSON() function
function BSONVariant(const Format: RawUTF8; const Args,Params: array of const): variant; overload;

/// convert a TDocVariant variant into a TBSONVariant betDoc type instance
function BSONVariant(doc: TDocVariantData): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// store an array of integer into a TBSONVariant betArray type instance
// - object will be initialized with data supplied e.g. as a TIntegerDynArray
function BSONVariantFromIntegers(const Integers: array of integer): variant;

/// store an array of 64 bit integer into a TBSONVariant betArray type instance
// - object will be initialized with data supplied e.g. as a TIntegerDynArray
function BSONVariantFromInt64s(const Integers: array of Int64): variant;

/// parse the header of a BSON encoded binary buffer, and return its length
// - BSON should point to a "int32 e_list #0" BSON document (like TBSONDocument)
// - if ExpectedBSONLen is set, this function will check that the supplied
// BSON content "int32" length matches the supplied value, and raise an
// EBSONException if this comparison fails
// - as an alternative, consider using TBSONIterator, which wrap both a PByte
// and a TBSONElement into one convenient item
function BSONParseLength(var BSON: PByte; ExpectedBSONLen: integer=0): integer;

/// parse the next element in supplied BSON encoded binary buffer list
// - BSON should point to the "e_list" of the "int32 e_list #0" BSON document
// - will decode the supplied binary buffer as a variant, then it will let BSON
// point to the next element, and return TRUE
// - returns FALSE when you reached betEOF, so that you can use it in a loop:
// ! var bson: PByte;
// !     name: RaWUTF8;
// !     value: variant;
// ! ...
// ! BSONParseLength(bson);
// ! while BSONParseNextElement(bson,name,value) do
// !   writeln(name,':',value);
// - by default, it will return TBSONVariant custom variants for documents or
// arrays - but if storeDocArrayAsDocVariant is set, it will return a
// TDocVariant custom kind of variant, able to access to its nested
// properties via late-binding
// - if you want to parse a BSON list as fast as possible, you should better use
// TBSONElement.FromNext() which avoid any memory allocation (the SAX way) - in
// fact, this function is just a wrapper around TBSONElement.FromNext + ToVariant
// - as an alternative, consider using TBSONIterator, which wrap both a PByte
// and a TBSONElement into one convenient item
function BSONParseNextElement(var BSON: PByte; var name: RawUTF8; var element: variant;
  DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): boolean;

/// search for a property by number in a a supplied BSON encoded binary buffer
// - BSON should point to a "int32 e_list #0" BSON document (like TBSONDocument)
// - returns FALSE if the list has too few elements (starting at index 0)
// - otherwise, returns TRUE then let item point to the corresponding element
function BSONPerIndexElement(BSON: PByte; index: integer; var item: TBSONElement): boolean;

/// convert a BSON document into a TDocVariant variant instance
// - BSON should point to a "int32 e_list #0" BSON document
// - if ExpectedBSONLen is set, this function will check that the supplied
// BSON content "int32" length matches the supplied value
// - by definition, asBSONVariant is not allowed as Option value
procedure BSONToDoc(BSON: PByte; var Result: Variant; ExpectedBSONLen: integer=0;
  Option: TBSONDocArrayConversion=asDocVariantPerReference);

/// convert a TBSONDocument into a TDocVariant variant instance
// - BSON should be valid BSON document (length will be checked against expected
// "int32 e_list #0" binary layout)
// - by definition, asBSONVariant is not allowed as Option value
function BSONDocumentToDoc(const BSON: TBSONDocument;
  Option: TBSONDocArrayConversion=asDocVariantPerReference): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a BSON document into its JSON representation
// - BSON should point to a "int32 e_list #0" BSON document
// - Kind should be either betDoc or betArray
// - if ExpectedBSONLen is set, this function will check that the supplied
// BSON content "int32" length matches the supplied value
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
function BSONToJSON(BSON: PByte; Kind: TBSONElementType;
   ExpectedBSONLen: integer=0; Mode: TMongoJSONMode=modMongoStrict): RawUTF8;

/// convert a TBSONDocument into its JSON representation
// - BSON should be valid BSON document (length will be checked against expected
// "int32 e_list #0" binary layout)
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
function BSONDocumentToJSON(const BSON: TBSONDocument;
  Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a BSON list of elements into its JSON representation
// - BSON should point to the "e_list" of the "int32 e_list #0" BSON document,
// i.e. the item data as expected by TBSONElement.FromNext()
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
procedure BSONListToJSON(BSONList: PByte; Kind: TBSONElementType; W: TTextWriter;
  Mode: TMongoJSONMode=modMongoStrict);

/// convert any kind of BSON/JSON element, encoded as variant, into JSON
// - this function will use by default the MongoDB Extended JSON syntax for
// specific MongoDB objects but you may use modMongoShell if needed
procedure AddMongoJSON(const Value: variant; W: TTextWriter;
  Mode: TMongoJSONMode=modMongoStrict); overload;

/// convert any kind of BSON/JSON element, encoded as variant, into JSON
// - in addition to default modMongoStrict as rendered by VariantSaveJSON(),
// this function can render the supplied variant with the Mongo Shell syntax
// or even raw JSON content
function VariantSaveMongoJSON(const Value: variant; Mode: TMongoJSONMode): RawUTF8;




{ ************ MongoDB Client }

const
  /// MongoDB server default IP port
  MONGODB_DEFAULTPORT = 27017;

type
  /// exception type used for MongoDB process
  EMongoException = class(ESynException);

  /// the available MongoDB driver Request Opcodes
  // - opReply: database reply to a client request - ResponseTo shall be set
  // - opMsg: generic msg command followed by a string (deprecated)
  // - opUpdate: update document
  // - opInsert: insert new document
  // - opQuery: query a collection
  // - opGetMore: get more data from a previous query
  // - opDelete: delete documents
  // - opKillCursors: notify database client is done with a cursor
  TMongoOperation = (
    opReply, opMsg, opUpdate, opInsert, opQuery, opGetMore, opDelete, opKillCursors);

  /// define how an opUpdate operation will behave
  // - if mufUpsert is set, the database will insert the supplied object into
  // the collection if no matching document is found
  // - if mufMultiUpdate is set, the database will update all matching objects
  // in the collection; otherwise (by default) only updates first matching doc
  TMongoUpdateFlag =
    (mufUpsert, mufMultiUpdate);

  /// define how a TMongoRequestUpdate message will behave
  TMongoUpdateFlags = set of TMongoUpdateFlag;

  /// define how an opInsert operation will behave
  // - if mifContinueOnError is set, the database will not stop processing a
  // bulk insert if one fails (e.g. due to duplicate IDs); this makes bulk
  // insert behave similarly to a series of single inserts, except lastError
  // will be set if any insert fails, not just the last one - if multiple
  // errors occur, only the most recent will be reported by getLastError
  TMongoInsertFlag =
    (mifContinueOnError);

  /// define how a TMongoRequestInsert message will behave
  TMongoInsertFlags = set of TMongoInsertFlag;

  /// define how an opDelete operation will behave
  // - if mdfSingleRemove is set, the database will remove only the first
  // matching document in the collection. Otherwise (by default) all matching
  // documents will be removed
  TMongoDeleteFlag =
    (mdfSingleRemove);

  /// define how a TMongoRequestDelete message will behave
  TMongoDeleteFlags = set of TMongoDeleteFlag;

  /// define how an opQuery operation will behave
  // - if mqfTailableCursor is set, cursor is not closed when the last data
  // is retrieved
  // - if mqfSlaveOk is set, it will allow query of replica slave; normally
  // this returns an error except for namespace "local"
  // - mqfOplogReplay is internal replication use only - driver should not set
  // - if mqfNoCursorTimeout is set, the server normally does not times out
  // idle cursors after an inactivity period (10 minutes) to prevent
  // excess memory use
  // - if mqfAwaitData is to use with TailableCursor. If we are at the end
  // of the data, block for a while rather than returning no data. After a
  // timeout period, we do return as normal
  // - if mqfExhaust is set, stream the data down full blast in multiple "more"
  // packages, on the assumption that the client will fully read all data queried
  // - if mqfPartial is set, it will get partial results from a mongos if
  // some shards are down (instead of throwing an error)
  TMongoQueryFlag =
    (mqfTailableCursor=1, mqfSlaveOk, mqfOplogReplay, mqfNoCursorTimeout,
     mqfAwaitData, mqfExhaust, mqfPartial);

  /// define how a TMongoRequestQuery message will behave
  TMongoQueryFlags = set of TMongoQueryFlag;

  /// abstract class used to create MongoDB Wire Protocol client messages
  // - see http://docs.mongodb.org/meta-driver/latest/legacy/mongodb-wire-protocol
  // - this class is not tight to the connection class itself (which is one
  // known limitation of TMongoWire for instance)
  TMongoRequest = class(TBSONWriter)
  protected
    fRequestID: integer;
    fResponseTo: integer;
    fRequestOpCode: TMongoOperation;
    fDatabaseName,
    fCollectionName,
    fFullCollectionName: RawUTF8;
    fBSONDocument: TBSONDocument;
  public
    /// write a standard Message Header for MongoDB client
    // - opCode is the type of the message
    // - requestID  is a client or database-generated identifier that uniquely
    // identifies this message: in case of opQuery or opGetMore messages, it will
    // be sent in the responseTo field from the database
    // - responseTo is the requestID taken from previous opQuery or opGetMore
    constructor Create(const FullCollectionName: RawUTF8;
      opCode: TMongoOperation; requestID, responseTo: Integer); reintroduce;
    /// append a query parameter as a BSON document
    // - param can be a TDocVariant, e.g. created with:
    // ! _JsonFast('{name:"John",age:{$gt:21}}');
    // ! _JsonFastFmt('{name:?,age:{$gt:?}}',[],['John',21]);
    // ! _JsonFastFmt('{name:?,field:/%/i}',['acme.*corp'],['John']);
    // - param can be a TBSONVariant containing a TBSONDocument raw binary block
    // created e.g. from:
    // ! BSONVariant(['BSON',_Arr(['awesome',5.05, 1986])])
    // ! BSONVariantType[BSON(['BSON',_Arr(['awesome',5.05, 1986])])]
    // - if param is null, it will append a void document
    // - if param is a string, it will be converted as expected by most
    // database commands, e.g.
    // ! TMongoRequestQuery.Create('admin.$cmd','buildinfo',[],1)
    // will query   { buildinfo: 1 }  to the  admin.$cmd  collection, i.e.
    // $ admin.$cmd.findOne( { buildinfo: 1 } )
    procedure BSONWriteParam(const paramDoc: variant);
    /// flush the content and return the whole binary encoded stream
    // - expect the TBSONWriter instance to have been created with reintroduced
    // Create() specific constructors inheriting from this TMongoRequest class
    // - this overridden version will adjust the size in the message header
    procedure ToBSONDocument(var result: TBSONDocument); override;
    /// write the main parameters of the request as JSON
    procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); overload; virtual;
    /// write the main parameters of the request as JSON
    function ToJSON(Mode: TMongoJSONMode): RawUTF8; overload;
    /// identify the message, after call to any reintroduced Create() constructor
    property MongoRequestID: integer read fRequestID;
    /// the associated full collection name, e.g. 'db.test'
    property FullCollectionName: RawUTF8 read fFullCollectionName;
    /// the associated full collection name, e.g. 'db'
    property DatabaseName: RawUTF8 read fDatabaseName;
    /// the associated full collection name, e.g. 'test'
    property CollectionName: RawUTF8 read fCollectionName;
    /// the message operation code
    // - should be either opUpdate, opInsert, opQuery, opGetMore, opDelete
    // or opKillCursors, depending on the TMongoRequest* class instantiated
    property MongoRequestOpCode: TMongoOperation read fRequestOpCode;
  end;

  /// a MongoDB client abstract ancestor which is able to create a BULK
  // command message for MongoDB >= 2.6 instead of older dedicated Wire messages
  TMongoRequestWritable = class(TMongoRequest)
  protected

  public
  end;

  /// a MongoDB client message to update a document in a collection
  TMongoRequestUpdate = class(TMongoRequestWritable)
  protected
    fSelector, fUpdate: TVarData;
  public
    /// initialize a MongoDB client message to update a document in a collection
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - how the update will be processed can be customized via Flags
    // - Selector is the BSON document query to select the document, supplied as
    // TDocVariant - i.e. created via _JsonFast() or _JsonFastFmt() - or as
    // TBSONVariant - i.e. created via BSONVariant() - or null if all documents
    // are to be updated
    // - Update is the BSON document specification of the update to perform,
    // supplied as TDocVariant or TBSONVariant
    // - there is no response to an opUpdate message
    constructor Create(const FullCollectionName: RawUTF8;
      const Selector, Update: variant; Flags: TMongoUpdateFlags=[]); reintroduce;
    /// write the main parameters of the request as JSON
    procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
  end;

  /// a MongoDB client message to insert one or more documents in a collection
  TMongoRequestInsert = class(TMongoRequestWritable)
  public
    /// initialize a MongoDB client message to insert one or more documents in
    // a collection, supplied as variants
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - Documents is an array of TDocVariant or TBSONVariant - i.e. created via
    // _JsonFast() _JsonFastFmt() or BSONVariant()
    // - there is no response to an opInsert message
    constructor Create(const FullCollectionName: RawUTF8;
      const Documents: array of variant; Flags: TMongoInsertFlags=[]); reintroduce; overload;
    /// initialize a MongoDB client message to insert one or more documents in
    // a collection, supplied as raw BSON binary
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - Documents is the low-level concatenation of BSON documents, created
    // e.g. with a TBSONWriter stream
    // - there is no response to an opInsert message
    constructor Create(const FullCollectionName: RawUTF8;
      const Documents: TBSONDocument; Flags: TMongoInsertFlags=[]); reintroduce; overload;
    /// initialize a MongoDB client message to insert one or more documents in
    // a collection, supplied as JSON objects
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - JSONDocuments is an array of JSON objects
    // - there is no response to an opInsert message
    constructor Create(const FullCollectionName: RawUTF8;
      const JSONDocuments: array of PUTF8Char; Flags: TMongoInsertFlags=[]); reintroduce; overload;
  end;

  /// a MongoDB client message to delete one or more documents in a collection
  TMongoRequestDelete = class(TMongoRequestWritable)
  protected
    fQuery: TVarData;
  public
    /// initialize a MongoDB client message to delete one or more documents in
    // a collection
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - Selector is the BSON document query to select the document, supplied as
    // TDocVariant - i.e. created via _JsonFast() or _JsonFastFmt() - or as
    // TBSONVariant - i.e. created via BSONVariant() - or null if all documents
    // are to be deleted
    // - warning: CreateDelete('db.coll',null) can be expensive so you should
    // better drop the whole collection
    // - there is no response to an opDelete message
    constructor Create(const FullCollectionName: RawUTF8;
      const Selector: variant; Flags: TMongoDeleteFlags=[]); reintroduce;
    /// write the main parameters of the request as JSON
    procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
  end;

  /// a MongoDB client message to query one or more documents in a collection
  TMongoRequestQuery = class(TMongoRequest)
  protected
    fNumberToReturn,fNumberToSkip: integer;
    fQuery, fReturnFieldsSelector: TVarData;
  public
    /// initialize a MongoDB client message to query one or more documents in
    // a collection from a specified Cursor identifier
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - Query is the BSON document query to select the document, supplied as
    // TDocVariant - i.e. created via _JsonFast() or _JsonFastFmt() - or null
    // if all documents are to be retrieved - for instance:
    // ! _JsonFast('{name:"John",age:{$gt:21}}');
    // ! _JsonFastFmt('{name:?,age:{$gt:?}}',[],['John',21]);
    // ! _JsonFastFmt('{name:?,field:/%/i}',['acme.*corp'],['John']);
    // - if Query is a string, it will be converted as expected by most
    // database commands, e.g.
    // $ TMongoRequestQuery.Create('admin.$cmd','buildinfo',[],1)
    // will query   { buildinfo: 1 }  to the  admin.$cmd  collection, i.e.
    // $ admin.$cmd.findOne( { buildinfo: 1 } )
    // - Query can also be a TBSONVariant, e.g. created with:
    // ! BSONVariant('{name:?,age:{$gt:?}}',[],['John',21])
    // - ReturnFieldsSelector is an optional selector (set to null if not
    // applicable) as a BSON document that limits the fields in the returned
    // documents, supplied as TDocVariant or TBSONVariant - e.g. created via:
    // ! BSONVariantFieldSelector('a,b,c');
    // ! BSONVariantFieldSelector(['a','b','c']);
    // ! BSONVariant('{a:1,b:1,c:1}');
    // ! _JsonFast('{a:1,b:1,c:1}');
    // - if ReturnFieldsSelector is a string, it will be converted into
    // $ { ReturnFieldsSelector: 1 }
    constructor Create(const FullCollectionName: RawUTF8;
      const Query, ReturnFieldsSelector: variant; NumberToReturn: integer;
      NumberToSkip: Integer=0; Flags: TMongoQueryFlags=[]); reintroduce;
    /// write the main parameters of the request as JSON
    procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
    /// retrieve the NumberToReturn parameter as set to the constructor
    property NumberToReturn: integer read fNumberToReturn;
    /// retrieve the NumberToSkip parameter as set to the constructor
    property NumberToSkip: integer read fNumberToSkip;
  end;

  /// a MongoDB client message to continue the query of one or more documents
  // in a collection, after a TMongoRequestQuery message
  TMongoRequestGetMore = class(TMongoRequest)
  public
    /// initialize a MongoDB client message to continue the query of one or more
    // documents in a collection, after a opQuery / TMongoRequestQuery message
    // - FullCollectionName is e.g. 'dbname.collectionname'
    // - you can specify the number of documents to return (e.g. from previous
    // opQuery response)
    // - CursorID should have been retrieved within an opReply message from the
    // database
    constructor Create(const FullCollectionName: RawUTF8;
      NumberToReturn: integer; CursorID: Int64); reintroduce;
  end;

  /// a MongoDB client message to close one or more active cursors
  TMongoRequestKillCursor = class(TMongoRequest)
  protected
    fCursors: TInt64DynArray;
  public
    /// initialize a MongoDB client message to close one or more active cursors
    // in the database
    // - it is mandatory to ensure that database resources are reclaimed by
    // the client at the end of the query
    // - if a cursor is read until exhausted (read until opQuery or opGetMore
    // returns zero for the CursorId), there is no need to kill the cursor
    // - there is no response to an opKillCursor message
    constructor Create(const FullCollectionName: RawUTF8;
      const CursorIDs: array of Int64); reintroduce;
    /// write the main parameters of the request as JSON
    procedure ToJSON(W: TTextWriter; Mode: TMongoJSONMode); override;
  end;


  /// used to store the binary raw data a database response to a
  // TMongoRequestQuery / TMongoRequestGetMore client message
  TMongoReply = RawByteString;

  /// define an opReply message execution content
  // - mrfCursorNotFound will be set when getMore is called but the cursor id
  // is not valid at the server; returned with zero results
  // - mrfQueryFailure is set when the query failed - results consist of one
  // document containing an "$err" field describing the failure
  // - mrfShardConfigStale should not be used by client, just by Mongos
  // - mrfAwaitCapable is set when the server supports the AwaitData Query
  // option (always set since Mongod version 1.6)
  TMongoReplyCursorFlag = (
    mrfCursorNotFound, mrfQueryFailure, mrfShardConfigStale,
    mrfAwaitCapable);

  /// define a TMongoReplyCursor message execution content
  TMongoReplyCursorFlags = set of TMongoReplyCursorFlag;

  /// internal low-level binary structure mapping the TMongoReply header
  // - used e.g. by TMongoReplyCursor and TMongoConnection.GetReply()
  TMongoReplyHeader = packed record
    /// total message length, including the header
    MessageLength: integer;
    /// identifier of this message
    RequestID: integer;
    /// retrieve the RequestID from the original request
    ResponseTo: integer;
    /// low-level code of the message
    OpCode: integer;
    /// response flags
    ResponseFlags: integer;
    /// cursor identifier if the client may need to perform further opGetMore
    CursorID: Int64;
    /// where in the cursor this reply is starting
    StartingFrom: integer;
    /// number of documents in the reply
    NumberReturned: integer;
  end;

  /// points to an low-level binary structure mapping the TMongoReply header
  // - so that you can write e.g.
  // ! PMongoReplyHeader(aMongoReply)^.RequestID
  PMongoReplyHeader = ^TMongoReplyHeader;


  /// map a MongoDB server reply message as sent by the database
  // - in response to TMongoRequestQuery / TMongoRequestGetMore messages
  // - you can use the record's methods to retrieve information about a given
  // response, and navigate within all nested documents
  // - several TMongoReplyCursor instances may map the same TMongoReply content
  // - you can safely copy one TMongoReplyCursor instance to another
  {$ifndef UNICODE}
  TMongoReplyCursor = object
  protected
  {$else}
  TMongoReplyCursor = record
  private
  {$endif}
    fReply: TMongoReply;
    fRequestID: integer;
    fResponseTo: integer;
    fResponseFlags: TMongoReplyCursorFlags;
    fCursorID: Int64;
    fStartingFrom: integer;
    fNumberReturned: integer;
    fDocuments: TPointerDynArray;
    fCurrentPosition: integer;
    fFirstDocument,
    fCurrentDocument: PAnsiChar;
    fLatestDocIndex: integer;
    fLatestDocValue: variant;
    procedure ComputeDocumentsList;
    function GetOneDocument(index: integer): variant;
  public
    /// initialize the cursor with a supplied binary reply from the server
    // - will raise an EMongoException if the content is not valid
    // - will populate all record fields with the supplied data
    procedure Init(const ReplyMessage: TMongoReply);

    /// retrieve the next document in the list, as a TDocVariant instance
    // - return TRUE if the supplied document has been retrieved
    // - return FALSE if there is no more document to get - you can use the
    // Rewind method to restart from the first document
    // - could be used e.g. as:
    // ! var Reply: TMongoReply;
    // !     doc: variant;
    // ! ...
    // !   Reply.Init(ResponseMessage);
    // !   while Reply.Next(doc) do
    // !      writeln('Name: ',doc.Name,' FirstName: ',doc.FirstName);
    function Next(out doc: variant; option: TBSONDocArrayConversion=asDocVariantPerReference): boolean; overload;
    /// retrieve the next document in the list, as BSON content
    // - return TRUE if the supplied document has been retrieved - then doc
    // points to a "int32 e_list #0" BSON document
    // - return FALSE if there is no more document to get - you can use the
    // Rewind method to restart from the first document
    // - this method is almost immediate, since the BSON raw binary is returned
    // directly without any conversion
    // - could be used e.g. as:
    // ! var Reply: TMongoReply;
    // !     doc: PByte;
    // ! ...
    // !   Reply.Init(ResponseMessage);
    // !   while Reply.Next(doc) do
    // !     writeln(BSONToJSON(doc,0,modMongoShell)); // fast display
    function Next(out doc: PByte): boolean; overload;
    /// retrieve the next document in the list, as a BSON binary document
    // - return TRUE if the supplied document has been retrieved - then doc
    // points to a "int32 e_list #0" BSON document
    // - return FALSE if there is no more document to get - you can use the
    // Rewind method to restart from the first document
    // - this method is slightly slower than the one returning a PByte, since
    // it will allocate a memory buffer to store the TBSONDocument binary
    // - could be used e.g. as:
    // ! var Reply: TMongoReply;
    // !     doc: TBSONDocument;
    // ! ...
    // !   Reply.Init(ResponseMessage);
    // !   while Reply.Next(doc) do
    // !     writeln(BSONToJSON(doc,0,modMongoShell)); // fast display
    function Next(out BSON: TBSONDocument): boolean; overload;
    /// retrieve the next document in the list, as JSON content
    // - return TRUE if the supplied document has been retrieved
    // - return FALSE if there is no more document to get - you can use the
    // Rewind method to restart from the first document
    // - could be used e.g. as:
    // ! var Reply: TMongoReply;
    // !     json: RawUTF8;
    // ! ...
    // !   Reply.Init(ResponseMessage);
    // !   while Reply.Next(json,modMongoShell) do
    // !     writeln(json); // fast display
    function Next(out JSON: RawUTF8; Mode: TMongoJSONMode=modMongoStrict): boolean; overload;
    /// let Next() overloaded methods point to the first document of this message
    procedure Rewind;

    /// retrieve a given document as a TDocVariant instance
    // - this method won't use any cache (like Document[..] property), since
    // it should be used with a local variant on stack as cache:
    // ! var Reply: TMongoReply;
    // !     doc: variant;
    // !     i: integer;
    // ! ...
    // !   Reply.Init(ResponseMessage);
    // !   for i := 0 to Reply.DocumentCount-1 do begin
    // !      GmrfQueryFailureetDocument(i,doc);
    // !      writeln('Name: ',doc.Name,' FirstName: ',doc.FirstName);
    // !   end;
    procedure GetDocument(index: integer; var result: variant);
    /// return all documents content as a JSON array, or one JSON object
    // if there is only one document in this reply
    // - this method is very optimized and will convert the BSON binary content
    // directly into JSON
    procedure FetchAllToJSON(W: TTextWriter; Mode: TMongoJSONMode=modMongoStrict;
      WithHeader: boolean=false; MaxSize: Cardinal=0);
    /// return all documents content as a JSON array, or one JSON object
    // if there is only one document in this reply
    // - this method is very optimized and will convert the BSON binary content
    // directly into JSON
    function ToJSON(Mode: TMongoJSONMode=modMongoStrict; WithHeader: boolean=false;
      MaxSize: Cardinal=0): RawUTF8;
    /// append all documents content to a dynamic array of TDocVariant
    // - return the new size of the Dest[] array
    function AppendAllToDocVariantDynArray(var Dest: TVariantDynArray): integer;
    /// append all documents content to a TDocVariant array instance
    // - if the supplied instance if not already a TDocVariant of kind dvArray,
    // a new void instance will be created
    // - return the new size of the Dest array
    function AppendAllToDocVariant(var Dest: TDocVariantData): integer;
    /// append all documents content to a BSON binary stream
    // - Dest.Tag will be used to count the current item number in the resulting
    // BSON array
    procedure AppendAllToBSON(Dest: TBSONWriter);

    /// retrieve the context execution of this message
    property ResponseFlags: TMongoReplyCursorFlags read fResponseFlags;
    /// identifier of this message
    property RequestID: integer read fRequestID;
    /// retrieve the RequestID from the original request
    property ResponseTo: integer read fResponseTo;
    /// access to the low-level binary reply message
    property Reply: TMongoReply read fReply;
    /// cursor identifier if the client may need to perform further
    // TMongoRequestGetMore messages
    // - in the event that the result set of the query fits into one OP_REPLY
    // message, CursorID will be 0
    property CursorID: Int64 read fCursorID;
    /// where in the cursor this reply is starting
    property StartingFrom: integer read fStartingFrom;
    /// number of documents in the reply
    property DocumentCount: Integer read fNumberReturned;
    /// points to the first document binary
    // - i.e. just after the Reply header
    property FirstDocument: PAnsiChar read fFirstDocument;
    /// direct access to the low-level BSON binary content of each document
    property DocumentBSON: TPointerDynArray read fDocuments;
    /// retrieve a given document as a TDocVariant instance
    // - could be used e.g. as:
    // ! var Reply: TMongoReply;
    // !     i: integer;
    // ! ...
    // !   Reply.Init(ResponseMessage);
    // !   for i := 0 to Reply.DocumentCount-1 do
    // !      writeln('Name: ',Reply.Document[i].Name,' FirstName: ',Reply.Document[i].FirstName);
    // - note that there is an internal cache for the latest retrieved document
    // by this property, so that you can call Reply.Document[i] several times
    // without any noticeable speed penalty
    property Document[index: integer]: variant read GetOneDocument;
    /// the current position of the Next() call, starting at 0
    property Position: integer read fCurrentPosition;
  end;

  /// event callback signature for iterative process of TMongoConnection
  TOnMongoConnectionReply = procedure(Request: TMongoRequest;
    const Reply: TMongoReplyCursor; var Opaque) of object;

{$M+}

  TMongoClient = class;
  TMongoDatabase = class;
  TMongoCollection = class;

  /// one TCP/IP connection to a MongoDB server
  // - all access will be protected by a mutex (critical section): it is thread
  // safe but you may use one TMongoClient per thread or a connection pool, for
  // better performance
  TMongoConnection = class
  protected
    fLock: TRTLCriticalSection;
    fLocked: cardinal;
    fClient: TMongoClient;
    fSocket: TCrtSocket;
    fServerAddress: RawUTF8;
    fServerPort: integer;
    procedure Lock;
    procedure UnLock;
    function Send(Request: TMongoRequest): boolean;
    function GetOpened: boolean;
    function GetLocked: boolean;
    // will call TMongoReplyCursor.FetchAllToJSON(TTextWriter(Opaque))
    procedure ReplyJSONStrict(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
    procedure ReplyJSONExtended(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
    procedure ReplyJSONNoMongo(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
    // will call TMongoReplyCursor.AppendAllToDocVariantDynArray(TVariantDynArray(Opaque))
    procedure ReplyDocVariant(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
    // will call TMongoReplyCursor.AppendAllToBSON(TBSONWrite(Opaque))
    procedure ReplyBSON(Request: TMongoRequest; const Reply: TMongoReplyCursor; var Opaque);
  public
    /// initialize the connection to the corresponding MongoDB server
    // - the server address is either a host name, or an IP address
    // - if no server address is specified, will try to connect to localhost
    // - this won't create the connection, until Open method is executed
    constructor Create(const aClient: TMongoClient; const aServerAddress: RawByteString;
      aServerPort: integer=MONGODB_DEFAULTPORT); reintroduce;
    /// release the connection, including the socket
    destructor Destroy; override;
    /// connect to the MongoDB server
    // - will raise an EMongoException on error
    procedure Open;
    /// disconnect from MongoDB server
    // - will raise an EMongoException on error
    procedure Close;

    /// low-level method to send a request to the server
    // - if Request is not either TMongoRequestQuery or TMongoRequestGetMore,
    // will raise an EMongoException
    // - then will return the reply message as sent back by the database,
    // ready to be accessed using a TMongoReplyCursor wrapper
    procedure GetReply(Request: TMongoRequest; out result: TMongoReply);
    /// low-level method to send a request to the server, and return a cursor
    // - if Request is not either TMongoRequestQuery or TMongoRequestGetMore,
    // will raise an EMongoException
    // - then will parse and return a cursor to the reply message as sent back
    // by the database, with logging if necessary
    // - raise an EMongoException if mrfQueryFailure flag is set in the reply
    procedure GetCursor(Request: TMongoRequest; var Result: TMongoReplyCursor);
    /// low-level method to send a query to the server, calling a callback event
    // on each reply
    // - is used by GetDocumentsAndFree, GetBSONAndFree and GetJSONAndFree
    // methods to receive the whole document (you should better call those)
    // - the supplied Query instance will be released when not needed any more
    procedure GetRepliesAndFree(Query: TMongoRequestQuery;
      OnEachReply: TOnMongoConnectionReply; var Opaque);

    /// send a query to the server, returning a TDocVariant instance containing
    // all the incoming data
    // - will send the Request message, and any needed TMongoRequestGetMore
    // messages to retrieve all the data from the server
    // - the supplied Query instance will be released when not needed any more
    // - if Query.NumberToReturn<>1, it will return either null or a dvArray
    // kind of TDocVariant containing all returned items
    // - if Query.NumberToReturn=1, then it will return either null or a
    // single TDocVariant instance
    function GetDocumentsAndFree(Query: TMongoRequestQuery): variant; overload;
    /// send a query to the server, returning a TDocVariant instance containing
    // all the incoming data
    // - will send the Request message, and any needed TMongoRequestGetMore
    // messages to retrieve all the data from the server
    // - the supplied Query instance will be released when not needed any more
    // - if Query.NumberToReturn<>1, it will return either null or a dvArray
    // kind of TDocVariant containing all returned items
    // - if Query.NumberToReturn=1, then it will return either null or a
    // single TDocVariant instance
    procedure GetDocumentsAndFree(Query: TMongoRequestQuery; var result: variant); overload;
    /// send a query to the server, returning a dynamic array of TDocVariant
    // instance containing all the incoming data
    // - will send the Request message, and any needed TMongoRequestGetMore
    // messages to retrieve all the data from the server
    // - the supplied Query instance will be released when not needed any more
    procedure GetDocumentsAndFree(Query: TMongoRequestQuery; var result: TVariantDynArray); overload;
    /// send a query to the server, returning a TBSONDocument instance containing
    // all the incoming data, as raw binary BSON document containing an array
    // of the returned items
    // - will send the Request message, and any needed TMongoRequestGetMore
    // messages to retrieve all the data from the server
    // - the supplied Query instance will be released when not needed any more
    function GetBSONAndFree(Query: TMongoRequestQuery): TBSONDocument;
    /// send a query to the server, returning all the incoming data as JSON
    // - will send the Request message, and any needed TMongoRequestGetMore
    // messages to retrieve all the data from the server
    // - this method is very optimized and will convert the BSON binary content
    // directly into JSON, in either modMongoStrict or modMongoShell layout
    // (modNoMongo will do the same as modMongoStrict)
    // - if Query.NumberToReturn<>1, it will return either 'null' or a '[..]'
    // JSON array with all the incoming documents retrieved from the server
    // - if Query.NumberToReturn=1, it will return either 'null' or a single
    // '{...}' JSON object
    // - the supplied Query instance will be released when not needed any more
    function GetJSONAndFree(Query: TMongoRequestQuery; Mode: TMongoJSONMode): RawUTF8;

    /// send a message to the MongoDB server
    // - will apply Client.WriteConcern policy, and run an EMongoException
    // in case of any error
    // - the supplied Request instance will be released when not needed any more
    // - by default, it will follow Client.WriteConcern pattern - but you can
    // set NoAcknowledge = TRUE to avoid calling the getLastError command
    // - will return the getLastError reply (if retrieved from server)
    function SendAndFree(Request: TMongoRequest; NoAcknowledge: boolean=false): variant;
    /// run a database command, supplied as a TDocVariant, TBSONVariant or a
    // string, and return the a TDocVariant instance
    // - see http://docs.mongodb.org/manual/reference/command for a list
    // of all available commands
    // - for instance:
    // ! RunCommand('test',_ObjFast(['dbStats',1,'scale',1024],stats);
    // ! RunCommand('test',BSONVariant(['dbStats',1,'scale',1024],stats);
    // ! RunCommand('admin','buildinfo',fServerBuildInfo);
    // - the message will be returned by the server as a single TDocVariant
    // instance (since the associated TMongoRequestQuery.NumberToSkip=1)
    // - in case of any error, the error message is returned as text
    // - in case of success, this method will return ''
    function RunCommand(const aDatabaseName: RawUTF8;
      const command: variant; var returnedValue: variant): RawUTF8; overload;
    /// run a database command, supplied as a TDocVariant, TBSONVariant or a
    // string, and return the raw BSON document array of received items
    // - this overloaded method can be used on huge content to avoid the slower
    // conversion to an array of TDocVariant instances
    // - in case of success, this method will return TRUE, or FALSE on error
    function RunCommand(const aDatabaseName: RawUTF8;
      const command: variant; var returnedValue: TBSONDocument): boolean; overload;

    /// return TRUE if the Open method has successfully been called
    property Opened: boolean read GetOpened;
    /// access to the corresponding MongoDB server
    property Client: TMongoClient read fClient;
    /// direct access to the low-level TCP/IP communication socket
    property Socket: TCrtSocket read fSocket;
    /// is TRUE when the connection is busy
    property Locked: boolean read GetLocked;
  published
    /// read-only access to the supplied server address
    // - the server address is either a host name, or an IP address
    property ServerAddress: RawUTF8 read fServerAddress;
    /// read-only access to the supplied server port
    // - the server Port is MONGODB_DEFAULTPORT (27017) by default
    property ServerPort: integer read fServerPort;
  end;

  /// array of TCP connection to a MongoDB Replica Set
  // - first item [0] is the Primary member
  // - other items [1..] are the Secondary members
  TMongoConnectionDynArray = array of TMongoConnection;

  /// define Read Preference Modes to a MongoDB replica set
  // - Important: All read preference modes except rpPrimary may return stale
  // data because secondaries replicate operations from the primary with some
  // delay - ensure that your application can tolerate stale data if you choose
  // to use a non-primary mode
  // - rpPrimary:	Default mode - all operations read from the current replica
  // set primary
  // - rpPrimaryPreferred: in most situations, operations read from the primary
  // but if it is unavailable, operations read from secondary members.
  // - rpPsecondary: all operations read from the secondary members
  // of the replica set
  // - rpPsecondaryPreferred:	in most situations, operations read from
  // secondary members but if no secondary members are available, operations
  // read from the primary
  TMongoClientReplicaSetReadPreference = (
    rpPrimary, rpPrimaryPreferred, rpSecondary, rpSecondaryPreferred);

  /// define Write Concern property of a MongoDB connection
  // - Write concern describes the guarantee that MongoDB provides when
  // reporting on the success of a write operation. The strength of the write
  // concerns determine the level of guarantee. When inserts, updates and
  // deletes have a weak write concern, write operations return quickly. In
  // some failure cases, write operations issued with weak write concerns may
  // not persist. With stronger write concerns, clients wait after sending a
  // write operation for MongoDB to confirm the write operations. MongoDB
  // provides different levels of write concern to better address the specific
  // needs of applications. Clients may adjust write concern to ensure that
  // the most important operations persist successfully to an entire
  // MongoDB deployment. For other less critical operations, clients can
  // adjust the write concern to ensure faster performance rather than
  // ensure persistence to the entire deployment.
  // - wcAcknowledged is the default safe mode: the mongod confirms the
  // receipt of the write operation. Acknowledged write concern allows clients
  // to catch network, duplicate key, and other errors.
  // - with wcJournaled, the mongod acknowledges the write operation only
  // after committing the data to the journal. This write concern ensures that
  // MongoDB can recover the data following a shutdown or power interruption.
  // - wcReplicaAcknowledged will guarantee that the write operation propagates
  // to at least one member of a replica set
  // - with wcUnacknowledged, MongoDB does not acknowledge the receipt of
  // write operation. Unacknowledged is similar to errors ignored; however,
  // drivers attempt to receive and handle network errors when possible. The
  // driver's ability to detect network errors depends on the system's
  // networking configuration.
  // - with wcErrorsIgnored, MongoDB does not acknowledge write operations.
  // With this level of write concern, the client cannot detect failed write
  // operations. These errors include connection errors and mongod exceptions
  // such as duplicate key exceptions for unique indexes. Although the errors
  // ignored write concern provides fast performance, this performance gain
  // comes at the cost of significant risks for data persistence and durability.
  // WARNING: Do not use wcErrorsIgnored write concern in normal operation.
  TMongoClientWriteConcern = (
    wcAcknowledged, wcJournaled, wcReplicaAcknowledged,
    wcUnacknowledged, wcErrorsIgnored);

  /// remote access to a MongoDB server
  // - a single server can have several active connections, if some secondary
  // hosts were defined
  TMongoClient = class
  protected
    fConnectionString: RawUTF8;
    fDatabases: TRawUTF8ListHashed;
    fConnections: TMongoConnectionDynArray;
    fReadPreference: TMongoClientReplicaSetReadPreference;
    fWriteConcern: TMongoClientWriteConcern;
    fConnectionTimeOut: Cardinal;
    fGracefulReconnect: boolean;
    fLog: TSynLog;
    fLogRequestEvent: TSynLogInfo;
    fLogReplyEvent: TSynLogInfo;
    fLogReplyEventMaxSize: cardinal;
    fServerBuildInfo: variant;
    fServerBuildInfoNumber: cardinal;
    fLatestReadConnectionIndex: integer;
    procedure AfterOpen; virtual; 
    function GetOneReadConnection: TMongoConnection;
    function GetBytesReceived: Int64;
    function GetBytesSent: Int64;
    function GetBytesTransmitted: Int64;
  public
    /// prepare a connection to a MongoDB server or Replica Set
    // - this constructor won't create the connection until the Open method
    // is called
    // - you can specify multiple hosts, as CSV values, if necessary
    constructor Create(const Host: RawUTF8; Port: Integer=MONGODB_DEFAULTPORT;
      const SecondaryHostCSV: RawUTF8=''; const SecondaryPortCSV: RawUTF8=''); overload;
    /// connect to a database on a remote MongoDB primary server
    // - this method won't use authentication, and will return the corresponding
    // MongoDB database instance
    // - this method is an alias to the Database[] property
    function Open(const DatabaseName: RawUTF8): TMongoDatabase;
    /// secure connection to a database on a remote MongoDB server
    // - this method will use authentication and will return the corresponding
    // MongoDB database instance, with a dedicated secured connection
    // - will use MONGODB-CR for MongoDB engines up to 2.6 (or if ForceMongoDBCR
    // is TRUE), and SCRAM-SHA-1 since MongoDB 3.x 
    // - see http://docs.mongodb.org/manual/administration/security-access-control
    function OpenAuth(const DatabaseName,UserName,PassWord: RawUTF8;
      ForceMongoDBCR: boolean=false): TMongoDatabase;
    /// close the connection and release all associated TMongoDatabase,
    // TMongoCollection and TMongoConnection instances
    destructor Destroy; override;
    /// define an optional logging instance to be used
    // - you can also specify the event types to be used for requests or
    // replay: by default, a verbose log with sllSQL and sllDB will be set
    // - e.g. mORMotMongoDB.pas will call Client.SetLog(SQLite3Log) for you
    procedure SetLog(LogClass: TSynLogClass;
      RequestEvent: TSynLogInfo=sllSQL; ReplyEvent: TSynLogInfo=sllDB;
      ReplyEventMaxSize: cardinal=1024);

    /// retrieve extended server version and build information, as text
    // - will create a string from ServerBuildInfo object, e.g. as
    // $ 'MongoDB 3.2.0 mozjs mmapv1,wiredTiger'
    function ServerBuildInfoText: RawUTF8;
    /// retrieve the server version and build information
    // - return the content as a TDocVariant document, e.g.
    // ! ServerBuildInfo.version = '2.4.9'
    // ! ServerBuildInfo.versionArray = [2,4,9,0]
    // - this property is cached, so request is sent only once
    // - you may rather use ServerBuildInfoNumber to check for available
    // features at runtime, for easy comparison of the server version
    property ServerBuildInfo: variant read fServerBuildInfo;
    /// access to a given MongoDB database
    // - try to open it via a non-authenticated connection it if not already:
    // will raise an exception on error, or will return an instance
    // - will return an existing instance if has already been opened
    property Database[const DatabaseName: RawUTF8]: TMongoDatabase read Open; default;
    /// low-level access to the TCP/IP connections of this MongoDB replica set
    // - first item [0] is the Primary member
    // - other items [1..] are the Secondary members
    property Connections: TMongoConnectionDynArray read fConnections;
    /// define the logging instance to be used for LogRequestEvent/LogReplyEvent
    // - you may also call the SetLog() method to set all options at once
    property Log: TSynLog read fLog write fLog;
  published
    /// the connection definition used to connect to this MongoDB server
    property ConnectionString: RawUTF8 read fConnectionString;
    /// retrieve the server version and build information
    // - return the content as a TDocVariant document, e.g.
    // ! 2040900 for MongoDB 2.4.9, or 2060000 for MongoDB 2.6, or
    // ! 3000300 for MongoDB 3.0.3
    // - this property is cached, so can be used to check for available
    // features at runtime, without any performance penalty
    property ServerBuildInfoNumber: cardinal read fServerBuildInfoNumber;
    /// define Read Preference mode to a MongoDB replica set
    // - see http://docs.mongodb.org/manual/core/read-preference
    // - default is rpPrimary, i.e. reading from the main primary instance
    // - Important: All read preference modes except rpPrimary may return stale
    // data because secondaries replicate operations from the primary with some
    // delay - ensure that your application can tolerate stale data if you choose
    // to use a non-primary mode
    property ReadPreference: TMongoClientReplicaSetReadPreference
      read fReadPreference write fReadPreference;
    /// define Write Concern mode to a MongoDB replica set
    // - see http://docs.mongodb.org/manual/core/write-concern
    // - default is wcAcknowledged, i.e. to acknowledge all write operations
    property WriteConcern: TMongoClientWriteConcern
      read fWriteConcern write fWriteConcern;
    /// the connection time out, in milli seconds
    // - default value is 30000, i.e. 30 seconds
    property ConnectionTimeOut: Cardinal read fConnectionTimeOut write fConnectionTimeOut;
    /// allow automatic reconnection (with authentication, if applying), if the
    // socket is closed (e.g. was dropped from the server)
    property GracefulReconnect: boolean read fGracefulReconnect write fGracefulReconnect;
    /// how may bytes this client did received, among all its connections
    property BytesReceived: Int64 read GetBytesReceived;
    /// how may bytes this client did received, among all its connections
    property BytesSent: Int64 read GetBytesSent;
    /// how may bytes this client did transmit, adding both input and output
    property BytesTransmitted: Int64 read GetBytesTransmitted;
    /// if set to something else than default sllNone, will log each request
    // with the corresponding logging event kind
    // - will use the Log property for the destination log
    // - you may also call the SetLog() method to set all options at once
    property LogRequestEvent: TSynLogInfo read fLogRequestEvent write fLogRequestEvent;
    /// if set to something else than default sllNone, will log each reply
    // with the corresponding logging event kind
    // - WARNING: logging all incoming data may be very verbose, e.g. when
    // retrieving a document list - use it with care, not on production, but
    // only for debugging purposes - or set LogReplyEventMaxSize to a low value
    // - will use the Log property for the destination log
    // - you may also call the SetLog() method to set all options at once
    property LogReplyEvent: TSynLogInfo read fLogReplyEvent write fLogReplyEvent;
    /// defines how many characters a LogReplyEvent entry may append in the log
    // - is set by default to 1024, which sounds somewhat good for debugging
    property LogReplyEventMaxSize: cardinal
      read fLogReplyEventMaxSize write fLogReplyEventMaxSize;
  end;

  /// remote access to a MondoDB database
  TMongoDatabase = class
  protected
    fClient: TMongoClient;
    fName: RawUTF8;
    fCollections: TRawUTF8ListHashed;
    function GetCollection(const Name: RawUTF8): TMongoCollection;
    function GetCollectionOrCreate(const Name: RawUTF8): TMongoCollection;
    function GetCollectionOrNil(const Name: RawUTF8): TMongoCollection;
  public
    /// initialize a reference to a given MongoDB Database
    // - you should not use this constructor directly, but rather use the
    // TMongoClient.Database[] property
    // - it will connect to the Client's primary host, then retrieve all
    // collection names of this database
    constructor Create(aClient: TMongoClient; const aDatabaseName: RawUTF8);
    /// release all associated TMongoCollection instances
    destructor Destroy; override;

    /// run a database command, supplied as a TDocVariant, TBSONVariant or a
    // string, and return a TDocVariant instance
    // - this is the preferred method to issue database commands, as it provides
    // a consistent interface between the MongoDB shell and this driver
    // - see http://docs.mongodb.org/manual/reference/command for a list
    // of all available commands
    // - for instance:
    // ! RunCommand(_ObjFast(['dbStats',1,'scale',1024],stats);
    // ! RunCommand(BSONVariant(['dbStats',1,'scale',1024],stats);
    // ! RunCommand('dbStats',stats);
    // ! RunCommand('hostInfo',host);
    // - the message will be returned by the server as a TDocVariant instance
    // (since the associated TMongoRequestQuery.NumberToSkip=1)
    // - in case of any error, the error message is returned as text
    // - in case of success, this method will return ''
    function RunCommand(const command: variant;
      var returnedValue: variant): RawUTF8; overload;
    /// run a database command, supplied as a TDocVariant, TBSONVariant or a
    // string, and return the raw BSON document array of received items
    // - this overloaded method can be used on huge content to avoid the slower
    // conversion to an array of TDocVariant instances
    // - in case of success, this method will return TRUE, or FALSE on error
    function RunCommand(const command: variant;
      var returnedValue: TBSONDocument): boolean; overload;

    /// create the user in the database to which the user will belong
    // - you could specify the roles to use, for this database or others:
    // ! reportingDB.CreateUser('reportsUser','12345678',BSONVariant(
    // !  '[{ role: "readWrite", db: "reporting" }, { role: "read", db: "products" }]'));
    // - returns '' on sucess, an error message otherwise
    function CreateUser(const UserName,Password: RawUTF8;
      const roles: variant): RawUTF8;
    /// create the user with a read or read/write role on the current database
    // - returns '' on sucess, an error message otherwise
    function CreateUserForThisDatabase(const UserName,Password: RawUTF8;
      allowWrite: Boolean=true): RawUTF8;
    /// deletes the supplied user on the current database
    // - returns '' on sucess, an error message otherwise
    function DropUser(const UserName: RawUTF8): RawUTF8;

    /// access to a given MongoDB collection
    // - raise an EMongoDatabaseException if the collection name does not exist
    property Collection[const Name: RawUTF8]: TMongoCollection
      read GetCollection; default;
    /// access to a given MongoDB collection
    // - if the collection name does not exist, it will return nil
    property CollectionOrNil[const Name: RawUTF8]: TMongoCollection
      read GetCollectionOrNil;
    /// access to a given MongoDB collection
    // - if the collection name does not exist, it will add use the name to
    // create a TMongoCollection instance and register it to the internal list
    property CollectionOrCreate[const Name: RawUTF8]: TMongoCollection
      read GetCollectionOrCreate;
  published
    /// the database name
    property Name: RawUTF8 read fName;
    /// the associated MongoDB client instance
    property Client: TMongoClient read fClient;
  end;

  /// remote access to a MondoDB collection
  TMongoCollection = class
  protected
    fDatabase: TMongoDatabase;
    fName: RawUTF8;
    fFullCollectionName: RawUTF8;
    function AggregateCallFromJSON(const pipelineJSON: RawUTF8; var reply,res: variant): boolean; overload;
    function AggregateCallFromVariant(const pipelineArray: variant; var reply,res: variant): boolean; overload;
  public
    /// initialize a reference to a given MongoDB Collection
    // - you should not use this constructor directly, but rather use
    // TMongoClient.Database[].Collection[] property
    constructor Create(aDatabase: TMongoDatabase; const aCollectionName: RawUTF8);

    /// select documents in a collection and returns a dvArray TDocVariant
    // instance containing the selected documents
    // - Criteria can be null (to retrieve all documents) or a TDocVariant /
    // TBSONVariant query selector:
    // ! FindDoc(BSONVariant('{name:"John",age:{$gt:21}}'),null);
    // ! FindDoc(BSONVariant('{name:?,age:{$gt:?}}',[],['John',21]),null);
    // see http://docs.mongodb.org/manual/reference/operator for reference
    // - Projection can be null (to retrieve all fields) or a CSV string to set
    // field names to retrieve, or a TDocVariant or TBSONVariant - e.g.:
    // ! FindDoc(BSONVariant(['name','John']),null);
    // ! FindDoc(BSONVariant(['name','John']),'_id,name');
    // ! FindDoc(BSONVariant(['name','John']),BSONVariantFieldSelector('name,_id'));
    // - NumberToReturn can be left to its default maxInt value to return all
    // matching documents, or specify a limit (e.g. 1 for one document - in this
    // case, the returned instance won't be a dvArray kind of TDocVariant, but
    // either null or the single returned document)
    // - if the query does not have any matching record, it will return null
    function FindDoc(const Criteria, Projection: Variant;
      NumberToReturn: integer=1; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]): variant; overload;
    /// select documents in a collection and returns a dvArray TDocVariant
    // instance containing the selected documents
    // - Criteria can specify the query selector as (extended) JSON and
    // parameters:
    // ! FindDoc('{name:"John",age:{$gt:21}}',[]);
    // ! FindDoc('{name:?,age:{$gt:?}}',['John',21]);
    // see http://docs.mongodb.org/manual/reference/operator for reference
    // - this overloaded method will use a null Projection, i.e. will retrieve
    // all fields
    // - NumberToReturn can be left to its default maxInt value to return all
    // matching documents, or specify a limit (e.g. 1 for one document - in this
    // case, the returned instance won't be a dvArray kind of TDocVariant, but
    // either null or the single returned document)
    // - if the query does not have any matching record, it will return null
    function FindDoc(Criteria: PUTF8Char; const Params: array of const;
      NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]): variant; overload;
    /// find an existing document in a collection, by its _id field
    // - _id will identify the unique document to be retrieved
    // - returns null, or a TDocVariant instance
    function FindOne(const _id: TBSONObjectID): variant; overload;
    /// find an existing document in a collection, by its _id field
    // - _id will identify the unique document to be retrieved
    // - returns null, or a TDocVariant instance
    function FindOne(const _id: variant): variant; overload;
    /// find an existing document in a collection, by a custom Criteria value
    // - Criteria object, specified as name/value pairs, will identify the
    // unique document to be retrieved
    // - returns the found TDocVariant instance
    // - if the Criteria has no match, return either null or a new object with
    // default values as NameValuePairs if ReturnNewObjectIfNotFound is true
    function FindOne(const NameValuePairs: array of const;
      ReturnNewObjectIfNotFound: boolean=false): variant; overload;
    /// returns a dynamic array of TDocVariant instance containing
    // all documents of a collection
    // - Projection can be null (to retrieve all fields) or a CSV string to set
    // field names to retrieve, or a TDocVariant or TBSONVariant with
    // projection operators
    procedure FindDocs(var result: TVariantDynArray; const Projection: variant;
      NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]); overload;
    /// select documents in a collection and returns a dynamic array of
    // TDocVariant instance containing the selected documents
    // - you can e.g. fill a res: TVariantDynArray with the following query:
    // ! FindDocs('{name:?,age:{$gt:?}}',['John',21],res,null);
    // - Projection can be null (to retrieve all fields) or a CSV string to set
    // field names to retrieve, or a TDocVariant or TBSONVariant with
    // projection operators
    procedure FindDocs(Criteria: PUTF8Char; const Params: array of const;
      var result: TVariantDynArray; const Projection: variant;
      NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]); overload;
    /// select documents in a collection and returns a dynamic array of
    // TDocVariant instance containing the selected documents
    // - could be used to fill a VCL grid using a TDocVariantArrayDataSet
    // as defined in SynVirtualDataSet.pas:
    // ! ds1.DataSet := ToDataSet(self,FindDocs('{name:?,age:{$gt:?}}',['John',21],null));
    // - Projection can be null (to retrieve all fields) or a CSV string to set
    // field names to retrieve, or a TDocVariant or TBSONVariant with
    // projection operators
    function FindDocs(Criteria: PUTF8Char; const Params: array of const;
      const Projection: variant; NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]): TVariantDynArray; overload;

    /// select documents in a collection and returns a JSON array of documents
    // containing the selected documents
    // - Criteria can be null (to retrieve all documents) or a TDocVariant /
    // TBSONVariant query selector:
    // ! FindJSON(BSONVariant('{name:"John",age:{$gt:21}}'),null);
    // ! FindJSON(BSONVariant('{name:?,age:{$gt:?}}',[],['John',21]),null);
    // see http://docs.mongodb.org/manual/reference/operator for reference
    // - Projection can be null (to retrieve all fields) or a CSV string to set
    // the field names to retrieve, or a TDocVariant or TBSONVariant - e.g.:
    // ! FindJSON(BSONVariant(['name','John']),null);
    // ! FindJSON(BSONVariant(['name','John']),'_id');
    // ! FindJSON(BSONVariant(['name','John']),BSONVariantFieldSelector('name,_id'));
    // - NumberToReturn can be left to its default maxInt value to return all
    // matching documents as a '[..]' JSON array, or specify a limit (e.g. 1
    // for one document - in this case, the returned instance won't be a '[..]'
    // JSON array, but either 'null' or a single '{..}' JSON object)
    // - this method is very optimized and will convert the BSON binary content
    // directly into JSON, in either modMongoStrict or modMongoShell layout
    // (modNoMongo will do the same as modMongoStrict)
    function FindJSON(const Criteria, Projection: Variant;
      NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]; Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
    /// select documents in a collection and returns a JSON array of documents
    // containing the selected documents
    // - Criteria can specify the query selector as (extended) JSON and
    // parameters:
    // ! FindJSON('{name:"John",age:{$gt:21}}',[]);
    // ! FindJSON('{name:?,age:{$gt:?}}',['John',21]);
    // see http://docs.mongodb.org/manual/reference/operator for reference
    // - this overloaded method will use a null Projection, i.e. will retrieve
    // all fields
    // - NumberToReturn can be left to its default maxInt value to return all
    // matching documents as a '[..]' JSON array, or specify a limit (e.g. 1
    // for one document - in this case, the returned instance won't be a '[..]'
    // JSON array, but either 'null' or a single '{..}' JSON object)
    function FindJSON(Criteria: PUTF8Char; const Params: array of const;
      NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]; Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
    /// select documents in a collection and returns a JSON array of documents
    // containing the selected documents
    // - Criteria and Projection can specify the query selector as (extended)
    // JSON and parameters
    function FindJSON(Criteria: PUTF8Char; const CriteriaParams: array of const;
      const Projection: variant; NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]; Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;

    /// select documents in a collection and returns a TBSONDocument instance
    // containing the selected documents as a raw binary BSON array document
    // - Criteria can be null (to retrieve all documents) or a TDocVariant /
    // TBSONVariant query selector:
    // ! FindBSON(BSONVariant('{name:"John",age:{$gt:21}}'),null);
    // ! FindBSON(BSONVariant('{name:?,age:{$gt:?}}',[],['John',21]),null);
    // - Projection can be null (to retrieve all fields) or a CSV string to set
    // the field names to retrieve, or a TDocVariant or TBSONVariant - e.g.:
    // ! FindBSON(BSONVariant(['name','John']),null);
    // ! FindBSON(BSONVariant(['name','John']),'_id');
    // ! FindBSON(BSONVariant(['name','John']),BSONVariantFieldSelector('name,_id'));
    // - NumberToReturn can be left to its default maxInt value to return all
    // matching documents, or specify a limit (e.g. 1 for one document)
    function FindBSON(const Criteria, Projection: Variant;
      NumberToReturn: integer=maxInt; NumberToSkip: Integer=0;
      Flags: TMongoQueryFlags=[]): TBSONDocument;

    /// insert one document, supplied as (extended) JSON and parameters,
    // in the collection
    // - supplied JSON could be either strict or in MongoDB Shell syntax:
    // !   products.insert('{ _id: ?, item: ?, qty: ? }',[1,'card',15]);
    // !   // here _id is forced on the client side
    // !   products.insert('{ item: ?, qty: ? }',[1,'card',15]);
    // !   // here the _id will be created on the client side as an ObjectID
    // - you can retrieve the client-side computed ObjectID, as such:
    // ! var oid: TBSONObjectID;
    // ! ...
    // !   products.insert('{ item: ?, qty: ? }',['card',15],@oid);
    // !   writeln(oid.ToText);
    procedure Insert(const Document: RawUTF8; const Params: array of const;
      CreatedObjectID: PBSONObjectID=nil); overload;
    /// insert one or more documents in the collection
    // - Documents is an array of TDocVariant (i.e. created via _JsonFast()
    // or _JsonFastFmt()) - or of TBSONVariant (created via BSONVariant())
    // - by default, it will follow Client.WriteConcern pattern - but you can
    // set NoAcknowledge = TRUE to avoid calling the getLastError command and
    // increase the execution speed, at the expense of a unsafe process
    procedure Insert(const Documents: array of variant; Flags: TMongoInsertFlags=[];
      NoAcknowledge: boolean=false); overload;
    /// insert one or more documents in the collection
    // - Documents is the low-level concatenation of BSON documents, created
    // e.g. with a TBSONWriter stream
    // - by default, it will follow Client.WriteConcern pattern - but you can
    // set NoAcknowledge = TRUE to avoid calling the getLastError command and
    // increase the execution speed, at the expense of a unsafe process
    procedure Insert(const Documents: TBSONDocument;
      Flags: TMongoInsertFlags=[]; NoAcknowledge: boolean=false); overload;
    /// insert one or more documents in the collection
    // - JSONDocuments is an array of JSON objects
    // - by default, it will follow Client.WriteConcern pattern - but you can
    // set NoAcknowledge = TRUE to avoid calling the getLastError command and
    // increase the execution speed, at the expense of a unsafe process
    procedure InsertJSON(const JSONDocuments: array of PUTF8Char;
      Flags: TMongoInsertFlags=[]; NoAcknowledge: boolean=false);

    /// updates an existing document or inserts a new document, depending on
    // its document parameter
    // - this document should be a TDocVariant (i.e. created via _JsonFast()
    // or _JsonFastFmt()) since we need to check for the _id field, other types
    // will be converted to a TDocVariant instance (via its JSON representation)
    // so it is pointless to use BSONVariant() here
    // - if the document does not contain an _id field, then the Save() method
    // performs an insert; during the operation, the client will add to the
    // Document variant the _id field and assign it a unique ObjectId - you can
    // optionally retrieve it with the CreatedObjectID pointer - and the method
    // returns FALSE
    // - if the document contains an _id field, then the save() method performs
    // an upsert, querying the collection on the _id field: if a document does
    // not exist with the specified _id value, the save() method performs an
    // insert; if a document exists with the specified _id value, the save()
    // method performs an update that replaces ALL fields in the existing
    // document with the fields from the document - and the method returns TRUE
    function Save(var Document: variant; CreatedObjectID: PBSONObjectID=nil): boolean; overload;
    /// updates an existing document or inserts a new document, depending on
    // its document parameter, supplied as (extended) JSON and parameters
    // - supplied JSON could be either strict or in MongoDB Shell syntax:
    // - will perform either an insert or an update, depending of the
    // presence of the _id field, as overloaded Save(const Document: variant)
    procedure Save(const Document: RawUTF8; const Params: array of const;
      CreatedObjectID: PBSONObjectID=nil); overload;

    /// modifies an existing document or several documents in a collection
    // - the method can modify specific fields of existing document or documents
    // or replace an existing document entirely, depending on the update parameter
    // - Query and Update parameters should be TDocVariant (i.e. created via
    // _JsonFast() or _JsonFastFmt()) or TBSONVariant (created via BSONVariant())
    // - Query is the selection criteria for the update; use the same query
    // selectors as used in the Find() method
    // - if Update contains a plain document, it will replace any existing data
    // - if Update contains update operators (like $set), it will update the
    // corresponding fields in the document
    procedure Update(const Query, Update: variant; Flags: TMongoUpdateFlags=[]); overload;
    /// modifies an existing document or several documents in a collection
    // - the method can modify specific fields of existing document or documents
    // or replace an existing document entirely, depending on the update parameter
    // - since all content will be transformed into JSON internally, use this
    // method only if the supplied parameters are simple types: any complex value
    // (e.g. a TDateTime or a BSONVariant binary) won't be handled as expected -
    // use the overloaded Update() with explicit BSONVariant() values instead
    // - Query and Update parameters can be specified as JSON objects with
    // parameters
    // - Query is the selection criteria for the update; use the same query
    // selectors as used in the Find() method
    // - if Update contains a plain document, it will replace any existing data:
    // ! people.update('{name:?}',['Andy'],'{name:?,age:? }',['Andy',25],[mufUpsert]);
    // Warning: to avoid inserting the same document more than once, only use
    // mufUpsert if the query field is uniquely indexed
    // - if Update contains update operators (like $set), it will update the
    // corresponding fields in the document:
    // ! book.insert('{_id:?,item:?,stock:?}',[11,'Divine Comedy',2]);
    // ! book.update('{item:?},['Divine Comedy'],'{$set:{price:?},$inc:{stock:?}},[18,5]);
    // ! // the updated document is now:
    // ! { "_id" : 11, "item" : "Divine Comedy", "price" : 18, "stock" : 7 }
    procedure Update(Query: PUTF8Char; const QueryParams: array of const;
      const Update: RawUTF8; const UpdateParams: array of const;
      Flags: TMongoUpdateFlags=[]); overload;
    /// modifies some fields of an existing document in a collection
    // - by default, Update() or Save() will replace the whole document
    // - this method will expect the identifier to be supplied as a variant -
    // may be via the ObjectID() function
    // - and will replace the specified fields, i.e. it will execute a $set:
    // with the supplied UpdatedFields value
    procedure UpdateOne(const _id, UpdatedFields: variant);

    /// delete an existing document or several documents in a collection
    // - Query parameter should be TDocVariant (i.e. created via _JsonFast() or
    // _JsonFastFmt()) or TBSONVariant (created via BSONVariant())
    // - Query is the selection criteria for the deletion; use the same query
    // selectors as used in the Find() method
    // - to limit the deletion to just one document, set Flags to [mdfSingleRemove]
    // - to delete all documents matching the deletion criteria, leave it to []
    procedure Remove(const Query: variant; Flags: TMongoDeleteFlags=[]); overload;
    /// delete an existing document in a collection, by its _id field
    // - _id will identify the unique document to be deleted
    procedure RemoveOne(const _id: TBSONObjectID); overload;
    /// delete an existing document in a collection, by its _id field
    // - _id will identify the unique document to be deleted
    procedure RemoveOne(const _id: variant); overload;
    /// delete an existing document or several documents in a collection
    // - Query parameter can be specified as JSON objects with parameters
    // - Query is the selection criteria for the deletion; use the same query
    // selectors as used in the Find() method
    // - to limit the deletion to just one document, set Flags to [mdfSingleRemove]
    // - to delete all documents matching the deletion criteria, leave it to []
    procedure RemoveFmt(Query: PUTF8Char; const QueryParams: array of const;
       Flags: TMongoDeleteFlags=[]);

    /// creates an index on the specified field(s) if the index does
    // not already exist
    // - Keys and Options parameters should be TDocVariant (e.g. created via
    // _JsonFast() or _JsonFastFmt()) - and not TBSONVariant values
    // - for ascending/descending indexes, Keys is a document that contains pairs
    // with the name of the field or fields to index and order of the index:
    // value of 1 specifies ascending and of -1 specifies descending
    // - options is a non-mandatory document that controls the creation
    // of the index -
    // - you can write e.g.
    // ! book.EnsureIndex(_JsonFast('{ orderDate: 1 }'),null)
    // ! book.EnsureIndex(_ObjFast(['orderDate',1]),null)
    procedure EnsureIndex(const Keys, Options: variant); overload;
    /// creates an index on the specified field(s) if the index does
    // not already exist
    // - Keys are the correspondiong field names
    // - you can write e.g. to create an ascending index on a given field:
    // ! book.EnsureIndex(['orderDate']);
    procedure EnsureIndex(const Keys: array of RawUTF8; Ascending: boolean=true;
      Unique: boolean=false); overload;
    /// drops the entire collection from the database
    // - once dropped, this TMongoCollection instance will be freed: never
    // use this instance again after success (i.e. returned '')
    // - in case of error, a textual message will be returned as result
    // - once dropped, this collection will be removed from the parent
    // Database.Collection[] internal list
    // - Warning: this method obtains a write lock on the affected database
    // and will block other operations until it has completed
    function Drop: RawUTF8;

    /// calculate the number of documents in the collection
    // - be aware that this method may be somewhat slow for huge collections,
    // since a full scan of an index is to be performed: if your purpose is
    // to ensure that a collection contains items, use rather IsEmpty method
    function Count: Int64;
    /// calculate the number of documents in the collection that match
    // a specific query
    // - Criteria can specify the query selector as a BSONVariant/TDocVariant
    function FindCount(const Query: variant): Int64; overload;
    /// calculate the number of documents in the collection that match
    // a specific query
    // - Criteria can specify the query selector as (extended) JSON and
    // parameters:
    // ! FindCount('{name:?,age:{$gt:?}}',[],['John',21]);
    // ! FindCount('{ ord_dt: { $gt: new Date(?) } }',[],[trunc(Now)-7]);
    // - optional MaxNumberToReturn can specify a limit for the search (e.g. if
    // you do not want an exact count, but only check for a specific limit)
    // - optional NumberToSkip can specify the number of matching documents
    // to skip before counting
    function FindCount(Criteria: PUTF8Char; const Args,Params: array of const;
      MaxNumberToReturn: integer=0; NumberToSkip: Integer=0): Int64; overload;
    /// returns TRUE if the collection has no document, FALSE otherwise 
    // - is much faster than Count, especially for huge collections
    function IsEmpty: boolean;
    /// calculate aggregate values using the MongoDB aggregation framework
    // and return the result as a TDocVariant instance
    // - the Aggregation Framework was designed to be more efficient than the
    // alternative map-reduce pattern, and is available since MongoDB 2.2 -
    // see http://docs.mongodb.org/manual/reference/command/aggregate
    // - you should specify the aggregation pipeline as a list of JSON object
    // operators (without the [..]) - for reference of all available phases,
    // see http://docs.mongodb.org/manual/core/aggregation-pipeline
    // - if the server sent back no {result:...} member, will return null
    // - if the server sent back one item as {result:[{..}]}, will return
    // this single item as a TDocVariant
    // - if the server sent back several items as {result:[{..},{..}]}, will
    // return a dvArray kind of TDocVariant
    function AggregateDoc(Operators: PUTF8Char; const Params: array of const): variant; overload;
    /// calculate JSON aggregate values using the MongoDB aggregation framework
    // - the Aggregation Framework was designed to be more efficient than the
    // alternative map-reduce pattern, and is available since MongoDB 2.2 -
    // see http://docs.mongodb.org/manual/reference/command/aggregate
    // - you should specify the aggregation pipeline as a list of JSON object
    // operators (without the [..]) - for reference of all available phases,
    // see http://docs.mongodb.org/manual/core/aggregation-pipeline
    // - for instance, the following will return as JSON a collection sorted in
    // descending order according by the age field and then in ascending order
    // according to the value in the posts field
    // ! AggregateJSON('{ $sort : { age : -1, posts: 1 } }',[])
    function AggregateJSON(Operators: PUTF8Char; const Params: array of const;
      Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
    /// calculate aggregate values using the MongoDB aggregation framework
    // and return the result as a TDocVariant instance
    // - overloaded method to specify the pipeline as a BSON raw document
    // as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
    function AggregateDocFromVariant(const pipelineArray: variant): variant;
    /// calculate JSON aggregate values using the MongoDB aggregation framework
    // - overloaded method to specify the pipeline as a BSON raw document
    // as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
    function AggregateJSONFromVariant(const pipelineArray: variant;
      Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
    /// calculate aggregate values using the MongoDB aggregation framework
    // and return the result as a TDocVariant instance
    // - overloaded method to specify the pipeline as a JSON text object
    // as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
    // - for instance, the following will return the maximum _id value of
    // the collection:
    // ! AggregateDoc('{$group:{_id:null,max:{$max:"$_id"}}}').max
    function AggregateDocFromJson(const PipelineJSON: RawUTF8): variant;
    /// calculate JSON aggregate values using the MongoDB aggregation framework
    // - overloaded method to specify the pipeline as a JSON text object
    // as detailed by http://docs.mongodb.org/manual/core/aggregation-pipeline
    function AggregateJSONFromJson(const PipelineJSON: RawUTF8;
      Mode: TMongoJSONMode=modMongoStrict): RawUTF8; overload;
  published
    /// the collection name
    property Name: RawUTF8 read fName;
    /// the full collection name, e.g. 'dbname.collectionname'
    property FullCollectionName: RawUTF8 read fFullCollectionName;
    /// the associated MongoDB database instance
    property Database: TMongoDatabase read fDatabase;
  end;

  /// exception type used for MongoDB process, once connected
  EMongoConnectionException = class(EMongoException)
  protected
    fConnection: TMongoConnection;
  public
    /// initialize the Exception for a given request
    constructor Create(const aMsg: string; aConnection: TMongoConnection); reintroduce; overload;
    /// initialize the Exception for a given request
    constructor CreateUTF8(const Format: RawUTF8; const Args: array of const;
      aConnection: TMongoConnection); reintroduce;
  published
    /// the associated connection
    property Connection: TMongoConnection read fConnection;
  end;

  EMongoDatabaseException = class(EMongoConnectionException)
  protected
    fDatabase: TMongoDatabase;
  public
    /// initialize the Exception for a given request
    constructor Create(const aMsg: string; aDatabase: TMongoDatabase); reintroduce; overload;
    /// initialize the Exception for a given request
    constructor CreateUTF8(const Format: RawUTF8; const Args: array of const;
      aDatabase: TMongoDatabase); reintroduce;
    {$ifndef NOEXCEPTIONINTERCEPT}
    /// used to customize the exception log to contain information about the Query
    // - it will log the database parameters
    function CustomLog(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean; override;
    {$endif}
  published
    /// the associated Database
    property Database: TMongoDatabase read fDatabase;
  end;

  /// exception type used for MongoDB query process
  EMongoRequestException = class(EMongoConnectionException)
  protected
    fRequest: TMongoRequest;
    fError: TMongoReplyCursor;
    fErrorDoc: variant;
    function GetErrorDoc: variant;
  public
    /// initialize the Exception for a given request
    constructor Create(const aMsg: string; aConnection: TMongoConnection;
      aRequest: TMongoRequest=nil); reintroduce; overload;
    /// initialize the Exception for a given request
    constructor CreateUTF8(const Format: RawUTF8; const Args: array of const;
      aConnection: TMongoConnection; aRequest: TMongoRequest); reintroduce;
    /// initialize the Exception for a given request
    constructor Create(const aMsg: string; aConnection: TMongoConnection;
      aRequest: TMongoRequest; const aError: TMongoReplyCursor); reintroduce; overload;
    /// initialize the Exception for a given request
    constructor Create(const aMsg: string; aConnection: TMongoConnection;
      aRequest: TMongoRequest; const aErrorDoc: TDocVariantData); reintroduce; overload;
    {$ifndef NOEXCEPTIONINTERCEPT}
    /// used to customize the exception log to contain information about the Query
    // - it will log both the failing request and the returned error message
    function CustomLog(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean; override;
    {$endif}
    /// the associated error reply document
    property ErrorReply: TMongoReplyCursor read fError;
  published
    /// the associated error reply document, as a TDocVariant instance
    // - will return the first document available in ErrorReply, or the supplied
    // aErrorDoc: TDocVariantData instance
    property ErrorDoc: Variant read GetErrorDoc;
  end;

  /// exception type used for MongoDB query process after an Operating System
  // error (e.g. in case of socket error)
  EMongoRequestOSException = class(EMongoRequestException)
  protected
    fSystemLastError: cardinal;
  public
    /// initialize the Exception for a given request, including the last
    // error message retrieved from the operating system
    // - if such an exception is raised, you can use SystemLastError property
    // to retrieve the corresponding Operating System error code
    constructor Create(const aMsg: string; aConnection: TMongoConnection;
      aRequest: TMongoRequest=nil); reintroduce;
    /// contain the associated Operating System last error code
    // - will specify e.g. the kind of communication/socket error
    property SystemLastError: cardinal read fSystemLastError;
  end;

{$M-}



implementation

// used by TBSONElement.ToVariant() method and BSONToDoc() procedure
procedure BSONItemsToDocVariant(Kind: TBSONElementType; BSON: PByte;
  var Doc: TDocVariantData; Option: TBSONDocArrayConversion);
const OPTIONS: array[TBSONDocArrayConversion] of TDocVariantOptions =
    ([],[dvoReturnNullForUnknownProperty],
        [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference],
        [dvoReturnNullForUnknownProperty,dvoInternNames],
        [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,dvoInternNames]);
var k: TDocVariantKind;
    i,n,cap: integer;
    intnames: TRawUTF8Interning;
    items: array[0..63] of TBSONElement;
begin // very fast optimized code
  if BSON=nil then
    TVarData(Doc).VType := varNull else begin
    intnames := nil;
    case Kind of
    betDoc: begin
      k := dvObject;
      if dvoInternNames in Doc.Options then
        intnames := DocVariantType.InternNames;
    end;
    betArray:
      k := dvArray;
    else exit; // leave Doc=varEmpty
    end;
    Doc.Init(OPTIONS[Option],k);
    cap := 0;
    repeat // will handle up to 64 TBSONElement per loop (via items[])
      n := 0;
      while items[n].FromNext(BSON) do begin
        inc(n);
        if n=length(items) then
          break; // avoid buffer overflow
      end;
      if n=0 then
        break;
      inc(cap,n); // pre-allocate Doc.Names[]/Values[]
      if cap<512 then
        Doc.Capacity := cap else
        if Doc.Capacity<cap then
          Doc.Capacity := cap+cap shr 3; // faster for huge arrays
      for i := 0 to n-1 do begin
        if Kind=betDoc then
          if intnames<>nil then
            intnames.Unique(Doc.Names[i+Doc.Count],items[i].Name,items[i].NameLen) else
            SetString(Doc.Names[i+Doc.Count],PAnsiChar(items[i].Name),items[i].NameLen);
        items[i].ToVariant(Doc.Values[i+Doc.Count],Option);
      end;
      Doc.SetCount(Doc.Count+n);
    until (BSON=nil) or (BSON^=byte(betEOF));
  end;
end;


{ TBSONElement }

var
  /// size (in bytes) of a BSON element
  // - equals -1 for varying elements
  BSON_ELEMENTSIZE: array[TBSONElementType] of integer = (
    //betEOF, betFloat, betString, betDoc, betArray, betBinary,
      0,     sizeof(Double), -1,     -1,     -1,       -1,
    //betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
      0,                    sizeof(TBSONObjectID), 1, sizeof(Int64),
    //betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
      0,        -1,           -1,             -1,        -1,
    //betJSScope, betInt32, betTimeStamp, betInt64, betDecimal128
      -1, sizeof(Integer), sizeof(Int64), SizeOf(Int64), Sizeof(TDecimal128));

  /// types which do not have an exact equivalency to a standard variant
  // type will be mapped as varUnknown - and will be changed into
  // BSONVariantType.VarType
  BSON_ELEMENTTYPES: array[TBSONElementType] of word = (
    //betEOF, betFloat, betString, betDoc, betArray, betBinary,
    varEmpty, varDouble, varString, varUnknown, varUnknown, varUnknown,
    //betDeprecatedUndefined, betObjectID, betBoolean, betDateTime,
    varEmpty, varUnknown, varBoolean, varDate,
    //betNull, betRegEx, betDeprecatedDbptr, betJS, betDeprecatedSymbol,
    varNull, varUnknown, varUnknown, varUnknown, varUnknown,
    //betJSScope, betInt32, betTimeStamp, betInt64, betDecimal128
    varUnknown, varInteger, varUnknown, varInt64, varUnknown);

function TBSONElement.ToVariant(DocArrayConversion: TBSONDocArrayConversion): variant;
begin
  ToVariant(Result,DocArrayConversion);
end;

procedure TBSONElement.ToVariant(var result: variant;
  DocArrayConversion: TBSONDocArrayConversion);
var res: TVarData absolute result;
    resBSON: TBSONVariantData absolute result;
begin
  if res.VType and VTYPE_STATIC<>0 then
    VarClear(result);
  ZeroFill(@result); // set result.VType=varEmpty and result.VAny=nil
  case Kind of
  betFloat:
    res.VDouble := PDouble(Element)^;
  betString:
    SetString(RawUTF8(res.VAny),Data.Text,Data.TextLen);
  betJS, betDeprecatedSymbol:
    SetString(RawUTF8(resBSON.VText),Data.Text,Data.TextLen);
  betDoc, betArray:
    if DocArrayConversion=asBSONVariant then
      SetString(TBSONDocument(resBSON.VBlob),PAnsiChar(Element),ElementBytes) else begin
      BSONItemsToDocVariant(Kind,Data.DocList,TDocVariantData(result),DocArrayConversion);
      exit;
    end;
  betBinary, betRegEx, betDeprecatedDbptr, betJSScope, betTimeStamp, betDecimal128:
    SetString(RawByteString(resBSON.VBlob),PAnsiChar(Element),ElementBytes);
  betObjectID:
    resBSON.VObjectID := PBSONObjectID(Element)^;
  betBoolean:
    res.VBoolean := PBoolean(Element)^;
  betDateTime:
    res.VDate := UnixMSTimeToDateTime(PUnixMSTime(Element)^);
  betInt32:
    res.VInteger := PInteger(Element)^;
  betInt64:
    res.VInt64 := PInt64(Element)^;
  // betNull, betDeprecatedUndefined, betMinKey or betMaxKey has no data
  end;
  res.VType := BSON_ELEMENTTYPES[Kind];
  if res.VType=varUnknown then begin
    resBSON.VType := BSONVariantType.VarType;
    resBSON.VKind := Kind;
  end;
end;

function TBSONElement.ToInteger(const default: Int64=0): Int64;
begin
  case Kind of
  betBoolean:
    result := PByte(Element)^;
  betFloat:
    result := Trunc(PDouble(Element)^);
  betInt32:
    result := PInteger(Element)^;
  betInt64:
    result := PInt64(Element)^;
  else
    result := default;
  end;
end;

function TBSONElement.ToRawUTF8: RawUTF8;
procedure ComplexType;
var V: variant;
    wasString: boolean;
begin
  ToVariant(V);
  VariantToUTF8(V,result,wasString);
end;
begin
  case Kind of
  betFloat:
    ExtendedToStr(PDouble(Element)^,DOUBLE_PRECISION,result);
  betString:
    SetString(result,Data.Text,Data.TextLen);
  betInt32:
    Int32ToUtf8(PInteger(Element)^,result);
  betInt64:
    Int64ToUtf8(PInt64(Element)^,result);
  betDecimal128:
    PDecimal128(Element)^.ToText(result);
  else ComplexType;
  end;
end;

function TBSONElement.DocItemToVariant(const aName: RawUTF8; var aValue: variant;
  DocArrayConversion: TBSONDocArrayConversion): boolean;
var item: TBSONElement;
begin
  if (Kind in [betDoc,betArray]) and item.FromSearch(Data.DocList,aName) then begin
    item.ToVariant(aValue,DocArrayConversion);
    result := true;
  end else
    result := false;
end;

function TBSONElement.DocItemToRawUTF8(const aName: RawUTF8): RawUTF8;
var item: TBSONElement;
begin
  if (Kind in [betDoc,betArray]) and item.FromSearch(Data.DocList,aName) then
    result := item.ToRawUTF8 else
    result := '';
end;

function TBSONElement.DocItemToInteger(const aName: RawUTF8; const default: Int64): Int64;
var item: TBSONElement;
begin
  if (Kind in [betDoc,betArray]) and item.FromSearch(Data.DocList,aName) then
    result := item.ToInteger(default) else
    result := default;
end;

procedure TBSONElement.AddMongoJSON(W: TTextWriter; Mode: TMongoJSONMode);
label bin,regex;
begin
  case Kind of
  betFloat:
    W.AddDouble(PDouble(Element)^);
  betString, betJS, betDeprecatedSymbol: begin
    W.Add('"');
    W.AddJSONEscape(Data.Text,Data.TextLen);
    W.Add('"');
  end;
  betDoc, betArray:
    BSONListToJSON(Data.DocList,Kind,W,Mode);
  betObjectID: begin
    W.AddShort(BSON_JSON_OBJECTID[false,Mode]);
    W.AddBinToHex(Element,SizeOf(TBSONObjectID));
    W.AddShort(BSON_JSON_OBJECTID[true,Mode]);
  end;
  betDeprecatedUndefined:
    W.AddShort(BSON_JSON_UNDEFINED[Mode=modMongoShell]);
  betBinary:
    case Mode of
    modNoMongo:
      W.WrBase64(Data.Blob,Data.BlobLen,true);
    modMongoStrict: begin
      W.AddShort(BSON_JSON_BINARY[false,false]);
      W.WrBase64(Data.Blob,Data.BlobLen,false);
      W.AddShort(BSON_JSON_BINARY[false,true]);
      W.AddBinToHex(@Data.BlobSubType,1);
      W.AddShort('"}');
    end;
    modMongoShell: begin
      W.AddShort(BSON_JSON_BINARY[true,false]);
      W.AddBinToHex(@Data.BlobSubType,1);
      W.AddShort(BSON_JSON_BINARY[true,true]);
      W.WrBase64(Data.Blob,Data.BlobLen,false);
      W.AddShort('")');
    end;
    end;
  betRegEx:
    case Mode of
    modNoMongo:
bin:W.WrBase64(Element,ElementBytes,true);
    modMongoStrict:
      goto regex;
    modMongoShell:
      if (PosChar(Data.RegEx,'/')=nil) and
         (PosChar(Data.RegExOptions,'/')=nil) then begin
        W.Add('/');
        W.AddNoJSONEscape(Data.RegEx,Data.RegExLen);
        W.Add('/');
        W.AddNoJSONEscape(Data.RegExOptions,Data.RegExOptionsLen);
      end else begin
regex:  W.AddShort(BSON_JSON_REGEX[0]);
        W.AddJSONEscape(Data.RegEx,Data.RegExLen);
        W.AddShort(BSON_JSON_REGEX[1]);
        W.AddJSONEscape(Data.RegExOptions,Data.RegExOptionsLen);
        W.AddShort(BSON_JSON_REGEX[2]);
      end;
    end;
  betDeprecatedDbptr:
    goto bin; // no specific JSON construct for this deprecated item
  betJSScope:
    goto bin; // no specific JSON construct for this item yet
  betTimeStamp:
    goto bin; // internal content will always be written as raw binary
  betBoolean:
    W.Add(PBoolean(Element)^);
  betDateTime: begin
    W.AddShort(BSON_JSON_DATE[Mode,false]);
    W.AddUnixMSTime(Element,false);
    W.AddShort(BSON_JSON_DATE[Mode,true]);
  end;
  betNull:
    W.AddShort('null');
  betInt32:
    W.Add(PInteger(Element)^);
  betInt64:
    W.Add(PInt64(Element)^);
  betDecimal128: begin
    W.AddShort(BSON_JSON_DECIMAL[false,Mode]);
    PDecimal128(Element)^.AddText(W);
    W.AddShort(BSON_JSON_DECIMAL[true,Mode]);
  end;
  else
  if Kind=betMinKey then
    W.AddShort(BSON_JSON_MINKEY[Mode=modMongoShell]) else
  if Kind=betMaxKey then
    W.AddShort(BSON_JSON_MAXKEY[Mode=modMongoShell]) else
    raise EBSONException.CreateUTF8('TBSONElement.AddMongoJSON: unexpected type %',
      [ord(Kind)]);
  end;
end;

procedure TBSONElement.FromVariant(const aName: RawUTF8; const aValue: Variant;
  var aTemp: RawByteString);
const ELEMKIND: array[varEmpty..varWord64] of TBSONElementType = (
  betEOF, betNull, betInt32, betInt32, betFloat, betFloat, betFloat, betDateTime,
  betString, betEOF, betEOF, betBoolean, betEof, betEOF, betEOF, betEOF,
  betInt32, betInt32, betInt32, betInt64, betInt64, betInt64);
var aVarData: TVarData absolute aValue;
    aBson: TBSONVariantData absolute aValue;
    aDoc: TDocVariantData absolute aValue;
label str, st2;
begin
  if aVarData.VType=varByRef or varVariant then begin
    FromVariant(aName,PVariant(aVarData.VPointer)^,aTemp);
    exit;
  end;
  FillCharFast(self,sizeof(self),0);
  Name := pointer(aName);
  NameLen := length(aName);
  case aVarData.VType of
  0..varDate,varBoolean..high(ELEMKIND): begin // simple types
    Element := @Data.InternalStorage;
    Kind := ELEMKIND[aVarData.VType];
    case Kind of
    betFloat:
      PDouble(Element)^ := double(aValue);
    betDateTime:
      PUnixMSTime(Element)^ := DateTimeToUnixMSTime(aVarData.VDate);
    betBoolean:
      PBoolean(Element)^ := aVarData.VBoolean;
    betInt32:
      if not VariantToInteger(aValue,PInteger(Element)^) then
        raise EBSONException.Create('TBSONElement.FromVariant(betInt32)');
    betInt64:
      if not VariantToInt64(aValue,PInt64(Element)^) then
        raise EBSONException.Create('TBSONElement.FromVariant(betInt64)');
    end;
    ElementBytes := BSON_ELEMENTSIZE[Kind];
  end;
  varString:
    if (aVarData.VAny<>nil) and
       (PInteger(aVarData.VAny)^ and $ffffff=JSON_SQLDATE_MAGIC) and
       Iso8601CheckAndDecode(PUTF8Char(aVarData.VAny)+3,Length(RawUTF8(aVarData.VAny))-3,
         PDateTime(@Data.InternalStorage)^) then begin
      // recognized TTextWriter.AddDateTime(woDateTimeWithMagic) ISO-8601 format
      Element := @Data.InternalStorage;
      Kind := betDateTime;
      ElementBytes := BSON_ELEMENTSIZE[betDateTime];
    end else begin
      Kind := betString;
      Data.Text := aVarData.VAny;
      Data.TextLen := Length(RawUTF8(aVarData.VAny));
st2:  ElementBytes := Data.TextLen+1;
      if aVarData.VAny=nil then
        Data.InternalStorage := 1 else
        Element := nil; // special case handled by TBSONWriter.BSONWrite()
    end;
  {$ifdef HASVARUSTRING}
  varUString: begin
    RawUnicodeToUtf8(aVarData.VAny,length(UnicodeString(aVarData.VAny)),RawUTF8(aTemp));
    goto str;
  end;
  {$endif}
  varOleStr: begin
    RawUnicodeToUtf8(aVarData.VAny,length(WideString(aVarData.VAny)),RawUTF8(aTemp));
str:Kind := betString;
    Data.Text := pointer(aTemp);
    Data.TextLen := Length(aTemp);
    goto st2;
  end;
  else
  if aVarData.VType=BSONVariantType.VarType then begin
    Kind := aBson.VKind;
    case Kind of
    betObjectID: FromBSON(@aBson.VObjectID); // stored inlined 
    else         FromBSON(aBson.VBlob); // complex type stored as a RawByteString
    end;
    if ElementBytes<0 then
      raise EBSONException.CreateUTF8('TBSONElement.FromVariant(bson,%)',[ToText(Kind)^]);
  end else
  if aVarData.VType=DocVariantType.VarType then begin
    with TBSONWriter.Create(TRawByteStringStream) do // inlined BSON()   
    try
      BSONWriteDoc(aDoc);
      ToBSONDocument(aTemp);
    finally
      Free;
    end;
    if dvoIsObject in aDoc.Options then
      Kind := betDoc else
    if dvoIsArray in aDoc.Options then
      Kind := betArray else
      raise EBSONException.CreateUTF8('TBSONElement.FromVariant(doc,%)',[ToText(aDoc.Kind)^]);
    FromBSON(pointer(aTemp));
    if ElementBytes<0 then
      raise EBSONException.CreateUTF8('TBSONElement.FromVariant(docbson,%)',[ToText(Kind)^]);
  end else
    raise EBSONException.CreateUTF8('TBSONElement.FromVariant(VType=%)',[aVarData.VType]);
  end;
end;

function TBSONElement.FromDocument(const doc: TBSONDocument): boolean;
var n: Integer;
begin
  FillCharFast(self,sizeof(self),0);
  n := length(doc);
  if (n>=4) and (PInteger(doc)^=n) then begin
    Kind := betDoc;
    FromBSON(pointer(doc));
    result := true;
  end else
    result := false;
end;

const
  NULCHAR: AnsiChar = #0;

procedure TBSONElement.FromBSON(bson: PByte);
begin // see http://bsonspec.org/#/specification
  Element := bson;
  case Kind of // handle variable-size storage
  betString, betJS, betDeprecatedSymbol: begin  // "\x02" e_name string
    ElementBytes := PInteger(bson)^+sizeof(integer); // int32 (byte*) "\x00"
    Data.TextLen := PInteger(bson)^-1;
    inc(bson,sizeof(integer));
    Data.Text := pointer(bson);
  end;
  betDoc, betArray: begin  // "\x03" e_name document
    ElementBytes := PInteger(bson)^;
    inc(bson,sizeof(integer)); // points to a "e_list #0"
    Data.DocList := bson;
  end;
  betBinary: begin         // "\x05" e_name int32 subtype (byte*)
    ElementBytes := PInteger(bson)^+(sizeof(integer)+1);
    Data.BlobLen := PInteger(bson)^;
    inc(bson,sizeof(integer));
    Data.BlobSubType := TBSONElementBinaryType(bson^);
    inc(bson);
    Data.Blob := bson;
  end;
  betRegEx: begin          // "\x0B" e_name cstring cstring
    Data.RegEx := Element;
    Data.RegExLen := StrLen(Data.RegEx);
    Data.RegExOptions := Data.RegEx+Data.RegExLen+1;
    Data.RegExOptionsLen := StrLen(Data.RegExOptions);
    ElementBytes := Data.RegExLen+Data.RegExOptionsLen+2;
  end;
  betJSScope: begin       // "\x0F" e_name  int32 string document
    ElementBytes := PInteger(bson)^;
    inc(bson,sizeof(integer));
    Data.JavaScriptLen := PInteger(bson)^-1;
    inc(bson,sizeof(integer));
    Data.JavaScript := pointer(bson);
    inc(bson,Data.JavaScriptLen+1);
    Data.ScopeDocument := bson;
  end;
  else
    if Kind>high(BSON_ELEMENTSIZE) then // e.g. betMinKey betMaxKey
      ElementBytes := 0 else
      ElementBytes := BSON_ELEMENTSIZE[Kind]; // fixed size storage
  end;
end;

function TBSONElement.FromNext(var BSON: PByte): boolean;
begin
  if BSON=nil then begin
    result := false;
    exit;
  end;
  Kind := TBSONElementType(BSON^);
  case ord(Kind) of
  ord(betEOF):
    result := false;
  ord(betFloat)..ord(betDecimal128),ord(betMinKey),ord(betMaxKey): begin
    inc(BSON);
    Name := PUTF8Char(BSON);
    NameLen := StrLen(PUTF8Char(BSON));
    inc(BSON,NameLen+1);
    FromBSON(BSON);
    if ElementBytes<0 then
      raise EBSONException.CreateUTF8(
        'TBSONElement.FromNext: unexpected size % for type %',[ElementBytes,ord(Kind)]);
    inc(BSON,ElementBytes);
    inc(Index);
    result := true;
  end;
  else raise EBSONException.CreateUTF8('TBSONElement.FromNext: unexpected type %',
    [ord(Kind)]);
  end;
end;

function TBSONElement.FromSearch(BSON: PByte; const aName: RawUTF8): boolean;
begin
  result := true;
  while FromNext(BSON) do
    if IdemPropNameU(aName,Name,NameLen) then
      exit;
  result := false;
end;


{ TBSONIterator }

function TBSONIterator.Init(const doc: TBSONDocument; kind: TBSONElementType): boolean;
var n: integer;
begin
  FillCharFast(self,sizeof(self),0);
  n := length(doc);
  if (kind in [betDoc,betArray]) and (n>=4) and (PInteger(doc)^=n) then begin
    Item.Kind := kind;
    Item.FromBSON(pointer(doc));
    fBson := Item.Data.DocList;
    result := true;
  end else
    result := false;
end;

function TBSONIterator.Next: boolean;
begin
  result := Item.FromNext(fBson);
end;


function BSONParseLength(var BSON: PByte; ExpectedBSONLen: integer=0): integer;
begin
  if (BSON=nil) or
     ((ExpectedBSONLen<>0) and (PInteger(BSON)^<>ExpectedBSONLen)) then
     raise EBSONException.Create('Incorrect supplied BSON document content');
  result := PInteger(BSON)^;
  inc(PInteger(BSON));
end;

function BSONParseNextElement(var BSON: PByte; var name: RawUTF8; var element: variant;
  DocArrayConversion: TBSONDocArrayConversion=asBSONVariant): boolean;
var item: TBSONElement;
begin
  result := item.FromNext(BSON);
  if result then begin
    SetString(name,PAnsiChar(item.Name),item.NameLen);
    item.ToVariant(element,DocArrayConversion);
  end;
end;

function BSONPerIndexElement(BSON: PByte; index: integer; var item: TBSONElement): boolean;
begin
  result := true;
  if (index>=0) and (BSON<>nil) and (BSONParseLength(BSON)<>0) then
    while item.FromNext(BSON) do
      if index=0 then
        exit else
        dec(index);
  result := false;
end;

procedure BSONToDoc(BSON: PByte; var Result: Variant; ExpectedBSONLen: Integer;
  Option: TBSONDocArrayConversion);
begin
  if Option=asBSONVariant then
    raise EBSONException.Create('BSONToDoc(option=asBSONVariant) is not allowed');
  if TVarData(result).VType and VTYPE_STATIC<>0 then
    VarClear(result);
  BSONParseLength(BSON,ExpectedBSONLen);
  BSONItemsToDocVariant(betDoc,BSON,TDocVariantData(Result),Option);
end;

function BSONDocumentToDoc(const BSON: TBSONDocument; Option: TBSONDocArrayConversion): variant;
begin
  BSONToDoc(pointer(BSON),result,length(BSON));
end;

procedure BSONListToJSON(BSONList: PByte; Kind: TBSONElementType;
  W: TTextWriter; Mode: TMongoJSONMode);
var item: TBSONElement;
begin
  case Kind of
  betDoc:
    if BSONList^=byte(betEOF) then
      W.Add('{','}') else begin
      W.Add('{');
      while item.FromNext(BSONList) do begin
        if Mode=modMongoShell then begin
          W.AddNoJSONEscape(item.Name,item.NameLen);
          W.Add(':');
        end else
          W.AddFieldName(item.Name,item.NameLen);
        item.AddMongoJSON(W,Mode);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add('}');
    end;
  betArray: begin
    W.Add('[');
    while item.FromNext(BSONList) do begin
      item.AddMongoJSON(W,Mode);
      W.Add(',');
    end;
    W.CancelLastComma;
    W.Add(']');
  end;
  else raise EBSONException.CreateUTF8('BSONListToJSON(Kind=%)',[ord(Kind)]);
  end;
end;

function BSONDocumentToJSON(const BSON: TBSONDocument;
  Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
begin
  result := BSONToJSON(pointer(BSON),betDoc,length(BSON),Mode);
end;

function BSONToJSON(BSON: PByte; Kind: TBSONElementType; ExpectedBSONLen: integer;
  Mode: TMongoJSONMode): RawUTF8;
var W: TTextWriter;
begin
  BSONParseLength(BSON,ExpectedBSONLen);
  W := TTextWriter.CreateOwnedStream;
  try
    BSONListToJSON(BSON,Kind,W,Mode);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

procedure AddMongoJSON(const Value: variant; W: TTextWriter; Mode: TMongoJSONMode);
  procedure AddCustom;
  var item: TBSONElement;
      temp: RawByteString;
  begin
    item.FromVariant('',Value,temp);
    item.AddMongoJSON(W,Mode);
  end;
begin
  if TVarData(Value).VType<$10F then
    W.AddVariant(Value,twJSONEscape) else
    AddCustom;
end;

function VariantSaveMongoJSON(const Value: variant; Mode: TMongoJSONMode): RawUTF8;
var W: TTextWriter;
begin
  W := TTextWriter.CreateOwnedStream;
  try
    AddMongoJSON(Value,W,Mode);
    W.SetText(result);
  finally
    W.Free;
  end;
end;


{ TBSONWriter }

procedure TBSONWriter.CancelAll;
begin
  inherited;
  fDocumentCount := 0;
end;

procedure TBSONWriter.WriteCollectionName(Flags: integer; const CollectionName: RawUTF8);
begin
  Write4(Flags);
  if CollectionName='' then
    raise EBSONException.Create('Missing collection name');
  Write(pointer(CollectionName),length(CollectionName)+1); // +1 for #0
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; elemtype: TBSONElementType);
begin
  Write1(ord(elemtype));
  if name='' then
    write1(0) else // write only #0
    {$ifdef HASINLINE}
    Write(pointer(name),length(name)+1); // +1 for #0
    {$else}
    Write(pointer(name),PInteger(PtrInt(name)-sizeof(integer))^+1); // +1 for #0
    {$endif}
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: integer);
begin
  BSONWrite(name,betInt32);
  Write4(value);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: Double);
begin
  BSONWrite(name,betFloat);
  Write8(value);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: boolean);
begin
  BSONWrite(name,betBoolean);
  Write1(ord(value));
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: Int64);
begin
  if (value>=low(integer)) and (value<=high(integer)) then begin
    BSONWrite(name,betInt32);
    Write4(value);
  end else begin
    BSONWrite(name,betInt64);
    Write8(value);
  end;
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TBSONObjectID);
begin
  BSONWrite(name,betObjectID);
  Write(@value,sizeof(value));
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TDecimal128);
begin
  BSONWrite(name,betDecimal128);
  Write(@value,sizeof(value));
end;

procedure TBSONWriter.BSONWriteRegEx(const name: RawUTF8;
  const RegEx,Options: RawByteString);
begin
  BSONWrite(name,betRegEx); // cstring cstring
  Write(pointer(RegEx),length(RegEx));
  Write1(0);
  Write(pointer(Options),length(Options));
  Write1(0);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: RawUTF8;
  isJavaScript: boolean=false);
const TYP: array[boolean] of TBSONElementType = (betString,betJS);
var L: integer;
begin
  BSONWrite(name,TYP[isJavaScript]);
  L := length(value)+1; // +1 for ending #0
  Write4(L);
  if L=1 then
    Write1(0) else
    Write(pointer(value),L);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; value: PUTF8Char);
var L: integer;
begin
  BSONWrite(name,betString);
  L := StrLen(Value)+1;
  Write4(L);
  if L=1 then
    Write1(0) else
    Write(value,L);
end;

procedure TBSONWriter.BSONWriteString(const name: RawUTF8; value: PUTF8Char; valueLen: integer);
begin
  BSONWrite(name,betString);
  inc(valueLen);
  Write4(valueLen);
  if valueLen=1 then
    Write1(0) else
    Write(value,valueLen);
end;

procedure TBSONWriter.BSONWriteDateTime(const name: RawUTF8; const value: TDateTime);
var UnixTime: TUnixMSTime;
begin
  UnixTime := DateTimeToUnixMSTime(value);
  BSONWrite(name,betDateTime);
  Write8(UnixTime);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; Data: pointer; DataLen: integer);
begin
  BSONWrite(name,betBinary);
  Write4(DataLen);
  Write1(ord(bbtGeneric));
  Write(Data,DataLen);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const elem: TBSONElement);
begin
  BSONWrite(name,elem.Kind);
  if (elem.Element=nil) and // handle special case of TBSONElement.FromVariant()
     (elem.Kind in [betString,betJS,betDeprecatedSymbol]) then begin
    Write4(elem.Data.TextLen+1); // int32 (byte*) "\x00"
    Write(elem.Data.Text,elem.Data.TextLen+1);
  end else
    Write(elem.Element,elem.ElementBytes);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const bson: TBSONVariantData);
begin
  case bson.VKind of
  betObjectID:
    BSONWrite(name,bson.VObjectID);
  else begin
    BSONWrite(name,bson.VKind);
    WriteBinary(RawByteString(bson.VBlob));
  end;
  end;
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const doc: TDocVariantData);
begin
  if dvoIsObject in doc.Options then
    BSONWrite(name,betDoc) else
  if dvoIsArray in doc.Options then
    BSONWrite(name,betArray) else
    raise EBSONException.Create('Undefined nested document');
  BSONWriteDoc(doc);
end;

procedure TBSONWriter.BSONWriteArray(const kind: TBSONElementType);
begin
  BSONWrite(UInt32ToUtf8(fDocumentArray),kind);
  inc(fDocumentArray);
  if kind in [betDoc,betArray] then
    BSONDocumentBegin;
end;

procedure TBSONWriter.BSONDocumentBegin;
begin
  if fDocumentStack>=Length(fDocumentStackOffset) then
    SetLength(fDocumentStackOffset,fDocumentStack+fDocumentStack shr 3+16);
  fDocumentStackOffset[fDocumentStack] := TotalWritten;
  inc(fDocumentStack);
  Write4(0);
end;

procedure TBSONWriter.BSONDocumentBegin(const name: RawUTF8; kind: TBSONElementType);
begin
  if not (kind in [betDoc,betArray]) then
    raise EBSONException.Create('BSONDocumentBegin(?)');
  BSONWrite(name,kind);
  BSONDocumentBegin;
end;

procedure TBSONWriter.BSONDocumentBeginInArray(const name: RawUTF8; kind: TBSONElementType);
begin
  if fDocumentArray>0 then
    BSONDocumentEnd;
  BSONWriteArray(kind);
  BSONDocumentBegin(name);
end;

procedure TBSONWriter.BSONDocumentEnd(CloseNumber: integer; WriteEndingZero: boolean);
begin
  while CloseNumber>0 do begin
    if (CloseNumber>1) or WriteEndingZero then
      Write1(0);
    if fDocumentStack=0 then
      raise EBSONException.CreateUTF8('Unexpected %.BSONDocumentEnd',[self]);
    dec(fDocumentStack);
    if fDocumentCount>=Length(fDocument) then
      SetLength(fDocument,fDocumentCount+fDocumentCount shr 3+16);
    with fDocument[fDocumentCount] do begin
      Offset := fDocumentStackOffset[fDocumentStack];
      Length := TotalWritten-Offset;
    end;
    inc(fDocumentCount);
    dec(CloseNumber);
  end;
end;

procedure TBSONWriter.BSONAdjustDocumentsSize(BSON: PByteArray);
var i: Integer;
begin
  for i := 0 to fDocumentCount-1 do
  with fDocument[i] do
    PCardinal(@BSON[Offset])^ := Length;
end;

procedure TBSONWriter.ToBSONDocument(var result: TBSONDocument);
begin
  Flush;
  result := (Stream as TRawByteStringStream).DataString;
  BSONAdjustDocumentsSize(pointer(result));
end;

procedure TBSONWriter.ToBSONVariant(var result: variant; Kind: TBSONElementType);
var doc: TBSONDocument;
begin
  ToBSONDocument(doc);
  BSONVariantType.FromBSONDocument(doc,result,Kind);
end;

procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TVarRec);
var tmp: RawUTF8;
begin
  case value.VType of
    vtBoolean:  BSONWrite(name,value.VBoolean);
    vtInteger:  BSONWrite(name,value.VInteger);
    vtInt64:    BSONWrite(name,value.VInt64^);
    vtCurrency: BSONWrite(name,value.VCurrency^);
    vtExtended: BSONWrite(name,value.VExtended^);
    vtVariant:  BSONWriteVariant(name,value.VVariant^);
    vtString, vtAnsiString, {$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString: begin
      VarRecToUTF8(value,tmp);
      BSONWrite(name,tmp);
    end;
    else raise EBSONException.CreateUtf8(
      '%.BSONWrite(TVarRec.VType=%)',[self,value.VType]);
  end;
end;

procedure TBSONWriter.BSONWriteVariant(const name: RawUTF8; const value: variant);
  procedure WriteComplex;
  var temp: RawUTF8;
      JSON: PUTF8Char;
  begin
    with TVarData(value) do
    case VType of
    {$ifdef HASVARUSTRING}
    varUString: begin
      RawUnicodeToUtf8(VAny,length(UnicodeString(VAny)),temp);
      BSONWrite(Name,temp);
    end;
    {$endif}
    varOleStr: begin
      RawUnicodeToUtf8(VAny,length(WideString(VAny)),temp);
      BSONWrite(Name,temp);
    end;
    else begin
      VariantSaveJSON(value,twJSONEscape,temp);
      JSON := pointer(temp);
      BSONWriteFromJSON(name,JSON,nil);
      if JSON=nil then
        raise EBSONException.CreateUTF8('%.BSONWriteVariant(VType=%)',[self,VType]);
    end;
    end;
  end;
var dt: TDateTime;
begin
  with TVarData(value) do begin
    case VType of
    varEmpty,
    varNull:     BSONWrite(Name,betNull);
    varSmallint: BSONWrite(Name,VSmallInt);
    {$ifndef DELPHI5OROLDER}
    varShortInt: BSONWrite(Name,VShortInt);
    varWord:     BSONWrite(Name,VWord);
    varLongWord: BSONWrite(Name,VLongWord);
    {$endif}
    varByte:     BSONWrite(Name,VByte);
    varBoolean:  BSONWrite(Name,VBoolean);
    varInteger:  BSONWrite(Name,VInteger);
    varWord64,
    varInt64:    BSONWrite(Name,VInt64);
    varSingle:   BSONWrite(Name,VSingle);
    varDouble:   BSONWrite(Name,VDouble);
    varDate:     BSONWriteDateTime(Name,VDate);
    varCurrency: BSONWrite(Name,VCurrency);
    varString:
      if (VAny<>nil) and (PInteger(VAny)^ and $ffffff=JSON_SQLDATE_MAGIC) and
         Iso8601CheckAndDecode(PUTF8Char(VAny)+3,Length(RawUTF8(VAny))-3,dt) then
        // recognized TTextWriter.AddDateTime(woDateTimeWithMagic) ISO-8601 format
        BSONWriteDateTime(Name,dt) else
        BSONWrite(Name,RawUTF8(VAny)); // expect UTF-8 content
    else
    if VType=varByRef or varVariant then
      BSONWriteVariant(name,PVariant(VPointer)^) else
    if VType=BSONVariantType.VarType then
      BSONWrite(name,TBSONVariantData(value)) else
    if VType=DocVariantType.VarType then
      BSONWrite(name,TDocVariantData(value)) else
      WriteComplex;
    end;
  end;
end;

procedure TBSONWriter.BSONWriteDoc(const doc: TDocVariantData);
var Name: RawUTF8;
    i: integer;
begin
  BSONDocumentBegin;
  if TVarData(doc).VType>varNull then // null,empty will write {}
    if TVarData(doc).VType<>DocVariantType.VarType then
      raise EBSONException.CreateUTF8('%.BSONWriteDoc(VType=%)',
        [self,TVarData(doc).VType]) else
    for i := 0 to doc.Count-1 do begin
      if doc.Names<>nil then
        Name := doc.Names[i] else
        UInt32ToUtf8(i,Name);
      BSONWriteVariant(Name,doc.Values[i]);
      if TotalWritten>BSON_MAXDOCUMENTSIZE then
        raise EBSONException.CreateUTF8('%.BSONWriteDoc(size=%>max %)',
          [self,TotalWritten,BSON_MAXDOCUMENTSIZE]);
    end;
  BSONDocumentEnd;
end;

procedure TBSONWriter.BSONWriteProjection(const FieldNamesCSV: RawUTF8);
var FieldNames: TRawUTF8DynArray;
    i: integer;
begin
  CSVToRawUTF8DynArray(pointer(FieldNamesCSV),FieldNames);
  BSONDocumentBegin;
  for i := 0 to high(FieldNames) do
    BSONWrite(FieldNames[i],1);
  BSONDocumentEnd;
end;

function TBSONWriter.BSONWriteQueryOperator(name: RawUTF8; inverted: boolean;
  operator: TSynTableStatementOperator; const Value: variant): boolean;
const
  QUERY_OPS: array[opNotEqualTo..opIn] of RawUTF8 = (
    '$ne','$lt','$lte','$gt','$gte','$in');
  INVERT_OPS: array[opEqualTo..opGreaterThanOrEqualTo] of TSynTableStatementOperator = (
    opNotEqualTo,opEqualTo, opGreaterThanOrEqualTo,opGreaterThan,
    opLessThanOrEqualTo,opLessThan);
var wasString: boolean;
    like: RawUTF8;
    len: integer;
    doInvert: boolean;
begin
  result := false; // error on premature exit
  case Operator of
  // http://docs.mongodb.org/manual/faq/developers/#faq-developers-query-for-nulls
  // {$type:10} would return only existing fields, but our ODM do not insert
  // blobs by default -> do not use {$type:10} trick but plain {field:null}
  opIsNull:
    operator := opEqualTo;     // here Value=null
  opIsNotNull:
    operator := opNotEqualTo;  // here Value=null
  end;
  doInvert := false;
  if inverted then
    if operator<=high(INVERT_OPS) then
      operator := INVERT_OPS[operator] else begin
      doInvert := true;
      BSONDocumentBegin(name);
      name := '$not';
    end;
  case Operator of
  opEqualTo:
    BSONWriteVariant(name,Value);
  opNotEqualTo..opIn: begin
    BSONDocumentBegin(name);
    BSONWriteVariant(QUERY_OPS[operator],Value);
    BSONDocumentEnd;
  end;
  opLike: begin
    VariantToUTF8(Value,like,wasString);
    len := length(like);
    if (len=0) or not wasString then
      exit;
    if like[1]='%' then
      if len=1 then // LIKE '%' is invalid
        exit else
        if like[len]='%' then
          if len=2 then
            exit else // LIKE '%%' is invalid
            like := copy(like,2,len-2) else    // LIKE '%a%' -> /a/
          like := copy(like,2,len-1)+'$' else  // LIKE '%a'  -> /a$/
      if like[len]='%' then
        like := '^'+copy(like,1,len-1) else    // LIKE 'a%'  -> /^a/
        like := '^'+like+'$';                  // LIKE 'a'   -> /^a$/
    BSONWriteRegEx(name,like,'i'); // /like/i for case-insensitivity
  end;
  opContains: begin // http://docs.mongodb.org/manual/reference/operator/query/in
    BSONDocumentBegin(name);
    if _Safe(Value)^.Kind=dvArray then
      BSONWriteVariant(QUERY_OPS[opIn],Value) else begin
      BSONWrite(QUERY_OPS[opIn],betArray);
      BSONWriteArray([Value]);
    end;
    BSONDocumentEnd;
  end;
  else
    exit; // unhandled operator
  end;
  if doInvert then
    BSONDocumentEnd;
  result := true;
end;

procedure TBSONWriter.BSONWriteObject(const NameValuePairs: array of const);
var Name: RawUTF8;
    i: integer;
begin
  BSONDocumentBegin;
  for i := 0 to (length(NameValuePairs)shr 1)-1 do begin
    VarRecToUTF8(NameValuePairs[i*2],Name);
    BSONWrite(Name,NameValuePairs[i*2+1]);
  end;
  BSONDocumentEnd;
end;

procedure TBSONWriter.BSONWriteArray(const Items: array of const);
var i: integer;
begin
  BSONDocumentBegin;
  for i := 0 to high(Items) do
    BSONWrite(UInt32ToUtf8(i),Items[i]);
  BSONDocumentEnd;
end;

procedure TBSONWriter.BSONWriteArrayOfInteger(const Integers: array of integer);
var i: integer;
begin
  BSONDocumentBegin;
  for i := 0 to high(Integers) do
    BSONWrite(UInt32ToUtf8(i),Integers[i]);
  BSONDocumentEnd;
end;

procedure TBSONWriter.BSONWriteArrayOfInt64(const Integers: array of Int64);
var i: integer;
begin
  BSONDocumentBegin;
  for i := 0 to high(Integers) do
    BSONWrite(UInt32ToUtf8(i),Integers[i]);
  BSONDocumentEnd;
end;

procedure TBSONWriter.BSONWriteFromJSON(const name: RawUTF8; var JSON: PUTF8Char;
  EndOfObject: PUTF8Char; DoNotTryExtendedMongoSyntax: boolean);
var tmp: variant;
    blob: RawByteString;
    wasString: boolean;
    Value: PUTF8Char;
    ValueLen: integer;
    VDouble: double;
    ValueDateTime: TDateTime absolute VDouble;
    VInt64: Int64 absolute VDouble;
    Kind: TBSONElementType;
label dbl;
begin
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if not DoNotTryExtendedMongoSyntax and
     BSONVariantType.TryJSONToVariant(JSON,tmp,EndOfObject) then
    // was betDateTime, betObjectID or betRegEx, from strict or extended JSON
    BSONWriteVariant(name,tmp) else
    // try from simple types
    case JSON^ of
    #0: begin
      JSON := nil;
      exit;
    end;
    '[': begin // nested array
      BSONWrite(name,betArray);
      JSON := BSONWriteDocFromJSON(JSON,EndOfObject,Kind,DoNotTryExtendedMongoSyntax);
    end;
    '{': begin // nested document
      BSONWrite(name,betDoc);
      JSON := BSONWriteDocFromJSON(JSON,EndOfObject,Kind,DoNotTryExtendedMongoSyntax);
    end;
    else begin // simple types
      Value := GetJSONField(JSON,JSON,@wasString,EndOfObject,@ValueLen);
      if JSON=nil then
        JSON := @NULCHAR;
      if (Value=nil) or not wasString then
        if GetVariantFromNotStringJSON(Value,TVarData(tmp),true) then begin
          BSONWriteVariant(name,tmp); // null,boolean,Int64,double
          exit;
        end;
      // found no simple value -> check text value
      if Base64MagicCheckAndDecode(Value,ValueLen,blob) then
        // recognized '\uFFF0base64encodedbinary' pattern
        BSONWrite(name,pointer(blob),length(blob)) else
      if Iso8601CheckAndDecode(Value,ValueLen,ValueDateTime) then
        // recognized TTextWriter.AddDateTime() pattern
        BSONWriteDateTime(name,ValueDateTime) else
      if (PInteger(Value)^ and $ffffff=JSON_SQLDATE_MAGIC) and
         Iso8601CheckAndDecode(Value+3,ValueLen-3,ValueDateTime) then
        // recognized TTextWriter.AddDateTime(woDateTimeWithMagic) pattern
        BSONWriteDateTime(name,ValueDateTime) else
        // will point to the in-place escaped JSON text
        BSONWriteString(name,Value,ValueLen);
    end;
  end;
  if TotalWritten>BSON_MAXDOCUMENTSIZE then
    raise EBSONException.CreateUTF8('%.BSONWriteDoc(size=% > max=%)',
      [self,TotalWritten,BSON_MAXDOCUMENTSIZE]);
end;

function TBSONWriter.BSONWriteDocFromJSON(JSON: PUTF8Char; aEndOfObject: PUTF8Char;
  out Kind: TBSONElementType; DoNotTryExtendedMongoSyntax: boolean): PUTF8Char;
var ndx: cardinal;
    EndOfObject: AnsiChar;
    Name: RawUTF8;
begin
  result := nil;
  if JSON=nil then
    exit;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  case JSON^ of
  '[': begin
    Kind := betArray;
    BSONDocumentBegin;
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    ndx := 0;
    if JSON^=']' then
      inc(JSON) else
      repeat
        UInt32ToUtf8(ndx,Name);
        BSONWriteFromJSON(Name,JSON,@EndOfObject,DoNotTryExtendedMongoSyntax);
        if JSON=nil then
          exit; // invalid content
        inc(ndx);
      until EndOfObject=']';
  end;
  '{': begin
    Kind := betDoc;
    BSONDocumentBegin;
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if JSON^='}' then
      inc(JSON) else
      repeat
        // see http://docs.mongodb.org/manual/reference/mongodb-extended-json
        Name := GetJSONPropName(JSON); // BSON/JSON accepts "" as key name
        BSONWriteFromJSON(Name,JSON,@EndOfObject,DoNotTryExtendedMongoSyntax);
        if (JSON=nil) or (EndOfObject=#0) then
          exit; // invalid content
      until EndOfObject='}';
  end;
  'n','N':
    if IdemPChar(JSON+1,'ULL') then begin // append null as {}
      Kind := betDoc;
      BSONDocumentBegin;
      inc(JSON,4);
    end else
      exit;
  else exit;
  end;
  BSONDocumentEnd;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if aEndOfObject<>nil then
    aEndOfObject^ := JSON^;
  if JSON^<>#0 then
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
  result := JSON; // indicates successfully parsed
end;


{ TBSONObjectID }

var
  GlobalBSONObjectID: record
    Section: TRTLCriticalSection;
    Default: packed record
      Counter: cardinal;
      MachineID: TBSON24;
      ProcessID: word;
    end;
    LastCreateTime: cardinal;
    LastCounter: cardinal;
  end;

procedure InitBSONObjectIDComputeNew;
begin
  InitializeCriticalSection(GlobalBSONObjectID.Section);
  with GlobalBSONObjectID.Default do begin
    TAESPRNG.Main.FillRandom(@Counter,3);
    with ExeVersion do
      PCardinal(@MachineID)^ := crc32c(crc32c(0,pointer(Host),length(Host)),
        pointer(User),length(User));
    ProcessID := (ProcessID shl 8) xor TThreadID(MainThreadID);
  end;
end;

procedure TBSONObjectID.ComputeNew;
var now, count: cardinal;
begin
  with GlobalBSONObjectID do begin
    EnterCriticalSection(Section);
    now := UnixTimeUTC; // fast API call (no need of cache)
    if now>LastCreateTime then begin
      LastCreateTime := now;
      count := Default.Counter; // reset
    end else begin
      count := LastCounter+1;
      if count and $ffffff=Default.Counter then begin
        count := Default.Counter; // collision -> cheat on timestamp
        inc(LastCreateTime);
      end;
    end;
    Counter.b1 := count shr 16; // stored as bigendian
    Counter.b2 := count shr 8;
    Counter.b3 := count;
    LastCounter := count;
    UnixCreateTime := bswap32(LastCreateTime);
    MachineID := Default.MachineID;
    ProcessID := Default.ProcessID;
    LeaveCriticalSection(Section);
  end;
end;

function TBSONObjectID.Equal(const Another: TBSONObjectID): boolean;
begin
  result := (PIntegerArray(@Self)[2]=PIntegerArray(@Another)[2]) and
    {$ifdef CPU64}
    (PInt64(@Self)^=PInt64(@Another)^);
    {$else}
    (PIntegerArray(@Self)[1]=PIntegerArray(@Another)[1]) and
    (PIntegerArray(@Self)[0]=PIntegerArray(@Another)[0]);
    {$endif}
end;

function TBSONObjectID.CreateDateTime: TDateTime;
begin
  result := UnixTimeToDateTime(bswap32(UnixCreateTime));
end;

function TBSONObjectID.ToText: RawUTF8;
begin
  ToText(result);
end;

function TBSONObjectID.ToVariant: variant;
begin
  if TVarData(result).VType and VTYPE_STATIC<>0 then
    VarClear(result);
  with TBSONVariantData(result) do begin
    VType := BSONVariantType.VarType;
    VKind := betObjectID;
    VObjectID := self;
  end;
end;

function TBSONObjectID.FromText(const Text: RawUTF8): boolean;
begin
  if length(Text)=SizeOf(self)*2 then
    result := SynCommons.HexToBin(Pointer(Text),@self,SizeOf(self)) else
    result := false;
end;

function TBSONObjectID.FromText(Text: PUTF8Char): boolean;
begin
  result := SynCommons.HexToBin(Pointer(Text),@self,SizeOf(self));
end;

function TBSONObjectID.FromVariant(const value: variant): boolean;
var txt: RawUTF8;
    wasString: boolean;
    bson: TBSONVariantData absolute value;
begin
  if TVarData(value).VType=varByRef or varVariant then
    result := FromVariant(PVariant(TVarData(value).VPointer)^) else
  if (bson.VType=BSONVariantType.VarType) and (bson.VKind=betObjectID) then begin
    self := bson.VObjectID;
    result:= true;
  end else begin
    VariantToUTF8(value,txt,wasString);
    result := wasString and FromText(txt);
  end;
end;

procedure TBSONObjectID.ToText(var result: RawUTF8);
begin
  SetString(result,nil,sizeof(self)*2);
  SynCommons.BinToHex(@self,pointer(result),sizeof(self));
end;


{ TBSONVariant }

procedure TBSONVariant.ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind);
var item: TBSONElement;
    temp: RawByteString;
begin
  item.FromVariant('',Value,temp);
  item.AddMongoJSON(W,modMongoStrict);
end;

function TBSONVariant.GetNewDoc(const BSONDoc: TBSONDocument): variant;
begin
  FromBSONDocument(BSONDoc,result);
end;

function TBSONVariant.IsOfKind(const V: variant;
  Kind: TBSONElementType): boolean;
begin
  with TBSONVariantData(V) do
    if VType=varByRef or varVariant then
      result := IsOfKind(PVariant(TVarData(V).VPointer)^,Kind) else
      result := (self<>nil) and (VType=VarType) and (VKind=Kind);
end;

function TBSONVariant.ToBlob(const V: Variant; var Blob: RawByteString): boolean;
begin
  with TVarData(V) do
    if VType=varByRef or varVariant then begin
      result := ToBlob(PVariant(VPointer)^,Blob);
      exit;
     end;
  with TBSONVariantData(V) do begin
    result := (VType=VarType) and (VKind=betBinary);
    if result then
      if (VBlob=nil) or
         (PInteger(VBlob)^<>Length(RawByteString(VBlob))-(sizeof(integer)+1)) then
        Blob := '' else
        SetString(Blob,PAnsiChar(VBlob)+(sizeof(integer)+1),PInteger(VBlob)^);
  end;
end;

procedure TBSONVariant.FromBinary(const Bin: RawByteString;
  BinType: TBSONElementBinaryType; var result: variant);
var Len: integer;
begin // "\x05" e_name int32 subtype (byte*)
  with TBSONVariantData(result) do begin
    if VType and VTYPE_STATIC<>0 then
      VarClear(result);
    if Bin='' then begin
      VType := varNull; // stores a NULL
      exit;
    end;
    VType := VarType;
    VKind := betBinary;
    VBlob := nil; // avoid GPF here below
    Len := length(Bin);
    SetLength(RawByteString(VBlob),Len+(sizeof(integer)+1));
    PInteger(VBlob)^ := Len;
    PByteArray(VBlob)^[sizeof(integer)] := ord(BinType);
    MoveFast(pointer(Bin)^,PByteArray(VBlob)^[sizeof(integer)+1],Len);
  end;
end;

procedure TBSONVariant.FromBSONDocument(const BSONDoc: TBSONDocument;
  var result: variant; Kind: TBSONElementType);
begin
  with TBSONVariantData(result) do begin
    if VType and VTYPE_STATIC<>0 then
      VarClear(result);
    VType := VarType;
    VKind := Kind;
    VBlob := nil; // avoid GPF here below
    RawByteString(VBlob) := BSONDoc;
  end;
end;

procedure TBSONVariant.FromJSON(json: PUTF8Char; var result: variant);
begin
  if TVarData(result).VType and VTYPE_STATIC<>0 then
    VarClear(result);
  if json=nil then
    exit;
  if json^ in [#1..' '] then repeat inc(json) until not(json^ in [#1..' ']);
  if json^ in ['{','['] then
    with TBSONVariantData(result) do begin
      VType := VarType;
      VBlob := nil; // avoid GPF here below
      VKind := JSONBufferToBSONDocument(json,TBSONDocument(VBlob));
    end else
      VariantLoadJSON(result,json);
end;

function TBSONVariant.TryJSONToVariant(var JSON: PUTF8Char;
  var Value: variant; EndOfObject: PUTF8Char): boolean;
var bsonvalue: TBSONVariantData absolute Value;
    varvalue: TVarData absolute Value;
// warning: code should NOT modify JSON buffer in-place, unless it returns true
  procedure Return(kind: TBSONElementType; P: PUTF8Char; GotoEndOfObject: AnsiChar='}');
  begin
    if GotoEndOfObject<>#0 then
      while P^<>GotoEndOfObject do
      if P^=#0 then begin
        if kind in [betRegEx,betDecimal128] then
          RawByteString(bsonvalue.VBlob) := ''; // avoid memory leak
        exit;
      end else inc(P);
    P := GotoNextNotSpace(P+1);
    if EndOfObject<>nil then
      EndOfObject^ := P^;
    if P^<>#0 then
      JSON := P+1 else
      JSON := P;
    case kind of
    betObjectID, betRegEx, betDecimal128: begin // see TBSONWriter.BSONWrite()
      bsonvalue.VType := VarType;
      bsonvalue.VKind := kind;
    end;
    betDateTime:
      varvalue.VType := varDate;
    end;
    result := true;
  end;
  procedure TryDate(P: PUTF8Char; GotoEndOfObject: AnsiChar);
  var L: integer;
  begin
    P := GotoNextNotSpace(P);
    if GotoEndOfObject=')' then
      if (P^=')') then begin // new date() constructor
        varvalue.VDate := NowUTC;
        Return(betDateTime,P,#0);
        exit;
      end else
      if P^ in ['0'..'9'] then begin
        varvalue.VDate := GetNextItemDouble(P,')');
        if (varvalue.VDate<>0) and (P<>nil) then begin
          Return(betDateTime,P-1,#0);
          exit;
        end;
      end;
    if P^<>'"' then exit;
    if PCardinal(P)^=JSON_SQLDATE_MAGIC_QUOTE then
      inc(P,3); // ignore\uFFF1 code for DateTimeToSQL/TimeLogToSQL functions
    L := 1; while P[L]<>'"' do if P[L]<=' ' then exit else inc(L);
    Iso8601ToDateTimePUTF8CharVar(P+1,L,varvalue.VDate);
    if varvalue.VDate<>0 then
      Return(betDateTime,P+L+1,GotoEndOfObject);
  end;
  procedure TryObjectID(P: PUTF8Char; GotoEndOfObject: AnsiChar);
  begin
    P := GotoNextNotSpace(P);
    if (GotoEndOfObject=')') and (P^=')') then begin // ObjectId() constructor
      bsonvalue.VObjectID.ComputeNew;
      Return(betObjectID,P,#0);
      exit;
    end;
    if P^<>'"' then exit;
    if bsonvalue.VObjectID.FromText(P+1) then
      Return(betObjectID,P+25,GotoEndOfObject);
  end;
  procedure TryDecimal(P: PUTF8Char; GotoEndOfObject: AnsiChar);
  var dec: TDecimal128;
      L: integer;
  begin
    if P^<>'"' then exit;
    inc(P);
    L := 0;
    while P[L]<>'"' do
      if not(P[L] in ['0'..'9','e','E','+','-','.']) then exit else inc(L);
    if dec.FromText(P,L)=dsvError then
      exit;                             
    bsonvalue.VBlob := nil; // avoid GPF
    SetString(RawByteString(bsonvalue.VBlob),PAnsiChar(@dec),sizeof(TDecimal128));
    Return(betDecimal128,P+L+1,GotoEndOfObject);
  end;
  var Reg,Opt: PUTF8Char;
      RegLen,OptLen: Integer;
  procedure ReturnRegEx(P: PUTF8Char; GotoEndOfObject: AnsiChar);
  var buf: PAnsiChar;
  begin
    bsonvalue.VBlob := nil; // avoid GPF
    SetString(RawByteString(bsonvalue.VBlob),nil,RegLen+OptLen+2);
    buf := bsonvalue.VBlob;
    MoveFast(Reg^,buf^,RegLen); inc(buf,RegLen); buf^ := #0; inc(buf);
    MoveFast(Opt^,buf^,OptLen); inc(buf,OptLen); buf^ := #0;
    Return(betRegEx,P,GotoEndOfObject);
  end;
  procedure TryRegExShell(P: PUTF8Char);
  begin
    RegLen := 0; while P[RegLen]<>'/' do if P[RegLen]<=' ' then exit else inc(RegLen);
    Reg := P;
    inc(P,RegLen);
    if P^<>'/' then exit else inc(P);
    OptLen := 0; while ord(P[OptLen]) in IsWord do inc(OptLen);
    if P[OptLen]=#0 then exit;
    Opt := P;
    ReturnRegEx(Opt+OptLen-1,#0);
  end;
  procedure TryRegExStrict(P: PUTF8Char);
  begin // warning: this won't escape double quotes...
    P := GotoNextNotSpace(P);
    if P^<>'"' then exit else inc(P);
    RegLen := 0; while P[RegLen]<>'"' do if P[RegLen]<=' ' then exit else inc(RegLen);
    Reg := P;
    P := GotoNextNotSpace(Reg+RegLen+1);
    if P^<>',' then Exit; // $regex:"acme*.corp",$options:"i"}
    P := GotoNextNotSpace(P+1);
    if P^='"' then inc(P);
    if not CompareMem(P,@BSON_JSON_REGEX[1][4],8) then exit else inc(P,8);
    if P^='"' then inc(P);
    P := GotoNextNotSpace(P);
    if P^<>':' then exit;
    P := GotoNextNotSpace(P+1);
    if P^<>'"' then exit else inc(P);
    OptLen := 0; while P[OptLen]<>'"' do if P[OptLen]<=' ' then exit else inc(OptLen);
    Opt := P;
    ReturnRegEx(Opt+OptLen+1,'}');
  end;
var P: PUTF8Char;
begin // here JSON does not start with " or 1..9 (obvious simple types)
  // see http://docs.mongodb.org/manual/reference/mongodb-extended-json
  result := false;
  case NormToUpperAnsi7[JSON^] of
  '{': begin // strict MongoDB objects e.g. {"$undefined":true} or {"$oid":".."}
    P := JSON;
    repeat inc(P) until not(P^ in [#1..' ']);
    if P^<>'"' then exit;
    repeat inc(P) until not(P^ in [#1..' ']);
    if P[0]='$' then
    case P[1] of
    'u': if CompareMem(P+2,@BSON_JSON_UNDEFINED[false][5],10) then
           Return(betDeprecatedUndefined,P+12);
    'm': if CompareMem(P+2,@BSON_JSON_MINKEY[false][5],7) then
           Return(betMinKey,P+9) else
         if CompareMem(P+2,@BSON_JSON_MAXKEY[false][5],7) then
           Return(betMaxKey,P+9);
    'o': if CompareMem(P+2,@BSON_JSON_OBJECTID[false,modMongoStrict][5],4) then
           TryObjectID(P+6,'}');
    'd': if CompareMem(P+2,@BSON_JSON_DATE[modMongoStrict,false][5],5) then
           TryDate(P+7,'}');
    'r': if CompareMem(P+2,@BSON_JSON_REGEX[0][5],6) then
           TryRegExStrict(P+8);
    'n': if CompareMem(P+2,@BSON_JSON_DECIMAL[false,modMongoStrict][5],14) then
           TryDecimal(P+16,'}');
    end;
  end;
  // MongoDB Shell Mode extended syntax
  'U': if StrCompIL(JSON+1,@BSON_JSON_UNDEFINED[true][2],8)=0 then
         Return(betDeprecatedUndefined,JSON+8,#0);
  'M': if StrCompIL(JSON+1,@BSON_JSON_MINKEY[true][2],5)=0 then
         Return(betMinKey,JSON+5,#0) else
       if StrCompIL(JSON+1,@BSON_JSON_MAXKEY[true][2],7)=0 then
         Return(betMaxKey,JSON+5,#0);
  'O': if StrCompIL(JSON+1,@BSON_JSON_OBJECTID[false,modMongoShell][2],8)=0 then
         TryObjectID(JSON+9,')');
  'N': if StrCompIL(JSON+1,'ew Date(',8)=0 then
          TryDate(JSON+9,')') else
       if StrCompIL(JSON+1,@BSON_JSON_DECIMAL[false,modMongoShell][2],13)=0 then
          TryDecimal(JSON+14,')');
  'I': if StrCompIL(JSON+1,@BSON_JSON_DATE[modMongoShell,false][2],7)=0 then
          TryDate(JSON+8,')');
  '/': TryRegExShell(JSON+1);
  end;
end;

procedure TBSONVariant.Cast(var Dest: TVarData; const Source: TVarData);
begin
  CastTo(Dest,Source,VarType);
end;

procedure TBSONVariant.CastTo(var Dest: TVarData;
  const Source: TVarData; const AVarType: TVarType);
var tmp: RawUTF8;
    wasString: boolean;
begin
  if AVarType=VarType then begin
    VariantToUTF8(Variant(Source),tmp,wasString);
    if wasString then begin
      if Dest.VType and VTYPE_STATIC<>0 then
        VarClear(variant(Dest));
      if TBSONVariantData(Dest).VObjectID.FromText(tmp) then begin
        Dest.VType := VarType;
        TBSONVariantData(Dest).VKind := betObjectID;
        exit;
      end;
      variant(Dest) := BSONVariant(tmp); // convert from JSON text
      exit;
    end;
    RaiseCastError;
  end else begin
    if Source.VType<>VarType then
      RaiseCastError;
    with TBSONVariantData(Source) do
      if (VKind=betObjectID) and (AVarType in [varDate,varDouble]) then begin
        Dest.VType := AVarType;
        Dest.VDate := VObjectID.CreateDateTime;
        exit;
      end else begin
        if VKind=betObjectID then
          VObjectID.ToText(tmp) else
          tmp := VariantSaveMongoJSON(variant(Source),modMongoShell);
        RawUTF8ToVariant(tmp,Dest,AVarType); // convert to JSON text
      end;
  end;
end;

procedure TBSONVariant.Clear(var V: TVarData);
begin
  if TBSONVariantData(V).VKind in BSON_ELEMENTVARIANTMANAGED then
    RawByteString(TBSONVariantData(V).VBlob) := '';
  ZeroFill(@V); // will set V.VType := varEmpty
end;

procedure TBSONVariant.Copy(var Dest: TVarData;
  const Source: TVarData; const Indirect: Boolean);
begin
  if Indirect then
    SimplisticCopy(Dest,Source,true) else begin
    if Dest.VType and VTYPE_STATIC<>0 then
      VarClear(variant(Dest)); // Dest may be a complex type
    Dest := Source;
    with TBSONVariantData(Dest) do
    if VKind in BSON_ELEMENTVARIANTMANAGED then begin
      VBlob := nil; // avoid GPF
      RawByteString(VBlob) := RawByteString(TBSONVariantData(Source).VBlob);
    end;
  end;
end;

procedure TBSONVariant.Compare(const Left, Right: TVarData;
  var Relationship: TVarCompareResult);
var res: integer;
    LeftU,RightU: RawUTF8;
begin
  LeftU := VariantSaveMongoJSON(variant(Left),modMongoStrict);
  RightU := VariantSaveMongoJSON(variant(Right),modMongoStrict);
  if LeftU=RightU then
    Relationship := crEqual else begin
    res := StrComp(pointer(LeftU),pointer(RightU));
    if res<0 then
      Relationship := crLessThan else
    if res>0 then
      Relationship := crGreaterThan else
      Relationship := crEqual;
  end;
end;


{ main BSON* functions }

function ToText(kind: TBSONElementType): PShortString;
begin
  result := GetEnumName(TypeInfo(TBSONElementType),ord(kind));
end;

function ObjectID: variant;
var ID: TBSONObjectID;
begin
  ID.ComputeNew;
  result := ID.ToVariant;
end;

function ObjectID(const Hexa: RaWUTF8): variant;
var ID: TBSONObjectID;
begin
  if ID.FromText(Hexa) then
    result := ID.ToVariant else
    raise EBSONException.CreateUTF8('Invalid ObjectID("%")',[Hexa]);
end;

function BSONObjectID(const aObjectID: variant): TBSONObjectID;
begin
  if not result.FromVariant(aObjectID) then
    raise EBSONException.Create('BSONObjectID() over not ObjectID variant');
end;

function JavaScript(const JS: RawUTF8): variant;
begin
  with TBSONVariantData(result) do begin
    if VType and VTYPE_STATIC<>0 then
      VarClear(result);
    VType := BSONVariantType.VarType;
    VKind := betJS;
    VText := nil; // avoid GPF
    RawUTF8(VText) := JS;
  end;
end;

function JavaScript(const JS: RawUTF8; const Scope: TBSONDocument): variant;
var Len, JSLen: integer;
begin
  with TBSONVariantData(result) do begin
    if VType and VTYPE_STATIC<>0 then
      VarClear(result);
    VType := BSONVariantType.VarType;
    VKind := betJSScope;
    JSLen := Length(JS)+1;                        // string = int32 text#0
    Len := SizeOf(integer)*2+JSLen+length(Scope); // int32 string document
    VBlob := nil; // avoid GPF
    SetLength(RawByteString(VBlob),Len);
    PIntegerArray(VBlob)^[0] := Len;              // length:int32
    PIntegerArray(VBlob)^[1] := JSLen;            // string:int32
    MoveFast(pointer(JS)^,PAnsiChar(VBlob)[8],JSLen); // string:text#0
    MoveFast(pointer(Scope)^,PAnsiChar(VBlob)[8+JSLen],Length(Scope)); // document
  end;
end;

function NumberDecimal(const Value: RawUTF8): variant;
var dec: TDecimal128;
begin
  if dec.FromText(Value)=dsvError then
    raise EBSONException.CreateUTF8('Invalid NumberDecimal("%")',[Value]);
  dec.ToVariant(result);
end;

function NumberDecimal(const Value: currency): variant;
var dec: TDecimal128;
begin
  dec.FromCurr(Value);
  dec.ToVariant(result);
end;

function BSON(const doc: TDocVariantData): TBSONDocument;
begin
  if TVarData(doc).VType=varVariant or varByRef then begin
    result := BSON(PDocVariantData(TVarData(doc).VPointer)^);
    exit;
  end;
  if TVarData(doc).VType<>DocVariantType.VarType then
    raise EBSONException.Create('doc is not a TDocVariant');
  with TBSONWriter.Create(TRawByteStringStream) do
  try
    BSONWriteDoc(doc);
    ToBSONDocument(result);
  finally
    Free;
  end;
end;

function BSONFromIntegers(const Integers: array of integer): TBSONDocument;
begin
  with TBSONWriter.Create(TRawByteStringStream) do
  try
    BSONWriteArrayOfInteger(Integers);
    ToBSONDocument(result);
  finally
    Free;
  end;
end;

function BSONFromInt64s(const Integers: array of Int64): TBSONDocument;
begin
  with TBSONWriter.Create(TRawByteStringStream) do
  try
    BSONWriteArrayOfInt64(Integers);
    ToBSONDocument(result);
  finally
    Free;
  end;
end;

function BSON(const NameValuePairs: array of const): TBSONDocument;
var W: TBSONWriter;
    name: RawUTF8;
    a: Integer;
procedure WriteValue;
var ndx: cardinal;
begin
  case VarRecAsChar(NameValuePairs[a]) of
  ord('['): begin
    W.BSONDocumentBegin(name,betArray);
    ndx := 0;
    repeat
      inc(a);
      if VarRecAsChar(NameValuePairs[a])=ord(']') then
        break;
      UInt32ToUtf8(ndx,name);
      WriteValue;
      inc(ndx);
    until a=high(NameValuePairs);
    W.BSONDocumentEnd;
  end;
  ord('{'): begin
    W.BSONDocumentBegin(name,betDoc);
    repeat
      inc(a);
      VarRecToUTF8(NameValuePairs[a],name);
      if (a=high(NameValuePairs)) or (name='}') then
        break;
      inc(a);
      WriteValue;
    until a=high(NameValuePairs);
    W.BSONDocumentEnd;
  end else
    W.BSONWrite(name,NameValuePairs[a]);
  end;
end;
begin
  W := TBSONWriter.Create(TRawByteStringStream);
  try
    W.BSONDocumentBegin;
    a := 0;
    while a<high(NameValuePairs) do begin
      VarRecToUTF8(NameValuePairs[a],name);
      inc(a);
      WriteValue;
      inc(a);
    end;
    W.BSONDocumentEnd;
    W.ToBSONDocument(result);
  finally
    W.Free;
  end;
end;

function BSONFieldSelector(const FieldNames: array of RawUTF8): TBSONDocument;
var i: integer;
    W: TBSONWriter;
begin
  W := TBSONWriter.Create(TRawByteStringStream,512);
  try
    W.BSONDocumentBegin;
    for i := 0 to high(FieldNames) do
      W.BSONWrite(FieldNames[i],1);
    W.BSONDocumentEnd;
    W.ToBSONDocument(result);
  finally
    W.Free;
  end;
end;

function BSONFieldSelector(const FieldNamesCSV: RawUTF8): TBSONDocument;
var FieldNames: TRawUTF8DynArray;
begin
  CSVToRawUTF8DynArray(pointer(FieldNamesCSV),FieldNames);
  result := BSONFieldSelector(FieldNames);
end;

function JSONBufferToBSONDocument(JSON: PUTF8Char; var doc: TBSONDocument;
  DoNotTryExtendedMongoSyntax: boolean): TBSONElementType;
var W: TBSONWriter;
begin
  W := TBSONWriter.Create(TRawByteStringStream);
  try
    W.BSONWriteDocFromJSON(JSON,nil,result,DoNotTryExtendedMongoSyntax);
    W.ToBSONDocument(doc);
  finally
    W.Free;
  end;
end;

function JSONBufferToBSONArray(JSON: PUTF8Char; out docs: TBSONDocumentDynArray;
  DoNotTryExtendedMongoSyntax: boolean): boolean;
var W: TBSONWriter;
    doc: TBSONDocument;
    EndOfObject: AnsiChar;
    Kind: TBSONElementType;
    n: integer;
begin
  result := false;
  if JSON=nil then
    exit;
  JSON := GotoNextNotSpace(JSON);
  if JSON^<>'[' then
    exit;
  JSON := GotoNextNotSpace(JSON+1);
  n := 0;
  W := TBSONWriter.Create(TRawByteStringStream,16384);
  try
    repeat
      JSON := W.BSONWriteDocFromJSON(JSON,@EndOfObject,Kind,DoNotTryExtendedMongoSyntax);
      if JSON=nil then
        exit;
      W.ToBSONDocument(doc);
      if n>=length(docs) then
        SetLength(docs,n+64+length(docs) shr 3);
      docs[n] := doc;
      inc(n);
      W.CancelAll;
    until EndOfObject=']';
  finally
    W.Free;
  end;
  SetLength(docs,n);
  result := true;
end;

function BSON(const Format: RawUTF8; const Args,Params: array of const;
  kind: PBSONElementType): TBSONDocument;
var JSON: RawUTF8; // since we use FormatUTF8(), TSynTempBuffer is useless here
    v: variant;
    k: TBSONElementType;
begin
  if (Format='?') and (high(Params)>=0) then begin
    VarRecToVariant(Params[0],v);
    if DocVariantType.IsOfType(v) then begin
      result := BSON(TDocVariantData(v));
      if kind<>nil then
        if TDocVariantData(v).Kind=dvArray then
          kind^ := betArray else
          kind^ := betDoc;
      exit;
    end;
  end;
  JSON := FormatUTF8(Format,Args,Params,true);
  UniqueRawUTF8(JSON); // ensure Format is untouched if Args=[] 
  k := JSONBufferToBSONDocument(pointer(JSON),result);
  if kind<>nil then
    kind^ := k;
end;

function BSON(const JSON: RawUTF8; kind: PBSONElementType): TBSONDocument;
var tmp: TSynTempBuffer;
    k: TBSONElementType;
begin
  tmp.Init(JSON);
  try
    k := JSONBufferToBSONDocument(tmp.buf,result);
    if kind<>nil then
      kind^ := k;
  finally
    tmp.Done;
  end;
end;

function BSONVariant(const NameValuePairs: array of const): variant;
begin
  BSONVariantType.FromBSONDocument(BSON(NameValuePairs),result,betDoc);
end;

function BSONVariant(const JSON: RawUTF8): variant;
var k: TBSONElementType;
    b: RawByteString;
begin
  b := BSON(JSON,@k);
  BSONVariantType.FromBSONDocument(b,result,k);
end;

procedure BSONVariant(JSON: PUTF8Char; var result: variant);
var tmp: TBSONDocument;
begin
  JSONBufferToBSONDocument(JSON,tmp);
  BSONVariantType.FromBSONDocument(tmp,result);
end;

function BSONVariant(const Format: RawUTF8; const Args,Params: array of const): variant; overload;
var k: TBSONElementType;
    b: RawByteString;
begin
  b := BSON(Format,Args,Params,@k);
  BSONVariantType.FromBSONDocument(b,result,k);
end;

function BSONVariant(doc: TDocVariantData): variant; overload;
var k: TBSONElementType;
begin
  if doc.Kind=dvArray then
    k := betArray else
    k := betDoc;
  BSONVariantType.FromBSONDocument(BSON(Doc),result,k);
end;

function BSONVariantFieldSelector(const FieldNames: array of RawUTF8): variant;
begin
  BSONVariantType.FromBSONDocument(BSONFieldSelector(FieldNames),result);
end;

function BSONVariantFieldSelector(const FieldNamesCSV: RawUTF8): variant;
begin
  BSONVariantType.FromBSONDocument(BSONFieldSelector(FieldNamesCSV),result);
end;

function BSONVariantFromIntegers(const Integers: array of integer): variant;
begin
  BSONVariantType.FromBSONDocument(BSONFromIntegers(Integers),result,betArray);
end;

function BSONVariantFromInt64s(const Integers: array of Int64): variant;
begin
  BSONVariantType.FromBSONDocument(BSONFromInt64s(Integers),result,betArray);
end;


{ ************ MongoDB client }

{ TMongoRequest }

const
  WIRE_OPCODES: array[TMongoOperation] of integer = (
   1, 1000, 2001, 2002, 2004, 2005, 2006, 2007);
  CLIENT_OPCODES = [opUpdate,opInsert,opQuery,opGetMore,opDelete,opKillCursors];

var
  GlobalRequestID: Integer;

constructor TMongoRequest.Create(const FullCollectionName: RawUTF8;
  opCode: TMongoOperation; requestID, responseTo: Integer);
begin
  if not (opCode in CLIENT_OPCODES) then
    raise EMongoException.CreateUTF8('Unexpected %.Create(opCode=%)',
      [self,GetEnumName(TypeInfo(TMongoOperation),ord(opCode))^]);
  inherited Create(TRawByteStringStream);
  fFullCollectionName := FullCollectionName;
  Split(fFullCollectionName,'.',fDatabaseName,fCollectionName);
  if requestID=0 then
    fRequestID := InterlockedIncrement(GlobalRequestID) else
    fRequestID := requestID;
  fResponseTo := responseTo;
  BSONDocumentBegin;
  fRequestOpCode := opCode;
  Write4(fRequestID);
  Write4(fResponseTo);
  Write4(WIRE_OPCODES[opCode]);
end;

procedure TMongoRequest.BSONWriteParam(const paramDoc: variant);
begin
  if TVarData(paramDoc).VType=varByRef or varVariant then
    BSONWriteParam(PVariant(TVarData(paramDoc).VPointer)^) else
  if VarIsStr(paramDoc) then
    BSONWriteProjection(VariantToUTF8(paramDoc)) else
  if (TVarData(paramDoc).VType=BSONVariantType.VarType) and
     (TBSONVariantData(paramDoc).VKind in [betDoc,betArray]) and
     (TBSONVariantData(paramDoc).VBlob<>nil) then
    WriteBinary(RawByteString(TBSONVariantData(paramDoc).VBlob)) else
    BSONWriteDoc(TDocVariantData(paramDoc)); // for TDocVariant or null
end;

procedure TMongoRequest.ToBSONDocument(var result: TBSONDocument);
begin
  if (fRequestID=0) or (fRequestOpCode=opReply) then
    raise EMongoException.CreateUTF8('No previous proper %.Create() call',[self]);
  if fBSONDocument='' then begin
    BSONDocumentEnd(1,false);
    inherited ToBSONDocument(fBSONDocument);
  end;
  result := fBSONDocument;
end;

procedure TMongoRequest.ToJSON(W: TTextWriter; Mode: TMongoJSONMode);
begin
  if self=nil then begin
    W.AddShort('null');
    exit;
  end;
  W.Add('{');
  W.AddShort('collection:"');
  W.AddJSONEscape(pointer(fFullCollectionName));
  W.AddShort('",opCode:');
  W.AddTypedJSON(TypeInfo(TMongoOperation),fRequestOpCode);
  W.AddShort(',requestID:');
  W.AddU(fRequestID);
  if fResponseTo<>0 then begin
    W.AddShort(',responseTo:');
    W.AddU(fResponseTo);
  end;
  W.Add('}');
end;

function TMongoRequest.ToJSON(Mode: TMongoJSONMode): RawUTF8;
var W: TTextWriter;
begin
  W := TTextWriter.CreateOwnedStream;
  try
    ToJSON(W,Mode);
    W.SetText(result);
  finally
    W.Free;
  end;
end;


{ TMongoRequestUpdate }

constructor TMongoRequestUpdate.Create(const FullCollectionName: RawUTF8;
  const Selector, Update: variant; Flags: TMongoUpdateFlags);
begin
  inherited Create(FullCollectionName,opUpdate,0,0);
  fSelector := TVarData(Selector);
  fUpdate := TVarData(Update);
  WriteCollectionName(0,FullCollectionName);
  Write4(byte(Flags));
  BSONWriteParam(Selector);
  BSONWriteParam(Update);
end;

procedure TMongoRequestUpdate.ToJSON(W: TTextWriter; Mode: TMongoJSONMode);
begin
  inherited;
  W.CancelLastChar('}');
  W.AddShort(',selector:');
  AddMongoJSON(variant(fSelector),W,modMongoShell);
  W.AddShort(',update:');
  AddMongoJSON(variant(fUpdate),W,modMongoShell);
  W.Add('}');
end;

{ TMongoRequestInsert }

constructor TMongoRequestInsert.Create(const FullCollectionName: RawUTF8;
  const Documents: array of variant; Flags: TMongoInsertFlags=[]);
var i: integer;
begin
  inherited Create(FullCollectionName,opInsert,0,0);
  WriteCollectionName(byte(Flags),FullCollectionName);
  for i := 0 to high(Documents) do
    BSONWriteParam(Documents[i]);
end;

constructor TMongoRequestInsert.Create(const FullCollectionName: RawUTF8;
  const Documents: TBSONDocument; Flags: TMongoInsertFlags=[]);
begin
  inherited Create(FullCollectionName,opInsert,0,0);
  WriteCollectionName(byte(Flags),FullCollectionName);
  Write(pointer(Documents),Length(Documents));
end;

constructor TMongoRequestInsert.Create(const FullCollectionName: RawUTF8;
  const JSONDocuments: array of PUTF8Char; Flags: TMongoInsertFlags=[]);
var i: integer;
    kind: TBSONElementType;
begin
  inherited Create(FullCollectionName,opInsert,0,0);
  WriteCollectionName(byte(Flags),FullCollectionName);
  for i := 0 to high(JSONDocuments) do
    BSONWriteDocFromJSON(JSONDocuments[i],nil,kind);
end;

{ TMongoRequestDelete }

constructor TMongoRequestDelete.Create(const FullCollectionName: RawUTF8;
  const Selector: variant; Flags: TMongoDeleteFlags=[]);
begin
  inherited Create(FullCollectionName,opDelete,0,0);
  fQuery := TVarData(Selector);
  WriteCollectionName(byte(Flags),FullCollectionName);
  Write4(byte(Flags));
  BSONWriteParam(Selector);
end;

procedure TMongoRequestDelete.ToJSON(W: TTextWriter; Mode: TMongoJSONMode);
begin
  inherited;
  W.CancelLastChar('}');
  W.AddShort(',query:');
  AddMongoJSON(variant(fQuery),W,modMongoShell);
  W.Add('}');
end;

{ TMongoRequestQuery }

constructor TMongoRequestQuery.Create(const FullCollectionName: RawUTF8;
  const Query, ReturnFieldsSelector: variant; NumberToReturn: integer;
  NumberToSkip: Integer=0; Flags: TMongoQueryFlags=[]);
begin
  inherited Create(FullCollectionName,opQuery,0,0);
  fNumberToReturn := NumberToReturn;
  fNumberToSkip := NumberToSkip;
  fQuery := TVarData(Query);
  fReturnFieldsSelector := TVarData(ReturnFieldsSelector);
  WriteCollectionName(byte(Flags),FullCollectionName);
  Write4(NumberToSkip);
  Write4(NumberToReturn);
  BSONWriteParam(Query);
  if TVarData(ReturnFieldsSelector).VType>varNull then
    BSONWriteParam(ReturnFieldsSelector);
end;

procedure TMongoRequestQuery.ToJSON(W: TTextWriter; Mode: TMongoJSONMode);
begin
  inherited;
  W.CancelLastChar('}');
  W.AddShort(',query:');
  AddMongoJSON(variant(fQuery),W,modMongoShell);
  if fReturnFieldsSelector.VType<>varNull then begin
    W.AddShort(',projection:');
    AddMongoJSON(variant(fReturnFieldsSelector),W,modMongoShell);
  end;
  if fNumberToReturn<maxInt then begin
    W.AddShort(',numberToReturn:');
    W.Add(fNumberToReturn);
  end;
  if fNumberToSkip>0 then begin
    W.AddShort(',numberToSkip:');
    W.AddU(fNumberToSkip);
  end;
  W.Add('}');
end;

{ TMongoRequestGetMore }

constructor TMongoRequestGetMore.Create(const FullCollectionName: RawUTF8;
  NumberToReturn: integer; CursorID: Int64);
begin
  inherited Create(FullCollectionName,opGetMore,0,0);
  WriteCollectionName(0,FullCollectionName);
  Write4(NumberToReturn);
  Write8(CursorID);
end;

{ TMongoRequestKillCursor }

constructor TMongoRequestKillCursor.Create(const FullCollectionName: RawUTF8;
  const CursorIDs: array of Int64);
var n: integer;
begin
  if high(CursorIDs)<0 then
    raise EMongoException.CreateUTF8('Invalid %.Create([]) call',[self]);
  inherited Create(FullCollectionName,opKillCursors,0,0);
  Write4(0); // reserved for future use
  n := length(CursorIDs);
  Write4(n);
  SetLength(fCursors,n);
  n := n*sizeof(Int64);
  MoveFast(CursorIDs[0],fCursors[0],n);
  Write(pointer(fCursors),n);
end;

procedure TMongoRequestKillCursor.ToJSON(W: TTextWriter; Mode: TMongoJSONMode);
var i: integer;
begin
  inherited;
  W.CancelLastChar('}');
  W.AddShort(',cursorID:[');
  for i := 0 to high(fCursors) do begin
    W.Add(fCursors[i]);
    W.Add(',');
  end;
  W.CancelLastComma;
  W.Add(']','}');
end;


{ TMongoReplyCursor }

procedure TMongoReplyCursor.Init(const ReplyMessage: TMongoReply);
var Len: integer;
begin
  Len := length(ReplyMessage);
  with PMongoReplyHeader(ReplyMessage)^ do begin
    if (Len<sizeof(TMongoReplyHeader)) or (MessageLength<>Len) or
       (sizeof(TMongoReplyHeader)+NumberReturned*5>Len) then
      raise EMongoException.CreateUTF8('TMongoReplyCursor.Init(len=%)',[len]);
    if OpCode<>WIRE_OPCODES[opReply] then
      raise EMongoException.CreateUTF8('TMongoReplyCursor.Init(OpCode=%)',[OpCode]);
    fRequestID := RequestID;
    fResponseTo := ResponseTo;
    byte(fResponseFlags) := ResponseFlags;
    fCursorID := CursorID;
    fStartingFrom := StartingFrom;
    fNumberReturned := NumberReturned;
  end;
  fReply := ReplyMessage;
  fFirstDocument := PAnsiChar(pointer(fReply))+sizeof(TMongoReplyHeader);
  Rewind;
  fLatestDocIndex := -1;
end;

procedure TMongoReplyCursor.ComputeDocumentsList;
var i, Len: integer;
    P: PAnsiChar;
begin
  if fDocuments<>nil then
    exit;
  Len := length(fReply);
  SetLength(fDocuments,DocumentCount);
  P := fFirstDocument;
  for i := 0 to DocumentCount-1 do begin
    fDocuments[i] := P;
    inc(P,PInteger(P)^); // fast "parsing" of all supplied documents
    if P-pointer(fReply)>Len then
      raise EMongoException.CreateUTF8('ComputeDocumentsList(Document[%])',[i]);
  end;
  if P-pointer(fReply)<>Len then
    raise EMongoException.Create('ComputeDocumentsList(Documents)');
end;

function TMongoReplyCursor.GetOneDocument(index: integer): variant;
begin
  if fLatestDocIndex<>index then begin // naive but efficient cache
    GetDocument(index,fLatestDocValue);
    fLatestDocIndex := index;
  end;
  result := fLatestDocValue;
end;

procedure TMongoReplyCursor.GetDocument(index: integer; var result: variant);
begin
  if cardinal(index)>=cardinal(length(fDocuments)) then
    raise EMongoException.CreateUTF8('TMongoReplyCursor.GetDocument(index %>=%)',
      [index,length(fDocuments)]);
  if fDocuments=nil then
    ComputeDocumentsList;
  BSONToDoc(fDocuments[index],result,0,asDocVariantPerReference);
end;

function TMongoReplyCursor.Next(out doc: variant;
  option: TBSONDocArrayConversion=asDocVariantPerReference): boolean;
var b: PByte;
begin
  if Next(b) then begin
    BSONToDoc(b,doc,0,option);
    result := true;
  end else
    result := false;
end;

function TMongoReplyCursor.Next(out doc: PByte): boolean;
begin
  if fCurrentPosition<DocumentCount then begin
    doc := PByte(fCurrentDocument);
    inc(fCurrentDocument,PInteger(fCurrentDocument)^);
    inc(fCurrentPosition);
    result := true;
  end else begin
    doc := nil;
    result := false;
  end;
end;

function TMongoReplyCursor.Next(out BSON: TBSONDocument): boolean;
var b: PByte;
begin
  if Next(b) then begin
    SetString(BSON,PAnsiChar(b)+4,PInteger(b)^);
    result := true;
  end else
    result := false;
end;

function TMongoReplyCursor.Next(out JSON: RawUTF8; Mode: TMongoJSONMode=modMongoStrict): boolean;
var b: PByte;
begin
  if Next(b) then begin
    JSON := BSONToJSON(b,betDoc,0,Mode);
    result := true;
  end else
    result := false;
end;

procedure TMongoReplyCursor.Rewind;
begin
  fCurrentPosition := 0;
  fCurrentDocument := fFirstDocument;
end;

function TMongoReplyCursor.AppendAllToDocVariantDynArray(var Dest: TVariantDynArray): integer;
var b: PByte;
begin
  result := length(Dest);
  if (fReply='') or (DocumentCount<=0) then
    exit; // nothing to append
  SetLength(Dest,result+DocumentCount);
  Rewind;
  while Next(b) do begin
    BSONToDoc(b,Dest[result],0,asDocVariantPerReference);
    inc(result);
  end;
  if result<>length(Dest) then
    raise EMongoException.Create('Invalid opReply Documents');
end;

procedure TMongoReplyCursor.AppendAllToBSON(Dest: TBSONWriter);
var name: RawUTF8;
    i: integer;
    P: PAnsiChar;
begin
  P := FirstDocument;
  for i := 1 to DocumentCount do begin
    UInt32ToUtf8(Dest.Tag,name); // Dest.Tag = item number in array
    Dest.Tag := Dest.Tag+1;
    Dest.BSONWrite(name,betDoc);
    Dest.Write(P,PInteger(P)^);
    inc(P,PInteger(P)^);
  end;
end;

function TMongoReplyCursor.AppendAllToDocVariant(var Dest: TDocVariantData): integer;
var item: variant;
begin
  if TVarData(Dest).VType<>DocVariantType.VarType then
    TDocVariant.New(Variant(Dest),JSON_OPTIONS_FAST);
  result := Dest.Count;
  if (fReply='') or (DocumentCount<=0) then
    exit; // nothing to append
  inc(result,DocumentCount);
  Dest.Capacity := result;
  Rewind;
  while Next(item) do
    Dest.AddItem(item);
  if Dest.Count<>result then
    raise EMongoException.Create('Invalid opReply Documents');
end;

procedure TMongoReplyCursor.FetchAllToJSON(W: TTextWriter; Mode: TMongoJSONMode;
  WithHeader: boolean; MaxSize: Cardinal);
var b: PByte;
begin
  if (fReply='') or (DocumentCount<=0) then begin
    W.AddShort('null');
    exit;
  end;
  if WithHeader and (Mode=modMongoShell) then
    W.Add('{ReplyHeader:{ResponseFlags:%,RequestID:%,ResponseTo:%,CursorID:%,'+
      'StartingFrom:%,NumberReturned:%,ReplyDocuments:[',
      [byte(ResponseFlags),RequestID,ResponseTo,CursorID,StartingFrom,DocumentCount]);
  Rewind;
  while Next(b) do begin
    inc(b,sizeof(integer)); // points to the "e_list" of "int32 e_list #0"
    BSONListToJSON(b,betDoc,W,Mode);
    W.Add(',');
    if (MaxSize>0) and (W.TextLength>MaxSize) then begin
      W.AddShort('...');
      break;
    end;
  end;
  W.CancelLastComma;
  if WithHeader then
    W.Add(']','}');
end;

function TMongoReplyCursor.ToJSON(Mode: TMongoJSONMode; WithHeader: boolean;
  MaxSize: Cardinal): RawUTF8;
var W: TTextWriter;
begin
  if (fReply='') or (DocumentCount<=0) then
    result := 'null' else begin
    W := TTextWriter.CreateOwnedStream;
    try
      FetchAllToJSON(W,Mode,WithHeader,MaxSize);
      W.SetText(result);
    finally
      W.Free;
    end;
  end;
end;


{ TMongoConnection }

const
  /// message big enough to retrieve the maximum MongoDB document size
  MONGODB_MAXMESSAGESIZE = BSON_MAXDOCUMENTSIZE+sizeof(TMongoReplyHeader);

constructor TMongoConnection.Create(const aClient: TMongoClient;
  const aServerAddress: RawByteString; aServerPort: integer);
begin
  if aClient=nil then
    raise EMongoException.CreateUTF8('%.Create(nil)',[self]);
  fClient := aClient;
  fServerAddress := trim(aServerAddress);
  if fServerAddress='' then
    fServerAddress := '127.0.0.1';
  fServerPort := aServerPort;
  InitializeCriticalSection(fLock);
end;

destructor TMongoConnection.Destroy;
begin
  try
    try
      Close;
    except
      ; // continue on socket error
    end;
  finally
    DeleteCriticalSection(fLock);
    inherited Destroy;
  end;
end;

procedure TMongoConnection.Open;
begin
  if self=nil then
    raise EMongoException.Create('TMongoConnection(nil).Open');
  if fSocket<>nil then
    raise EMongoConnectionException.Create('Duplicate Open',self);
  try
    fSocket := TCrtSocket.Open(fServerAddress,UInt32ToUtf8(fServerPort),
      cslTCP,Client.ConnectionTimeOut);
  except
    on E: Exception do
      raise EMongoException.CreateUTF8(
        '%.Open unable to connect to MongoDB server: % "%"',[self,E,E.Message]);
  end;
  fSocket.TCPNoDelay := ord(true); // we buffer all output data before sending
  fSocket.KeepAlive := ord(true);  // do not close the connection without notice
end;

function TMongoConnection.GetOpened: boolean;
begin
  result := (self<>nil) and (fSocket<>nil);
end;

procedure TMongoConnection.Close;
begin
  FreeAndNil(fSocket);
end;

procedure TMongoConnection.GetDocumentsAndFree(Query: TMongoRequestQuery;
  var result: TVariantDynArray);
begin
  result := nil;
  GetRepliesAndFree(Query,ReplyDocVariant,result);
end;

procedure TMongoConnection.GetDocumentsAndFree(Query: TMongoRequestQuery;
  var result: variant);
var ForceOneInstance: boolean;
    docs: TVariantDynArray;
begin
  ForceOneInstance := Query.NumberToReturn=1;
  SetVariantNull(result);
  GetRepliesAndFree(Query,ReplyDocVariant,docs);
  if docs<>nil then
    if ForceOneInstance then
      result := docs[0] else
      TDocVariantData(result).InitArrayFromVariants(docs,JSON_OPTIONS_FAST);
end;

function TMongoConnection.GetDocumentsAndFree(Query: TMongoRequestQuery): variant;
begin
  GetDocumentsAndFree(Query,result);
end;

function TMongoConnection.GetBSONAndFree(Query: TMongoRequestQuery): TBSONDocument;
var W: TBSONWriter;
begin
  W := TBSONWriter.Create(TRawByteStringStream);
  try
    W.BSONDocumentBegin;
    GetRepliesAndFree(Query,ReplyBSON,W); // W.Tag = item number in array
    W.BSONDocumentEnd;
    W.ToBSONDocument(result);
  finally
    W.Free;
  end;
end;

function TMongoConnection.GetJSONAndFree(Query: TMongoRequestQuery; Mode: TMongoJSONMode): RawUTF8;
var W: TTextWriter;
    ReturnAsJSONArray: boolean;
begin
  ReturnAsJSONArray := Query.NumberToReturn>1;
  W := TTextWriter.CreateOwnedStream;
  try
    if ReturnAsJSONArray then
      W.Add('[');
    case Mode of
      modNoMongo:     GetRepliesAndFree(Query,ReplyJSONNoMongo,W);
      modMongoStrict: GetRepliesAndFree(Query,ReplyJSONStrict,W);
      modMongoShell:  GetRepliesAndFree(Query,ReplyJSONExtended,W);
    end;
    W.CancelLastComma;
    if ReturnAsJSONArray then
      W.Add(']');
    W.SetText(result);
    if (result='') or (result='[]') or (result='{}') then
      result := 'null';
  finally
    W.Free;
  end;
end;

procedure TMongoConnection.GetRepliesAndFree(Query: TMongoRequestQuery;
  OnEachReply: TOnMongoConnectionReply; var Opaque);
var main, more: TMongoReplyCursor;
    getMore: TMongoRequestGetMore;
    count: integer;
    cursorID: Int64;
begin
  try
    if not Assigned(Query) then
      raise EMongoRequestException.Create('Query=nil',self);
    if not Assigned(OnEachReply) then
      raise EMongoRequestException.Create('OnEachReply=nil',self,Query);
    count := Query.NumberToReturn; // 0 means default return size
    GetCursor(Query,main);
    if main.DocumentCount>0 then begin
      OnEachReply(Query,main,Opaque);
      if count>0 then
        dec(count,main.DocumentCount);
    end;
    cursorID := main.CursorID;
    if cursorID<>0 then
      if (Query.NumberToReturn=0) or ((Query.NumberToReturn>0)and(count>0)) then
      repeat
        getMore := TMongoRequestGetMore.Create(
          Query.FullCollectionName,count,cursorID);
        try
          GetCursor(getMore,more);
          if mrfCursorNotFound in more.ResponseFlags then
            raise EMongoRequestException.Create('GetMore cursor not found',self,Query,more);
          if more.DocumentCount>0 then begin
            OnEachReply(Query,more,Opaque);
            dec(count,more.DocumentCount);
          end;
          cursorID := more.CursorID;
        finally
          getMore.Free;
        end;
      until ((Query.NumberToReturn>0)and(count<=0)) or (cursorID=0);
    if cursorID<>0 then // if cursor not exhausted: need to kill it
      SendAndFree(TMongoRequestKillCursor.Create(Query.FullCollectionName,[cursorID]),true);
  finally
    Query.Free;
  end;
end;

procedure TMongoConnection.ReplyDocVariant(Request: TMongoRequest;
  const Reply: TMongoReplyCursor; var Opaque);
begin
  Reply.AppendAllToDocVariantDynArray(TVariantDynArray(Opaque));
end;

procedure TMongoConnection.ReplyJSONStrict(Request: TMongoRequest;
  const Reply: TMongoReplyCursor; var Opaque);
var W: TTextWriter absolute Opaque;
begin
  Reply.FetchAllToJSON(W,modMongoStrict,false);
  W.Add(',');
end;

procedure TMongoConnection.ReplyJSONExtended(Request: TMongoRequest;
  const Reply: TMongoReplyCursor; var Opaque);
var W: TTextWriter absolute Opaque;
begin
  Reply.FetchAllToJSON(W,modMongoShell,false);
  W.Add(',');
end;

procedure TMongoConnection.ReplyJSONNoMongo(Request: TMongoRequest;
  const Reply: TMongoReplyCursor; var Opaque);
var W: TTextWriter absolute Opaque;
begin
  Reply.FetchAllToJSON(W,modNoMongo,false);
  W.Add(',');
end;

procedure TMongoConnection.ReplyBSON(Request: TMongoRequest;
  const Reply: TMongoReplyCursor; var Opaque);
begin
  Reply.AppendAllToBSON(TBSONWriter(Opaque));
end;

function TMongoConnection.Send(Request: TMongoRequest): boolean;
var doc: TBSONDocument;
begin
  if fSocket=nil then
    raise EMongoRequestException.Create('Missing Open',self,Request);
  if Request=nil then
    raise EMongoRequestException.Create('LockAndSend(nil)',self);
  Request.ToBSONDocument(doc);
  if (Client.LogRequestEvent<>sllNone) and (Client.Log<>nil) and
     (Client.LogRequestEvent in Client.Log.Family.Level) then
    Client.Log.Log(Client.fLogRequestEvent,Request.ToJSON(modMongoShell),Request);
  result := fSocket.TrySndLow(pointer(doc),length(doc));
end;

function TMongoConnection.SendAndFree(Request: TMongoRequest; NoAcknowledge: boolean): variant;
var cmd: variant;
begin
  SetVariantNull(result);
  try
    if self=nil then
      raise EMongoRequestException.Create('Connection=nil',self,Request);
    Lock;
    try
      if Send(Request) then begin
        if NoAcknowledge or
           (Client.WriteConcern in [wcErrorsIgnored,wcUnacknowledged]) then
          exit;
        case Client.WriteConcern of
          wcAcknowledged:        cmd := 'getLastError';
          wcJournaled:           cmd := BSONVariant(['getLastError',1,'j',true]);
          wcReplicaAcknowledged: cmd := BSONVariant(['getLastError',1,'w',2]);
          else raise EMongoRequestException.CreateUTF8(
            '%.SendAndFree WriteConcern=%',[self,ord(Client.WriteConcern)],self,Request);
        end;
        RunCommand(Request.DatabaseName,cmd,result);
        if not VarIsNull(result.err) then
          raise EMongoRequestException.Create(
            'SendAndFree',self,Request,TDocVariantData(result));
      end else // socket error on sending
        if Client.WriteConcern=wcErrorsIgnored then
          exit else
          raise EMongoRequestOSException.Create('SendAndFree',self,Request);
    finally
      UnLock;
    end;
  finally
    Request.Free;
  end;
end;

procedure TMongoConnection.GetCursor(Request: TMongoRequest; var Result: TMongoReplyCursor);
var reply: TMongoReply;
begin
  GetReply(Request,reply);
  Result.Init(reply);
  if (Client.LogReplyEvent<>sllNone) and (Client.Log<>nil) and
     (Client.LogReplyEvent in Client.Log.Family.Level) then
    Client.Log.Log(Client.LogReplyEvent,
      Result.ToJSON(modMongoShell,True,Client.LogReplyEventMaxSize),Request);
  if mrfQueryFailure in Result.ResponseFlags then
    raise EMongoRequestException.Create('Query failure',self,Request,Result);
end;

procedure TMongoConnection.GetReply(Request: TMongoRequest; out result: TMongoReply);
var Header: TMongoReplyHeader;
    DataLen: integer;
begin
  if self=nil then
    raise EMongoRequestException.Create('Connection=nil',self,Request);
  FillCharFast(Header,sizeof(Header),0);
  try
    Lock;
    if Send(Request) then
      while true do
      if fSocket.TrySockRecv(@Header,sizeof(Header)) then begin
        if (Header.MessageLength<SizeOf(Header)) or
           (Header.MessageLength>MONGODB_MAXMESSAGESIZE) then
          raise EMongoRequestException.CreateUTF8('%.GetReply: MessageLength=%',
            [self,Header.MessageLength],self,Request);
        SetLength(result,Header.MessageLength);
        PMongoReplyHeader(result)^ := Header;
        DataLen := Header.MessageLength-sizeof(Header);
        if fSocket.TrySockRecv(@PByteArray(result)[sizeof(Header)],DataLen) then
          if Header.ResponseTo=Request.MongoRequestID then // success
            exit else
          if Header.OpCode=ord(opMsg) then begin
            if Client.Log<>nil then
              Client.Log.Log(sllWarning,'Msg from MongoDB: %',
                [BSONToJSON(@PByteArray(result)[sizeof(Header)],betDoc,DataLen,modMongoShell)],Request);
          end else
            raise EMongoRequestException.CreateUTF8(
              '%.GetReply: ResponseTo=% Expected:% in current blocking mode',
              [self,Header.ResponseTo,Request.MongoRequestID],self,Request);
      end else
        raise EMongoRequestException.Create('Server reset the connection: '+
          'probably due to a bad formatted BSON request',self,Request);
    // if we reached here, this is due to a socket error
    raise EMongoRequestOSException.Create('GetReply',self,Request);
  finally
    UnLock;
  end;
end;

function TMongoConnection.RunCommand(const aDatabaseName: RawUTF8;
  const command: variant; var returnedValue: variant): RawUTF8;
begin
  GetDocumentsAndFree(
    TMongoRequestQuery.Create(aDatabaseName+'.$cmd',command,null,1),
    returnedValue);
  with _Safe(returnedValue)^ do
    if GetValueOrDefault('ok',1)<>0 then
      result := '' else
      if not GetAsRawUTF8('errmsg',result) then
        result := 'unspecified error';
end;

function TMongoConnection.RunCommand(const aDatabaseName: RawUTF8;
  const command: variant; var returnedValue: TBSONDocument): boolean;
var item: TBSONElement;
begin
  returnedValue := GetBSONAndFree(
    TMongoRequestQuery.Create(aDatabaseName+'.$cmd',command,null,1));
  result := true;
  item.FromDocument(returnedValue);
  if item.DocItemToInteger('ok',1)=0 then
    result := false;
end;

procedure TMongoConnection.Lock;
begin
  EnterCriticalSection(fLock);
  inc(fLocked);
end;

procedure TMongoConnection.UnLock;
begin
  dec(fLocked);
  LeaveCriticalSection(fLock);
end;

function TMongoConnection.GetLocked: boolean;
begin
  result := (self<>nil) and (fLocked>0);
end;


{ EMongoConnectionException }

constructor EMongoConnectionException.Create(const aMsg: string;
  aConnection: TMongoConnection);
begin
  inherited Create(aMsg);
  fConnection := aConnection;
end;

constructor EMongoConnectionException.CreateUTF8(const Format: RawUTF8; const Args: array of const;
  aConnection: TMongoConnection);
begin
  inherited CreateUTF8(Format,Args);
  fConnection := aConnection;
end;


{ EMongoRequestException }

constructor EMongoRequestException.Create(const aMsg: string;
  aConnection: TMongoConnection; aRequest: TMongoRequest);
begin
  inherited Create(aMsg,aConnection);
  fRequest := aRequest;
end;

constructor EMongoRequestException.CreateUTF8(const Format: RawUTF8;
  const Args: array of const; aConnection: TMongoConnection;
  aRequest: TMongoRequest);
begin
  inherited CreateUTF8(Format,Args,aConnection);
  fRequest := aRequest;
end;

constructor EMongoRequestException.Create(const aMsg: string;
  aConnection: TMongoConnection; aRequest: TMongoRequest;
  const aError: TMongoReplyCursor);
begin
  Create(aMsg,aConnection,aRequest);
  fError := aError;
end;

constructor EMongoRequestException.Create(const aMsg: string;
  aConnection: TMongoConnection; aRequest: TMongoRequest;
  const aErrorDoc: TDocVariantData);
begin
  Create(aMsg,aConnection,aRequest);
  fErrorDoc := variant(aErrorDoc);
end;

{$ifndef NOEXCEPTIONINTERCEPT}
function EMongoRequestException.CustomLog(WR: TTextWriter;
  const Context: TSynLogExceptionContext): boolean;
begin
  inherited CustomLog(WR,Context);
  if fRequest<>nil then begin
    WR.AddInstanceName(fRequest,':');
    fRequest.ToJSON(WR,modMongoShell);
  end;
  if fError.Reply<>'' then
    fError.FetchAllToJSON(WR,modMongoShell,True);
  result := false; // log stack trace
end;
{$endif}

function EMongoRequestException.GetErrorDoc: variant;
begin
  if TVarData(fErrorDoc).VType=varEmpty then begin
    if not fError.Next(fErrorDoc) then
      SetVariantNull(fErrorDoc);
  end;
  result := fErrorDoc;
end;


{ EMongoRequestOSException }

constructor EMongoRequestOSException.Create(const aMsg: string;
  aConnection: TMongoConnection; aRequest: TMongoRequest=nil);
begin
  fSystemLastError := GetLastError;
  CreateUTF8('%: % (%)',[aMsg,SysErrorMessage(fSystemLastError),fSystemLastError],
    aConnection,aRequest);
end;


{ EMongoDatabaseException }

constructor EMongoDatabaseException.Create(const aMsg: string;
  aDatabase: TMongoDatabase);
begin
  inherited Create(aMsg,aDatabase.Client.Connections[0]);
  fDatabase := aDatabase;
end;

constructor EMongoDatabaseException.CreateUTF8(const Format: RawUTF8;
  const Args: array of const; aDatabase: TMongoDatabase);
begin
  inherited CreateUTF8(Format,Args,aDatabase.Client.Connections[0]);
  fDatabase := aDatabase;
end;

{$ifndef NOEXCEPTIONINTERCEPT}
function EMongoDatabaseException.CustomLog(WR: TTextWriter;
  const Context: TSynLogExceptionContext): boolean;
begin
  inherited CustomLog(WR,Context);
  WR.AddJSONEscape(['Database',fDatabase.Name]);
  result := false; // log stack trace
end;
{$endif}


{ TMongoClient }

constructor TMongoClient.Create(const Host: RawUTF8; Port: Integer;
  const SecondaryHostCSV, SecondaryPortCSV: RawUTF8);
var secHost: TRawUTF8DynArray;
    secPort: TIntegerDynArray;
    nHost, i: integer;
begin
  fConnectionTimeOut := 30000;
  fLogReplyEventMaxSize := 1024;
  FormatUTF8('mongodb://%:%',[Host,Port],fConnectionString);
  CSVToRawUTF8DynArray(pointer(SecondaryHostCSV),secHost);
  nHost := length(secHost);
  SetLength(fConnections,nHost+1);
  fConnections[0] := TMongoConnection.Create(self,Host,Port);
  if nHost>0 then begin
    CSVToIntegerDynArray(pointer(SecondaryPortCSV),secPort);
    for i := 0 to nHost-1 do begin
      if i>high(secPort) then
        Port := MONGODB_DEFAULTPORT else
        Port := secPort[i];
      fConnections[i+1] := TMongoConnection.Create(self,secHost[i],Port);
      fConnectionString := FormatUTF8('%,%:%',[fConnectionString,secHost[i],Port]);
    end;
  end;
  fDatabases := TRawUTF8ListHashed.Create(true);
end;

destructor TMongoClient.Destroy;
var i: integer;
begin
  for i := 0 to high(fConnections) do
    FreeAndNil(fConnections[i]);
  FreeAndNil(fDatabases);
  inherited;
end;

procedure TMongoClient.SetLog(LogClass: TSynLogClass;
  RequestEvent, ReplyEvent: TSynLogInfo; ReplyEventMaxSize: cardinal);
begin
  fLog := LogClass.Add;
  LogRequestEvent := RequestEvent;
  LogReplyEvent := ReplyEvent;
  LogReplyEventMaxSize := ReplyEventMaxSize;
end;

function TMongoClient.ServerBuildInfoText: RawUTF8;
begin
  with _Safe(ServerBuildInfo)^ do
    if Count=0 then
      result := '' else begin
      FormatUTF8('MongoDB % %',[U['version'],U['javascriptEngine']],result);
      with A['storageEngines']^ do begin
        // "storageEngines":["devnull","ephemeralForTest","mmapv1","wiredTiger"]
        DeleteByValue('devnull');
        DeleteByValue('ephemeralForTest');
        if Count>0 then
          result := result+' '+ToCSV;
      end;
    end;
end;

function TMongoClient.GetOneReadConnection: TMongoConnection;
function GetUnlockedSecondaryIndex: integer;
var retry: integer;
begin
  if Length(fConnections)=1 then // no secondary? use primary
    result := 0 else begin
    for retry := 1 to 100 do begin // search for an inactive connection
      result := fLatestReadConnectionIndex; // simple round-robin pattern
      if result=high(fConnections) then
        if ReadPreference=rpSecondary then
          result := 1 else
          result := 0 else
        inc(result); // thread-safety is not an issue here
      if (retry<=length(fConnections)) and not fConnections[result].Opened then
      try
        fConnections[result].Open;
      except
        on E: Exception do
          continue;
      end;
      if fConnections[result].Opened then
        if fConnections[result].Locked then
          if retry mod length(fConnections)=0 then
            SleepHiRes(2) else
            continue else
          break;
    end;
    if not fConnections[result].Opened then
      result := 0; // safe fallback to primary member in worst case
    fLatestReadConnectionIndex := result;
  end;
end;
begin
  case ReadPreference of
  rpPrimaryPreferred:
    if fConnections[0].Locked then
      result := fConnections[GetUnlockedSecondaryIndex] else
      result := fConnections[0];
  rpSecondary, rpSecondaryPreferred:
    result := fConnections[GetUnlockedSecondaryIndex];
  else // rpPrimary:
    result := fConnections[0];
  end;
end;

function TMongoClient.Open(const DatabaseName: RawUTF8): TMongoDatabase;
begin
  if self=nil then
    result := nil else begin
    result := TMongoDatabase(fDatabases.GetObjectByName(DatabaseName));
    if result=nil then begin // not already opened -> try now from primary host
      if not fConnections[0].Opened then begin
        fConnections[0].Open;
        AfterOpen;
      end;
      result := TMongoDatabase.Create(Self,DatabaseName);
      fDatabases.AddObject(DatabaseName,result);
    end;
  end;
end;

function PasswordDigest(const UserName,Password: RawUTF8): RawUTF8;
begin
  result := MD5(UserName+':mongo:'+PassWord);
end;

function TMongoClient.OpenAuth(const DatabaseName,UserName,PassWord: RawUTF8;
  ForceMongoDBCR: boolean): TMongoDatabase;
var res,bson: variant;
    err,digest,nonce,first,key,user,msg,rnonce: RawUTF8;
    payload: RawByteString;
    rnd: TAESBlock;
    sha: TSHA1;
    salted,client,stored,server: TSHA1Digest;
    resp: TDocVariantData;

  procedure CheckPayload;
  var bin: PVariant;
  begin
    if err<>'' then
      exit;
    if _Safe(res)^.GetAsPVariant('payload',bin) and
       BSONVariantType.ToBlob(bin^,payload) then
      resp.InitCSV(pointer(payload),JSON_OPTIONS_FAST,'=',',') else
      err := 'missing or invalid returned payload';
  end;
  
begin
  if (self=nil) or (UserName='') or (PassWord='') then
    raise EMongoException.CreateUTF8('Invalid %.OpenAuth("%") call',[self,DatabaseName]);
  result := TMongoDatabase(fDatabases.GetObjectByName(DatabaseName));
  if result=nil then  // not already opened -> try now from primary host
  try
    if not fConnections[0].Opened then
    try
      digest := PasswordDigest(UserName,Password);
      fConnections[0].Open; // socket connection
      AfterOpen; // need ServerBuildInfoNumber just below
      if ForceMongoDBCR or (ServerBuildInfoNumber<3000000) then begin
        // MONGODB-CR
        // http://docs.mongodb.org/meta-driver/latest/legacy/implement-authentication-in-driver
        bson := BSONVariant(['getnonce',1]);
        err := fConnections[0].RunCommand(DatabaseName,bson,res);
        if (err='') and not _Safe(res)^.GetAsRawUTF8('nonce',nonce) then
          err := 'missing returned nonce';
        if err<>'' then
          raise EMongoException.CreateUTF8('%.OpenAuthCR("%") step1: % - res=%',
            [self,DatabaseName,err,res]);
        key := MD5(nonce+UserName+digest);
        bson := BSONVariant(['authenticate',1,'user',UserName,'nonce',nonce,'key',key]);
        err := fConnections[0].RunCommand(DatabaseName,bson,res);
        if err<>'' then
          raise EMongoException.CreateUTF8('%.OpenAuthCR("%") step2: % - res=%',
            [self,DatabaseName,err,res]);
      end else begin
        // SCRAM-SHA-1
        // https://tools.ietf.org/html/rfc5802#section-5
        user := StringReplaceAll(StringReplaceAll(UserName,'=','=3D'),',','=2C');
        TAESPRNG.Main.FillRandom(rnd);
        nonce := BinToBase64(@rnd,sizeof(rnd));
        FormatUTF8('n=%,r=%',[user,nonce],first);
        BSONVariantType.FromBinary('n,,'+first,bbtGeneric,bson);
        err := fConnections[0].RunCommand(DatabaseName,BSONVariant([
          'saslStart',1,'mechanism','SCRAM-SHA-1','payload',bson,'autoAuthorize',1]),res);
        CheckPayload;
        if err='' then begin
          rnonce := resp.U['r'];
          if copy(rnonce,1,length(nonce))<>nonce then
            err := 'returned invalid nonce';
        end;
        if err<>'' then
          raise EMongoException.CreateUTF8('%.OpenAuthSCRAM("%") step1: % - res=%',
            [self,DatabaseName,err,res]);
        key := 'c=biws,r='+rnonce;
        PBKDF2_HMAC_SHA1(digest,Base64ToBin(resp.U['s']),UTF8ToInteger(resp.U['i']),salted);
        HMAC_SHA1(salted,'Client Key',client);
        sha.Full(@client,SizeOf(client),stored);
        msg := first+','+RawUTF8(payload)+','+key;
        HMAC_SHA1(stored,msg,stored);
        XorMemory(@client,@stored,SizeOf(client));
        HMAC_SHA1(salted,'Server Key',server);
        HMAC_SHA1(server,msg,server);
        msg := key+',p='+BinToBase64(@client,SizeOf(client));
        BSONVariantType.FromBinary(msg,bbtGeneric,bson);
        err := fConnections[0].RunCommand(DatabaseName,BSONVariant([
          'saslContinue',1,'conversationId',res.conversationId,'payload',bson]),res);
        resp.Clear;
        CheckPayload;
        if (err='') and (resp.U['v']<>BinToBase64(@server,SizeOf(server))) then
            err := 'Server returned an invalid signature';
        if err<>'' then
          raise EMongoException.CreateUTF8('%.OpenAuthSCRAM("%") step2: % - res=%',
            [self,DatabaseName,err,res]);
        if not res.done then begin
          // third empty challenge may be required
          err := fConnections[0].RunCommand(DatabaseName,BSONVariant([
            'saslContinue',1,'conversationId',res.conversationId,'payload','']),res);
         if (err='') and not res.done then
           err := 'SASL conversation failed to complete';
          if err<>'' then
            raise EMongoException.CreateUTF8('%.OpenAuthSCRAM("%") step3: % - res=%',
              [self,DatabaseName,err,res]);
        end;
      end;
    except
      fConnections[0].Close;
      raise;
    end;
    result := TMongoDatabase.Create(Self,DatabaseName);
    fDatabases.AddObject(DatabaseName,result);
  finally
    FillZero(RawByteString(digest));
  end;
end;

procedure TMongoClient.AfterOpen;
begin
  if VarIsEmptyOrNull(fServerBuildInfo) then begin
    fConnections[0].RunCommand('admin','buildinfo',fServerBuildInfo);
    with _Safe(fServerBuildInfo)^.A['versionArray']^ do
      if Count=4 then
        fServerBuildInfoNumber := // e.g. 2040900 for MongoDB 2.4.9
          integer(Values[0])*1000000+integer(Values[1])*10000+
          integer(Values[2])*100+integer(Values[3]);
  end;
end;

function TMongoClient.GetBytesReceived: Int64;
var i: integer;
begin
  result := 0;
  if self<>nil then
    for i := 0 to high(fConnections) do
      if fConnections[i].Socket<>nil then
        inc(result,fConnections[i].Socket.BytesIn);
end;

function TMongoClient.GetBytesSent: Int64;
var i: integer;
begin
  result := 0;
  if self<>nil then
    for i := 0 to high(fConnections) do
      if fConnections[i].Socket<>nil then
        inc(result,fConnections[i].Socket.BytesOut);
end;

function TMongoClient.GetBytesTransmitted: Int64;
var i: integer;
begin
  result := 0;
  if self<>nil then
    for i := 0 to high(fConnections) do
      if fConnections[i].Socket<>nil then
        inc(result,fConnections[i].Socket.BytesIn+fConnections[i].Socket.BytesOut);
end;


{ TMongoDatabase }

constructor TMongoDatabase.Create(aClient: TMongoClient;
  const aDatabaseName: RawUTF8);
var colls: TBSONIterator;
    full,db,coll: RawUTF8;
    resp,batch: variant;
    ndx: Integer;
begin
  fClient := aClient;
  fName := aDatabaseName;
  fCollections := TRawUTF8ListHashed.Create(true);
  if fClient.ServerBuildInfoNumber<3000000 then begin
    if colls.Init(Client.Connections[0].GetBSONAndFree(TMongoRequestQuery.Create(
      aDatabaseName+'.system.namespaces',null,'name',maxInt))) then
    // e.g. [ {name:"test.system.indexes"}, {name:"test.test"} ]
    while colls.Next do begin
      full := colls.item.DocItemToRawUTF8('name');
      if full<>'' then begin
        split(full,'.',db,coll);
        if db<>aDatabaseName then
          raise EMongoConnectionException.CreateUTF8(
            '%.Create: invalid "%" collection name for DB "%"',
            [self,full,aDatabaseName],Client.Connections[0]);
        fCollections.AddObject(coll,TMongoCollection.Create(self,coll));
      end;
    end;
  end else begin
    RunCommand('listCollections',resp);
    if _Safe(resp)^.GetValueByPath('cursor.firstBatch',batch) then
      with _Safe(batch)^ do
      for ndx := 0 to Count-1 do
        if _Safe(Values[ndx]).GetAsRawUTF8('name',coll) then
          fCollections.AddObject(coll,TMongoCollection.Create(self,coll));
  end;
end;

destructor TMongoDatabase.Destroy;
begin
  FreeAndNil(fCollections);
  inherited;
end;

function TMongoDatabase.CreateUser(const UserName,Password: RawUTF8;
  const roles: variant): RawUTF8;
var res: variant;
begin
  result := RunCommand(BSONVariant(
    ['createUser',UserName,'pwd',PasswordDigest(UserName,Password),
     'digestPassword',false,'roles',roles]),res);
end;

function TMongoDatabase.CreateUserForThisDatabase(const UserName,Password: RawUTF8;
  allowWrite: Boolean): RawUTF8;
const RW: array[boolean] of RawUTF8 = ('read','readWrite');
begin
  result := CreateUser(UserName,Password,
    BSONVariant('[{role:?,db:?}]',[],[RW[allowWrite],Name]));
end;

function TMongoDatabase.DropUser(const UserName: RawUTF8): RawUTF8;
var res: variant;
begin
  result := RunCommand(BSONVariant(['dropUser',UserName]),res);
end;

function TMongoDatabase.GetCollection(const Name: RawUTF8): TMongoCollection;
begin
  result := GetCollectionOrNil(Name);
  if result=nil then
    raise EMongoDatabaseException.CreateUTF8('%.GetCollection("%")',[self,Name],self);
end;

function TMongoDatabase.GetCollectionOrCreate(const Name: RawUTF8): TMongoCollection;
begin
  result := GetCollectionOrNil(Name);
  if result=nil then
    if self<>nil then begin
      result := TMongoCollection.Create(self,Name);
      fCollections.AddObject(Name,result);
    end;
end;

function TMongoDatabase.GetCollectionOrNil(const Name: RawUTF8): TMongoCollection;
begin
  if self=nil then
    result := nil else
    result := TMongoCollection(fCollections.GetObjectByName(Name));
end;

function TMongoDatabase.RunCommand(const command: variant;
  var returnedValue: variant): RawUTF8;
begin
  result := Client.Connections[0].RunCommand(Name,Command,returnedValue);
end;

function TMongoDatabase.RunCommand(const command: variant;
  var returnedValue: TBSONDocument): boolean;
begin
  result := Client.Connections[0].RunCommand(Name,Command,returnedValue);
end;


{ TMongoCollection }

constructor TMongoCollection.Create(aDatabase: TMongoDatabase;
  const aCollectionName: RawUTF8);
begin
  fDatabase := aDatabase;
  fName := aCollectionName;
  fFullCollectionName := fDatabase.Name+'.'+fName;
end;

function TMongoCollection.AggregateCallFromJson(const pipelineJSON: RawUTF8;
  var reply,res: variant): boolean;
begin // see http://docs.mongodb.org/manual/reference/command/aggregate
  if fDatabase.Client.ServerBuildInfoNumber<2020000 then
    raise EMongoException.Create('Aggregation needs MongoDB 2.2 or later');
  // db.runCommand({aggregate:"test",pipeline:[{$group:{_id:null,max:{$max:"$_id"}}}]})
  Database.RunCommand(BSONVariant('{aggregate:"%",pipeline:[%]}',[Name,pipelineJSON],[]),reply);
  // { "result" : [ { "_id" : null, "max" : 1250 } ], "ok" : 1 }
  res := reply.result;
  result := not VarIsNull(res);
end;

function TMongoCollection.AggregateDoc(Operators: PUTF8Char;
  const Params: array of const): variant;
begin
  result := AggregateDocFromJson(FormatUTF8(Operators,Params));
end;

function TMongoCollection.AggregateJSON(Operators: PUTF8Char;
  const Params: array of const; Mode: TMongoJSONMode): RawUTF8;
begin
  result := AggregateJSONFromJson(FormatUTF8(Operators,Params),Mode);
end;

function TMongoCollection.AggregateCallFromVariant(const pipelineArray: variant; var reply,res: variant): boolean;
begin // see http://docs.mongodb.org/manual/reference/command/aggregate
  if fDatabase.Client.ServerBuildInfoNumber<2020000 then
    raise EMongoException.Create('Aggregation needs MongoDB 2.2 or later');
  // db.runCommand({aggregate:"test",pipeline:[{$group:{_id:null,max:{$max:"$_id"}}}]})
  Database.RunCommand(BSONVariant(['aggregate',name,'pipeline',pipelineArray]),reply);
  // { "result" : [ { "_id" : null, "max" : 1250 } ], "ok" : 1 }
  res := reply.result;
  result := not VarIsNull(res);
end;

function TMongoCollection.AggregateDocFromVariant(const pipelineArray: variant): variant;
var reply: variant;
begin
  if AggregateCallFromVariant(pipelineArray,reply,result) then
    TDocVariant.GetSingleOrDefault(result,result,result) else
    SetVariantNull(result);
end;

function TMongoCollection.AggregateJSONFromVariant(const pipelineArray: variant;
  Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
var reply,res: variant;
begin
  if AggregateCallFromVariant(pipelineArray,reply,res) then
    result := VariantSaveMongoJSON(res,Mode) else
    result := '';
end;

function TMongoCollection.AggregateDocFromJson(const PipelineJSON: RawUTF8): variant;
var reply: variant;
begin
  if AggregateCallFromJSON(PipelineJSON,reply,result) then
    TDocVariant.GetSingleOrDefault(result,result,result) else
    SetVariantNull(result);
end;

function TMongoCollection.AggregateJSONFromJson(const PipelineJSON: RawUTF8;
  Mode: TMongoJSONMode=modMongoStrict): RawUTF8;
var reply,res: variant;
begin
  if AggregateCallFromJson(PipelineJSON,reply,res) then
    result := VariantSaveMongoJSON(res,Mode) else
    result := '';
end;

function TMongoCollection.Drop: RawUTF8;
var res: Variant;
begin
  if self=nil then begin
    result := 'No collection';
    exit;
  end;
  if Database.Client.Log<>nil then
    Database.Client.Log.Enter('Drop %',[Name],self);
  result := fDatabase.RunCommand(BSONVariant('{drop:?}',[],[Name]),res);
  Database.Client.Log.Log(sllTrace,'Drop("%")->%',[Name,res],self);
  if result='' then
    Database.fCollections.Delete(fDatabase.fCollections.IndexOf(Name));
end;

procedure TMongoCollection.EnsureIndex(const Keys, Options: variant);
var doc,res: variant;
    indexName: RawUTF8;
    ndx,order: integer;
    useCommand: Boolean;
begin
  if (self=nil) or (Database=nil) then
    exit;
  if Database.Client.Log<>nil then
    Database.Client.Log.Enter('EnsureIndex %',[Name],self);
  if DocVariantData(Keys)^.Kind<>dvObject then
    raise EMongoException.CreateUTF8('%[%].EnsureIndex(Keys?)',[self,FullCollectionName]);
  useCommand := fDatabase.Client.ServerBuildInfoNumber>=2060000;
  doc := _ObjFast(['key', Keys]);
  if not useCommand then
    doc.ns := FullCollectionName;
  if DocVariantType.IsOfType(Options) then
    with _Safe(Options)^ do
    for ndx := 0 to Count-1 do
      if Names[ndx]='name' then
        indexName := VariantToUTF8(Values[ndx]) else
        TDocVariantData(doc).AddValue(Names[ndx],Values[ndx]);
  if indexName='' then begin
    with _Safe(Keys)^ do
    for ndx := 0 to Count-1 do begin
      indexName := indexName+Names[ndx]+'_';
      order := VariantToIntegerDef(Values[ndx],10);
      if order=-1 then
        indexName := indexName+'_' else
      if order<>1 then
        raise EMongoException.CreateUTF8('%[%].EnsureIndex() on order {%:%}',
          [self,FullCollectionName,Names[ndx],Values[ndx]]);
    end;
  end;
  if length(FullCollectionName)+length(indexName)>120 then
    raise EMongoException.CreateUTF8(
      '%[%].EnsureIndex() computed name > 128 chars: please set as option',
      [self,FullCollectionName]);
  doc.name := indexName;
  if useCommand then
    fDatabase.RunCommand(BSONVariant(
      '{ createIndexes: ?, indexes: [?] }',[],[Name,doc]),res) else
    fDatabase.GetCollectionOrCreate('system.indexes').Insert([doc]);
  Database.Client.Log.Log(sllTrace,'EnsureIndex("%",%)->%',[Name,doc,res],self);
end;

procedure TMongoCollection.EnsureIndex(const Keys: array of RawUTF8;
  Ascending, Unique: boolean);
const Order: array[boolean] of Integer = (-1,1);
var k,opt: variant;
    A: integer;
begin
  if high(Keys)<0 then
    exit; // no column name
  TDocVariant.New(k);
  for A := 0 to high(Keys) do
    TDocVariantData(k).AddValue(Keys[A],Order[Ascending]);
  if Unique then
    opt := _ObjFast(['unique',true]);
  EnsureIndex(k,opt);
end;

function TMongoCollection.Count: Int64;
var res: variant;
begin
  fDatabase.RunCommand(BSONVariant(['count',Name]),res);
  result := _Safe(res)^.GetValueOrDefault('n',0);
end;

function TMongoCollection.FindCount(const Query: variant): Int64;
var res: variant;
begin
  fDatabase.RunCommand(BSONVariant(['count',Name,'query',Query]),res);
  result := _Safe(res)^.GetValueOrDefault('n',0);
end;

function TMongoCollection.FindCount(Criteria: PUTF8Char;
  const Args,Params: array of const;
  MaxNumberToReturn: integer=0; NumberToSkip: Integer=0): Int64;
var cmd: RawUTF8;
    res: variant;
begin
  FormatUTF8('{count:"%",query:%',[Name,FormatUTF8(Criteria,Args,Params,true)],cmd);
  if MaxNumberToReturn>0 then
    cmd := FormatUTF8('%,limit:%',[cmd,MaxNumberToReturn]);
  if NumberToSkip>0 then
    cmd := FormatUTF8('%,skip:%',[cmd,NumberToSkip]);
  fDatabase.RunCommand(BSONVariant(cmd+'}'),res);
  result := _Safe(res)^.GetValueOrDefault('n',0);
end;

function TMongoCollection.IsEmpty: boolean;
var res: variant;
begin // much faster than Count>0 for huge collections
  res := FindDoc(BSONVariant('{$query:{}}'),BSONVariant(['_id',1]));
  result := VarIsEmptyOrNull(res);
end;

function TMongoCollection.FindBSON(const Criteria, Projection: Variant;
  NumberToReturn, NumberToSkip: Integer; Flags: TMongoQueryFlags): TBSONDocument;
begin
  result := Database.Client.GetOneReadConnection.GetBSONAndFree(
    TMongoRequestQuery.Create(fFullCollectionName,
      Criteria,Projection,NumberToReturn,NumberToSkip,Flags));
end;

function TMongoCollection.FindDoc(const Criteria, Projection: Variant;
  NumberToReturn, NumberToSkip: Integer; Flags: TMongoQueryFlags): variant;
begin
  Database.Client.GetOneReadConnection.GetDocumentsAndFree(
    TMongoRequestQuery.Create(fFullCollectionName,
      Criteria,Projection,NumberToReturn,NumberToSkip,Flags),result);
end;

function TMongoCollection.FindDoc(Criteria: PUTF8Char;
  const Params: array of const; NumberToReturn, NumberToSkip: Integer;
  Flags: TMongoQueryFlags): variant;
begin
  result := FindDoc(BSONVariant(Criteria,[],Params),null,
    NumberToReturn,NumberToSkip,Flags);
end;

procedure TMongoCollection.FindDocs(Criteria: PUTF8Char;
  const Params: array of const; var result: TVariantDynArray;
  const Projection: variant; NumberToReturn, NumberToSkip: Integer;
  Flags: TMongoQueryFlags);
begin
  Database.Client.GetOneReadConnection.GetDocumentsAndFree(
    TMongoRequestQuery.Create(fFullCollectionName,
      BSONVariant(Criteria,[],Params),Projection,
      NumberToReturn,NumberToSkip,Flags),result);
end;

function TMongoCollection.FindDocs(Criteria: PUTF8Char; const Params: array of const;
  const Projection: variant; NumberToReturn,NumberToSkip: Integer;
  Flags: TMongoQueryFlags): TVariantDynArray;
begin
  FindDocs(Criteria,Params,result,Projection,NumberToReturn,NumberToSkip,Flags);
end;

function TMongoCollection.FindOne(const _id: TBSONObjectID): variant;
begin
  result := FindOne(['_id',_id.ToVariant]);
end;

function TMongoCollection.FindOne(const _id: variant): variant;
begin
  result := FindOne(['_id',_id]);
end;

function TMongoCollection.FindOne(const NameValuePairs: array of const;
  ReturnNewObjectIfNotFound: boolean): variant;
begin
  result := FindDoc(BSONVariant(NameValuePairs),null,1);
  if ReturnNewObjectIfNotFound and VarIsEmptyOrNull(result) then
    TDocVariantData(Result).InitObject(NameValuePairs,JSON_OPTIONS_FAST);
end;

procedure TMongoCollection.FindDocs(var result: TVariantDynArray;
  const Projection: variant; NumberToReturn, NumberToSkip: Integer;
  Flags: TMongoQueryFlags);
begin
  Database.Client.GetOneReadConnection.GetDocumentsAndFree(
    TMongoRequestQuery.Create(fFullCollectionName,null,Projection,
      NumberToReturn,NumberToSkip,Flags),result);
end;

function TMongoCollection.FindJSON(const Criteria, Projection: Variant;
  NumberToReturn, NumberToSkip: Integer; Flags: TMongoQueryFlags;
  Mode: TMongoJSONMode): RawUTF8;
begin
  result := Database.Client.GetOneReadConnection.GetJSONAndFree(
    TMongoRequestQuery.Create(fFullCollectionName,
      Criteria,Projection,NumberToReturn,NumberToSkip,Flags),Mode);
end;

function TMongoCollection.FindJSON(Criteria: PUTF8Char;
  const Params: array of const; NumberToReturn, NumberToSkip: Integer;
  Flags: TMongoQueryFlags; Mode: TMongoJSONMode): RawUTF8;
begin
  result := FindJSON(BSONVariant(Criteria,[],Params),null,
    NumberToReturn,NumberToSkip,Flags,Mode);
end;

function TMongoCollection.FindJSON(
  Criteria: PUTF8Char; const CriteriaParams: array of const;
  const Projection: variant; NumberToReturn, NumberToSkip: Integer;
  Flags: TMongoQueryFlags; Mode: TMongoJSONMode): RawUTF8;
begin
  result := FindJSON(BSONVariant(Criteria,[],CriteriaParams),
    Projection,NumberToReturn,NumberToSkip,Flags,Mode);
end;

procedure TMongoCollection.Insert(const Documents: array of variant;
  Flags: TMongoInsertFlags; NoAcknowledge: boolean);
begin
  Database.Client.Connections[0].SendAndFree(TMongoRequestInsert.Create(
    fFullCollectionName,Documents,Flags),NoAcknowledge);
end;

procedure TMongoCollection.Insert(const Documents: TBSONDocument;
  Flags: TMongoInsertFlags=[]; NoAcknowledge: boolean=false);
begin
  Database.Client.Connections[0].SendAndFree(TMongoRequestInsert.Create(
    fFullCollectionName,Documents,Flags),NoAcknowledge);
end;

procedure TMongoCollection.InsertJSON(const JSONDocuments: array of PUTF8Char;
  Flags: TMongoInsertFlags; NoAcknowledge: boolean);
begin
  Database.Client.Connections[0].SendAndFree(TMongoRequestInsert.Create(
    fFullCollectionName,JSONDocuments,Flags),NoAcknowledge);
end;

function EnsureDocumentHasID(var doc: TDocVariantData; var oid: variant;
  CreatedObjectID: PBSONObjectID): boolean;
var ndx: integer;
begin // return TRUE if _id has been computed (i.e. save=insert)
  ndx := doc.GetValueIndex('_id',3,true);
  if ndx<0 then begin
    oid := ObjectID;
    doc.AddValue('_id',oid);
    result := true;
  end else
  if TVarData(doc.Values[ndx]).VType<=varNull then begin
    oid := ObjectID;
    doc.Values[ndx] := oid;
    result := true;
  end else begin
    oid := doc.Values[ndx];
    result := false;
  end;
  if CreatedObjectID<>nil then
    CreatedObjectID^.FromVariant(oid)
end;

procedure TMongoCollection.Insert(const Document: RawUTF8;
  const Params: array of const; CreatedObjectID: PBSONObjectID);
var doc: variant;
    oid: variant;
begin
  _JsonFmt(Document,[],Params,JSON_OPTIONS_FAST,doc);
  EnsureDocumentHasID(TDocVariantData(doc),oid,CreatedObjectID);
  Insert([doc]);
end;

function TMongoCollection.Save(var Document: variant;
  CreatedObjectID: PBSONObjectID): boolean;
var oid: variant;
begin
  if not DocVariantType.IsOfType(Document) then
    Document := _JsonFast(VariantSaveMongoJSON(Document,modMongoShell));
  result := EnsureDocumentHasID(TDocVariantData(Document),oid,CreatedObjectID);
  if result then
    Insert([Document]) else
    Update(BSONVariant(['_id',oid]),Document,[mufUpsert])
end;

procedure TMongoCollection.Save(const Document: RawUTF8;
  const Params: array of const; CreatedObjectID: PBSONObjectID);
var doc: variant;
begin
  _JsonFmt(Document,[],Params,JSON_OPTIONS_FAST,doc);
  Save(doc,CreatedObjectID);
end;

procedure TMongoCollection.Update(Query: PUTF8Char;
  const QueryParams: array of const; const Update: RawUTF8;
  const UpdateParams: array of const; Flags: TMongoUpdateFlags);
var quer,upd: variant;
begin
  quer := BSONVariant(Query,[],QueryParams);
  upd := BSONVariant(Update,[],UpdateParams);
  self.Update(quer,upd,Flags);
end;

procedure TMongoCollection.Update(const Query, Update: variant;
  Flags: TMongoUpdateFlags);
begin
  Database.Client.Connections[0].SendAndFree(TMongoRequestUpdate.Create(
    fFullCollectionName,Query,Update,Flags),false);
end;

procedure TMongoCollection.UpdateOne(const _id, UpdatedFields: variant);
begin
  Update(BSONVariant(['_id',_id]),BSONVariant(['$set',UpdatedFields]));
end;

procedure TMongoCollection.Remove(const Query: variant;
  Flags: TMongoDeleteFlags);
begin
  Database.Client.Connections[0].SendAndFree(TMongoRequestDelete.Create(
    fFullCollectionName,Query,Flags),False);
end;

procedure TMongoCollection.RemoveOne(const _id: TBSONObjectID);
begin
  Remove(BSONVariant(['_id',_id.ToVariant]),[mdfSingleRemove]);
end;

procedure TMongoCollection.RemoveOne(const _id: variant);
begin
  Remove(BSONVariant(['_id',_id]),[mdfSingleRemove]);
end;

procedure TMongoCollection.RemoveFmt(Query: PUTF8Char;
  const QueryParams: array of const; Flags: TMongoDeleteFlags);
begin
  Remove(BSONVariant(Query,[],QueryParams),Flags);
end;


{ TDecimal128 }

// see https://github.com/mongodb/libbson/blob/master/src/bson/bson-decimal128.c

procedure TDecimal128.SetZero;
begin
  Bits.lo := 0;
  Bits.hi := BSON_DECIMAL128_HI_INT64POS;
end;

const
  D128: array[TDecimal128SpecialValue] of TDecimal128Bits = (
    // dsvError, dsvValue, dsvNan, dsvZero, dsvPosInf, dsvNegInf, dsvMin, dsvMax
    (hi:BSON_DECIMAL128_HI_NAN), (hi:BSON_DECIMAL128_HI_NAN), (hi:BSON_DECIMAL128_HI_NAN),
    (hi:BSON_DECIMAL128_HI_INT64POS), (hi:$7800000000000000),
    (hi:QWord($f800000000000000)), (lo:$378d8e63ffffffff; hi:QWord($dfffed09bead87c0)),
    (lo:$378d8e63ffffffff; hi:$5fffed09bead87c0) );

procedure TDecimal128.SetSpecial(special: TDecimal128SpecialValue);
begin
  Bits := D128[special];
end;

function TDecimal128.IsSpecial: TDecimal128SpecialValue;
begin
  for result := dsvNan to high(D128) do
    if (D128[result].hi=Bits.hi) and (D128[result].lo=Bits.lo) then
      exit;
  result := dsvValue;
end;

procedure TDecimal128.FromInt32(value: integer);
begin
  if value>=0 then begin
    Bits.lo := value;
    Bits.hi := BSON_DECIMAL128_HI_INT64POS;
  end else begin
    Bits.lo := -value;
    Bits.hi := BSON_DECIMAL128_HI_INT64NEG;
  end;
end;

procedure TDecimal128.FromUInt32(value: cardinal);
begin
  Bits.lo := value;
  Bits.hi := BSON_DECIMAL128_HI_INT64POS;
end;

procedure TDecimal128.FromInt64(value: Int64);
begin
  if value>=0 then begin
    Bits.lo := value;
    Bits.hi := BSON_DECIMAL128_HI_INT64POS;
  end else begin
    Bits.lo := -value;
    Bits.hi := BSON_DECIMAL128_HI_INT64NEG;
  end;
end;

procedure TDecimal128.FromQWord(value: QWord);
begin
  Bits.lo := value;
  Bits.hi := BSON_DECIMAL128_HI_INT64POS;
end;

function TDecimal128.FromFloat(const value: TSynExtended; precision: integer): boolean;
var tmp: shortstring;
begin
  if precision<=0 then
    precision := DOUBLE_PRECISION;
  tmp[0] := AnsiChar(ExtendedToString(tmp,value,precision));
  result := true;
  case ExtendedToStringNan(tmp) of
  seNan:    SetSpecial(dsvNan);
  seInf:    SetSpecial(dsvPosInf);
  seNegInf: SetSpecial(dsvNegInf);
  else result := FromText(@tmp[1],ord(tmp[0]))<>dsvError;
  end;
end;

procedure TDecimal128.FromCurr(const value: Currency);
begin // force exactly 4 decimals
  if value<0 then begin
    Bits.lo := -PInt64(@value)^;
    Bits.hi := BSON_DECIMAL128_HI_CURRNEG;
  end else begin
    Bits.lo := PInt64(@value)^;
    Bits.hi := BSON_DECIMAL128_HI_CURRPOS;
  end;
end;

function TDecimal128.Equals(const other: TDecimal128): boolean;
begin
  result := (Bits.lo=other.Bits.lo) and (Bits.hi=other.Bits.hi);
end;

function div128bits9digits(var value: THash128Rec): cardinal;
var r64: QWord;
    i: integer;
begin
  r64 := 0;
  for i := 0 to high(value.c) do begin
    r64 := r64 shl 32;   // adjust remainder to match value of next dividend
    inc(r64,value.c[i]); // add the divided to _rem
    if r64=0 then
      continue;
    value.c[i] := r64 div 1000000000;
    dec(r64,QWord(value.c[i])*1000000000);
  end;
  result := r64;
end;

{$ifdef CPU32DELPHI}
function x86div10(value: cardinal): cardinal;
asm // use fast reciprocal division for Delphi (FPC knows this optimization)
      mov   edx, 3435973837
      mul   edx
      shr   edx, 3
      mov   eax, edx
end;

procedure mul64(a,b: cardinal; out product64: QWord);
asm // Delphi is not efficient for x86 target with QWord -> optimize
      imul  edx
      mov   [ecx], eax
      mov   [ecx + 4], edx
end;
{$endif}

function TDecimal128.ToText(out Buffer: TDecimal128Str): integer;
var dest: PUTF8Char;
    exp, sciexp, signdig, radixpos: integer;
    combi, biasedexp, signmsb, leastdig, fastdiv: cardinal;
    digbuffer: array[0..35] of byte;
    dig: PByte;
    _128: THash128Rec;
    j, k: integer;
  procedure append(digits: integer);
  var i: integer;
  begin
    for i := 0 to digits-1 do begin
      dest^ := AnsiChar(dig^+ord('0'));
      inc(dig);
      inc(dest);
    end;
  end;
begin
  dest := @Buffer;
  if Int64(Bits.hi)<0 then begin
    dest^ := '-';
    inc(dest);
  end;
  if (Bits.lo=0) and (Bits.hi=0) then begin
    dest^ := '0';
    result := 1;
    exit;
  end;
  combi := (Bits.c[3] shr 26) and $1f;
  if combi shr 3=3 then
    case combi of
    30: begin
      result := AppendRawUTF8ToBuffer(dest,DECIMAL128_SPECIAL_TEXT[dsvPosInf])-@Buffer;
      exit;
    end;
    31: begin
      result := AppendRawUTF8ToBuffer(@Buffer,DECIMAL128_SPECIAL_TEXT[dsvNan])-@Buffer;
      exit;
    end;
    else begin
      biasedexp := (Bits.c[3] shr 15) and $3fff;
      signmsb := ((Bits.c[3] shr 14) and 1)+8;
    end;
    end
  else begin
    biasedexp := (Bits.c[3] shr 17) and $3fff;
    signmsb := (Bits.c[3] shr 14) and 7;
  end;
  exp := biasedexp-BSON_DECIMAL128_EXPONENT_BIAS;
  _128.c[0] := (Bits.c[3] and $3fff)+((signmsb and $0f)shl 14);
  _128.c[1] := Bits.c[2];
  _128.c[2] := Bits.c[1];
  _128.c[3] := Bits.c[0];
  FillCharFast(digbuffer,sizeof(digbuffer),0);
  dig := @digbuffer;
  if ((_128.lo=0) and (_128.hi=0)) or (_128.c[0]>=1 shl 17) then
    signdig := 1 // non-canonical or zero -> 0
  else begin
    for k := 3 downto 0 do begin
      if (_128.lo=0) and (_128.hi=0) then
        break;
      leastdig := div128bits9digits(_128);
      if leastdig=0 then
        continue;
      for j := 8 downto 0 do begin
        fastdiv := leastdig;
        {$ifdef CPU32DELPHI}
        leastdig := x86div10(leastdig); // Delphi compiler is not efficient
        {$else}
        leastdig := leastdig div 10; // FPC will use reciprocal division
        {$endif}
        digbuffer[k*9+j] := fastdiv-leastdig*10;
        if leastdig=0 then
          break;
      end;
    end;
    signdig := 36; // 4*9 = k*j loops above
    while dig^=0 do begin
      dec(signdig);
      inc(dig);
    end;
  end;
  sciexp := signdig-1+exp;
  if (sciexp<-6) or (exp>0) then begin // scientific format
    dest^ := AnsiChar(dig^+ord('0'));
    inc(dig);
    inc(dest);
    dec(signdig);
    if signdig<>0 then begin
      dest^ := '.';
      inc(dest);
      append(signdig);
    end;
    if sciexp>0 then
      PWord(dest)^ := ord('E')+ord('+')shl 8 else begin
      PWord(dest)^ := ord('E')+ord('-')shl 8;
      sciexp := -sciexp;
    end;
    dest := AppendUInt32ToBuffer(dest+2,sciexp)
  end else begin
    if exp>=0 then // regular format with no decimal place
      append(signdig)
    else begin
      radixpos := signdig+exp;
      if radixpos>0 then // non-zero digits before radix
        append(radixpos)
      else begin
        dest^ := '0'; // leading zero before radix point
        inc(dest);
      end;
      dest^ := '.';   // radix char
      inc(dest);
      while radixpos<0 do begin // leading zeros after radix
        dest^ := '0';
        inc(dest);
        inc(radixpos);
      end;
      append(signdig-radixpos);
    end;
  end;
  result := dest-@Buffer;
end;

function TDecimal128.ToText: RawUTF8;
var tmp: TDecimal128Str;
begin
  SetString(result,PAnsiChar(@tmp),ToText(tmp));
end;

procedure TDecimal128.ToText(var result: RawUTF8);
var tmp: TDecimal128Str;
begin
  SetString(result,PAnsiChar(@tmp),ToText(tmp));
end;

procedure TDecimal128.AddText(W: TTextWriter);
var tmp: TDecimal128Str;
begin
  W.AddNoJSONEscape(@tmp,ToText(tmp));
end;

function TDecimal128.ToVariant: variant;
begin
  ToVariant(result);
end;

procedure TDecimal128.ToVariant(out result: variant);
begin
  with TBSONVariantData(result) do begin
    VType := BSONVariantType.VarType;
    VKind := betDecimal128;
    VBlob := nil;
    SetString(RawByteString(VBlob),PAnsiChar(@Bits),sizeof(TDecimal128));
  end;
end;

function TDecimal128.ToFloat: TSynExtended;
var tmp: TDecimal128Str;
begin
  tmp[ToText(tmp)] := #0; // makes ASCIIZ temporary text conversion
  result := GetExtended(@tmp);
end;

function TDecimal128.ToCurr: currency;
begin
  ToCurr(result);
end;

procedure TDecimal128.ToCurr(out result: currency);
var tmp: TDecimal128Str;
    res64: Int64 absolute result;
begin
  if Bits.hi=BSON_DECIMAL128_HI_CURRNEG then // fast direct conversion e.g. FromCurr
    res64 := -Bits.lo else
  if Bits.hi=BSON_DECIMAL128_HI_CURRPOS then
    res64 := Bits.lo else begin
    tmp[ToText(tmp)] := #0; // makes ASCIIZ temporary text conversion
    res64 := StrToCurr64(@tmp);
  end;
end;

procedure mul64x64(const left, right: QWord; out product: THash128Rec);
{$ifdef CPUX86}
asm // adapted from FPC compiler output, which is much better than Delphi's here
        mov     ecx, eax
        mov     eax, dword ptr [ebp+8H]
        mul     dword ptr [ebp+10H]
        mov     dword ptr [ecx], eax
        mov     dword ptr [ebp-4H], edx
        mov     eax, dword ptr [ebp+8H]
        mul     dword ptr [ebp+14H]
        add     eax, dword ptr [ebp-4H]
        adc     edx, 0
        mov     dword ptr [ebp-10H], eax
        mov     dword ptr [ebp-0CH], edx
        mov     eax, dword ptr [ebp+0CH]
        mul     dword ptr [ebp+10H]
        add     eax, dword ptr [ebp-10H]
        adc     edx, 0
        mov     dword ptr [ecx+4H], eax
        mov     dword ptr [ebp-14H], edx
        mov     eax, dword ptr [ebp+0CH]
        mul     dword ptr [ebp+14H]
        add     eax, dword ptr [ebp-0CH]
        adc     edx, 0
        add     eax, dword ptr [ebp-14H]
        adc     edx, 0
        mov     dword ptr [ecx+8H], eax
        mov     dword ptr [ecx+0CH], edx
end;
{$else}
var l: TQWordRec absolute left;
    r: TQWordRec absolute right;
    t1,t2,t3: TQWordRec;
begin
  {$ifdef CPU32DELPHI}
  mul64(l.L,r.L,t1.V);
  mul64(l.H,r.L,t2.V);
  inc(t2.V,t1.H);
  mul64(l.L,r.H,t3.V);
  inc(t3.V,t2.L);
  mul64(l.H,r.H,product.H);
  inc(product.H,t2.H+t3.H);
  product.c0 := t1.L;
  product.c1 := t3.V;
  {$else}
  t1.V := QWord(l.L)*r.L;
  t2.V := QWord(l.H)*r.L+t1.H;
  t3.V := QWord(l.L)*r.H+t2.L;
  product.H := QWord(l.H)*r.H+t2.H+t3.H;
  product.L := t3.V shl 32 or t1.L;
  {$endif}
end;
{$endif}

function TDecimal128.FromText(text: PUTF8Char; textlen: integer): TDecimal128SpecialValue;
var P,PEnd: PUTF8Char;
    c: AnsiChar;
    flags: set of (negative, signed, radix, nonzero);
    digits: array[0..BSON_DECIMAL128_MAX_DIGITS-1] of byte;
    firstnon0, digread, digstored, digcount, radixpos,
    digfirst, diglast, exp, signdig, i: integer;
    signhi, signlo: QWord;
    biasedexp: cardinal;
    sign: THash128Rec;
begin
  for result := dsvNan to dsvNegInf do
    if IdemPropNameU(DECIMAL128_SPECIAL_TEXT[result],text,textlen) then begin
      Bits := D128[result];
      exit; // fast recognition of special text values (including '0')
    end;
  Bits := D128[dsvError];
  result := dsvError;
  if (textlen=0) or (text=nil) then
    exit;
  P := text;
  PEnd := text+textlen;
  flags := [];
  if P^ in ['+','-'] then begin
    include(flags,signed);
    if P^='-' then
      include(flags,negative);
    inc(P);
  end;
  digcount := 0;
  digread := 0;
  digstored := 0;
  radixpos := 0;
  firstnon0 := 0;
  exp := 0;
  while P<PEnd do begin
    c := P^;
    case c of
    '.':
      if radix in flags then // duplicated '.'
        exit else begin
        include(flags,radix);
        inc(P);
        continue;
      end;
    '0'..'9':
      if digstored<BSON_DECIMAL128_MAX_DIGITS then
        if (c>'0') or (nonzero in flags) then begin
          if not(nonzero in flags) then begin
            firstnon0 := digread;
            include(flags,nonzero);
          end;
          digits[digstored] := ord(c)-ord('0');
          inc(digstored);
        end;
    'E','e': begin
      inc(P);
      if P>=PEnd then
        exit;
      exp := GetInteger(P,PEnd);
      break;
    end;
    else exit;
    end;
    if nonzero in flags then
      inc(digcount);
    if radix in flags then
      inc(radixpos);
    inc(digread);
    inc(P);
  end;
  if digread=0 then
    exit;
  digfirst := 0;
  if digstored=0 then begin // value is zero
    diglast := 0;
    digits[0] := 0;
    digcount := 1;
    digstored := 1;
    signdig := 0;
  end else begin
    diglast := digstored-1;
    signdig := digcount;
    // handle trailing zeros as non-significant
    while text[firstnon0+signdig-1+ord(radix in flags)+ord(signed in flags)]='0' do
      dec(signdig);
  end;
  if (exp<=radixpos) and (radixpos-exp>1 shl 14) then
    exp := BSON_DECIMAL128_EXPONENT_MIN else
    dec(exp,radixpos);
  while exp>BSON_DECIMAL128_EXPONENT_MAX do begin
    inc(diglast);
    digits[diglast] := 0;
    if diglast-digfirst>BSON_DECIMAL128_MAX_DIGITS then
      if signdig=0 then begin // zero clamping is allowed
        exp := BSON_DECIMAL128_EXPONENT_MAX;
        break;
      end else
        exit; // overflow is not permitted
    dec(exp);
  end;
  while (exp<BSON_DECIMAL128_EXPONENT_MIN) or (digstored<digcount) do begin
    if diglast=0 then
      if signdig=0 then begin // zero clamping
        exp := BSON_DECIMAL128_EXPONENT_MIN;
        break;
      end else
        exit; // overflow
    if digstored<digcount then
      if (text[digcount-1+ord(signed in flags)+ord(radix in flags)]<>'0') and
         (signdig<>0) then
        exit else // overflow 
        dec(digcount) else // adjust to non stored digits
      if digits[diglast]<>0 then
        exit else // inexact rounding
        dec(diglast); // adjust to round
    if exp<BSON_DECIMAL128_EXPONENT_MAX then
      inc(exp) else
      exit;
  end;
  if diglast-digfirst+1<signdig then
    if text[firstnon0+diglast+ord(signed in flags)+ord(radix in flags)]<>'0' then
      exit; // inexact rouding
  signhi := 0;
  signlo := 0;
  if signdig<>0 then // if not zero
    if diglast-digfirst<17 then
      for i := digfirst to diglast do
      {$ifdef CPU32DELPHI} // use "shl" under x86 to avoid slower "call _llmul"
        inc(signlo,signlo+signlo shl 3+digits[i]) else begin
      for i := digfirst to diglast-17 do
        inc(signhi,signhi+signhi shl 3+digits[i]);
      for i := diglast-16 to diglast do
        inc(signlo,signlo+signlo shl 3+digits[i]);
      {$else}
        signlo := signlo*10+digits[i] else begin
      for i := digfirst to diglast-17 do
        signhi := signhi*10+digits[i];
      for i := diglast-16 to diglast do
        signlo := signlo*10+digits[i];
      {$endif}
    end;
  if signhi=0 then begin
    sign.L := signlo;
    sign.H := 0;
  end else begin
    mul64x64(signhi,100000000000000000,sign);
    inc(sign.L,signlo);
    {$ifdef FPC}
    if sign.L<signlo then
    {$else} // manual QWord processs (for oldest Delphi compilers)
    if (sign.c1<TQWordRec(signlo).H) or
       ((sign.c1=TQWordRec(signlo).H) and (sign.c0<TQWordRec(signlo).L)) then
    {$endif}
      inc(sign.H);
  end;
  biasedexp := exp+BSON_DECIMAL128_EXPONENT_BIAS;
  if (sign.H shr 49)and 1<>0 then
    Bits.hi := (3 shl 61) or (QWord(biasedexp and $3fff)shl 47) or
      (sign.H and $7fffffffffff) else
    Bits.hi := (QWord(biasedexp and $3fff)shl 49) or
      (sign.H and $1ffffffffffff);
  Bits.lo := sign.L;
  if negative in flags then
    Bits.c[3] := Bits.c[3] or $80000000;
  result := dsvValue;
end;

function TDecimal128.FromText(const text: RawUTF8): TDecimal128SpecialValue;
begin
  result := FromText(pointer(text),length(text));
end;

function TDecimal128.FromVariant(const value: variant): boolean;
var txt: RawUTF8;
    wasString: boolean;
    bson: TBSONVariantData absolute value;
begin
  if TVarData(value).VType=varByRef or varVariant then
    result := FromVariant(PVariant(TVarData(value).VPointer)^) else
  if (bson.VType=BSONVariantType.VarType) and (bson.VKind=betDecimal128) then begin
    Bits := PDecimal128(bson.VBlob)^.Bits;
    result := true;
  end else begin
    VariantToUTF8(value,txt,wasString);
    result := wasString and (FromText(txt)<>dsvError);
  end;
end;

initialization
  Assert(sizeof(TDecimal128)=16);
  Assert(ord(betEof)=$00);
  Assert(ord(betInt64)=$12);
  Assert(ord(betDecimal128)=$13);
  Assert(ord(bbtGeneric)=$00);
  Assert(ord(bbtMD5)=$05);
  Assert(ord(bbtUser)=$80);
  Assert(sizeof(TBSONObjectID)=12);
  Assert(sizeof(TBSONVariantData)=sizeof(variant));
  Assert(sizeof(TMongoReplyHeader)=36);
  // ensure TDocVariant and TBSONVariant custom types are registered
  if DocVariantType=nil then
    DocVariantType := TDocVariant(SynRegisterCustomVariantType(TDocVariant));
  BSONVariantType := SynRegisterCustomVariantType(TBSONVariant) as TBSONVariant;
  InitBSONObjectIDComputeNew;

finalization
  DeleteCriticalSection(GlobalBSONObjectID.Section);
end.