dualarrow

GraphQL

Feb 18th, 2022 (edited)
386
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.54 KB | None | 0 0
  1. unit GraphQL.Sample;
  2.  
  3. interface
  4.  
  5. uses
  6.   GraphQL.WebBroker, GraphQL.Http.Handler, GraphQL.Http.Interfaces,
  7.   GraphQL.Schema, GraphQL.Comp.Schema;
  8.  
  9. type
  10.   TGraphQL = class
  11.   private
  12.     fHttp: TGraphQLHttpHandler;
  13.     fSchema: TSchemaDocument;
  14.   public
  15.     constructor Create;
  16.     function SendReq(aReq: ansistring): string;
  17.   end;
  18.  
  19.   TRequest = class(TInterfacedObject, IGraphQLHttpRequest)
  20.   private
  21.     fMethod: string;
  22.     fURL: string;
  23.     fContent: ansistring;
  24.   public
  25.     function GetMethod: string;
  26.     function GetHeader(const Name: string): string;
  27.     function GetContent: TArray<Byte>;
  28.     function GetUrl: string;
  29.   end;
  30.  
  31.   TResponse = class(TInterfacedObject, IGraphQLHttpResponse)
  32.   private
  33.     fStatus: integer;
  34.     fContent: ansistring;
  35.   public
  36.     procedure SetStatusCode(const Value: Integer);
  37.     procedure SetHeader(const Name: string; const Value: string);
  38.     procedure Close(const Value: TArray<Byte>);
  39.     property Content: ansistring read fContent;
  40.   end;
  41.  
  42. type
  43.   TTest = class
  44.   private
  45.     fName: string;
  46.     fId: integer;
  47.   public
  48.     constructor Create;
  49.     property Id: integer read fId;
  50.     property Name: string read fName;
  51.   end;
  52.  
  53.   TQuery = class
  54.     function Test: TTest;
  55.   end;
  56.  
  57. implementation
  58.  
  59. uses
  60.   GraphQL.Helpers,
  61.   SysUtils;
  62.  
  63. const
  64.   AppSchema =
  65.     'type Test {                                ' + sLineBreak +
  66.     '  id: ID!                                  ' + sLineBreak +
  67.     '  name: String!                            ' + sLineBreak +
  68.     '}                                          ' + sLineBreak +
  69.     '                                           ' + sLineBreak +
  70.     'type Query {                               ' + sLineBreak +
  71.     '  test: Test                               ' + sLineBreak +
  72.     '}                                          ';
  73.  
  74.  
  75. { TGraphQL }
  76.  
  77. constructor TGraphQL.Create;
  78. begin
  79.   fSchema := TSchemaDocument.Parse(AppSchema);
  80.   fSchema.Init;
  81.   fSchema.Bind('Query', TQuery);
  82. end;
  83.  
  84. function TGraphQL.SendReq(aReq: ansistring): string;
  85. begin
  86.   aReq := 'query GetTest {     ' + #13#10 +
  87.           '  test {            ' + #13#10 +
  88.           '    name            ' + #13#10 +
  89.           '  }                 ' + #13#10 +
  90.           '}                   ';
  91.  
  92.  
  93.   var req := TRequest.Create;
  94.   var resp := TResponse.Create;
  95.  
  96.   req.fMethod := 'POST';
  97.   req.fUrl := 'http://test.com/test';
  98.   req.fContent := aReq;
  99.  
  100.   fHttp := TGraphQLHttpHandler.Create(req, resp, fSchema);
  101.   fHttp.ProcessRequest;
  102.   result := resp.Content;
  103.   fHttp.Free;
  104. end;
  105.  
  106. { TRequest }
  107.  
  108. function TRequest.GetContent: TArray<Byte>;
  109. begin
  110.   SetLength(result, length(fContent));
  111.   move(fContent[1], result[0], length(result));
  112. end;
  113.  
  114. function TRequest.GetHeader(const Name: string): string;
  115. begin
  116.   if SameText(name, 'Content-Type') then
  117.     result := 'application/graphql'
  118.   else
  119.     result := '';
  120. end;
  121.  
  122. function TRequest.GetMethod: string;
  123. begin
  124.   result := fMethod;
  125. end;
  126.  
  127. function TRequest.GetUrl: string;
  128. begin
  129.   result := fURL;
  130. end;
  131.  
  132. { TResponse }
  133.  
  134. procedure TResponse.Close(const Value: TArray<Byte>);
  135. begin
  136.   SetLength(fContent, length(value));
  137.   move(value[0], fContent[1], length(value));
  138. end;
  139.  
  140. procedure TResponse.SetHeader(const Name, Value: string);
  141. begin
  142.  
  143. end;
  144.  
  145. procedure TResponse.SetStatusCode(const Value: Integer);
  146. begin
  147.   fStatus := value;
  148. end;
  149.  
  150. { TQuery }
  151.  
  152. function TQuery.Test: TTest;
  153. begin
  154.   result := TTest.Create;
  155. end;
  156.  
  157. { TTest }
  158.  
  159. constructor TTest.Create;
  160. begin
  161.   fId := 1;
  162.   fName := 'Hello World';
  163. end;
  164.  
  165. end.
  166.  
Add Comment
Please, Sign In to add comment