├── .gitignore ├── Assets └── Logo │ ├── logo-1024.png │ ├── logo-128.png │ ├── logo-512.png │ ├── logo-original.jpg │ ├── logo-original.png │ └── logo-original.svg ├── LICENSE ├── Prometheus.Client.groupproj ├── README.md ├── Samples ├── Starter-DMVC │ ├── Controllers.Demo.pas │ ├── Starter.Sample.DMVC.dpr │ ├── Starter.Sample.DMVC.dproj │ ├── Starter.Sample.DMVC.res │ ├── WebModules.App.dfm │ └── WebModules.App.pas ├── Starter-Horse │ ├── Starter.Sample.Horse.dpr │ ├── Starter.Sample.Horse.dproj │ ├── Starter.Sample.Horse.res │ ├── Starter.Sample.HorseApp.dpr │ ├── Starter.Sample.HorseApp.dproj │ └── Starter.Sample.HorseApp.res ├── Starter-WebBroker │ ├── Forms.Main.dfm │ ├── Forms.Main.pas │ ├── Services.Memory.pas │ ├── Starter.Sample.WebBroker.dpr │ ├── Starter.Sample.WebBroker.dproj │ ├── Starter.Sample.WebBroker.res │ ├── Starter.Sample.WebBrokerApp.dpr │ ├── Starter.Sample.WebBrokerApp.dproj │ ├── WebModules.Prom.dfm │ └── WebModules.Prom.pas └── Starter-WiRL │ ├── Server.Forms.Main.dfm │ ├── Server.Forms.Main.pas │ ├── Server.Resources.Metrics.pas │ ├── Server.Resources.Samples.pas │ ├── Starter.Sample.WiRL.dpr │ ├── Starter.Sample.WiRL.dproj │ ├── Starter.Sample.WiRL.res │ ├── Starter.Sample.WiRLApp.dpr │ └── Starter.Sample.WiRLApp.dproj ├── Source ├── Prometheus.Client.Core.dpk ├── Prometheus.Client.Core.dproj ├── Prometheus.Client.Core.res ├── Prometheus.Collector.pas ├── Prometheus.Collectors.Counter.pas ├── Prometheus.Collectors.Gauge.pas ├── Prometheus.Collectors.Histogram.pas ├── Prometheus.Exposers.Text.pas ├── Prometheus.Labels.pas ├── Prometheus.Metrics.pas ├── Prometheus.Registry.pas ├── Prometheus.Resources.pas ├── Prometheus.Samples.pas └── Prometheus.SimpleCollector.pas ├── Tests ├── Fixtures │ ├── Prometheus.Tests.Fixtures.Collector.pas │ ├── Prometheus.Tests.Fixtures.Collectors.Counter.pas │ ├── Prometheus.Tests.Fixtures.Collectors.Gauge.pas │ └── Prometheus.Tests.Fixtures.Collectors.Histogram.pas ├── Prometheus.Client.Tests.dpr ├── Prometheus.Client.Tests.dproj └── Prometheus.Client.Tests.res ├── boss-lock.json └── boss.json /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | *.delphilsp.json 60 | 61 | # Delphi history and backups 62 | __history/ 63 | __recovery/ 64 | *.~* 65 | 66 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 67 | *.stat 68 | 69 | # DUnitX 70 | dunitx-results.xml 71 | 72 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 73 | modules/ 74 | 75 | -------------------------------------------------------------------------------- /Assets/Logo/logo-1024.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Assets/Logo/logo-1024.png -------------------------------------------------------------------------------- /Assets/Logo/logo-128.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Assets/Logo/logo-128.png -------------------------------------------------------------------------------- /Assets/Logo/logo-512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Assets/Logo/logo-512.png -------------------------------------------------------------------------------- /Assets/Logo/logo-original.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Assets/Logo/logo-original.jpg -------------------------------------------------------------------------------- /Assets/Logo/logo-original.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Assets/Logo/logo-original.png -------------------------------------------------------------------------------- /Assets/Logo/logo-original.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 227 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Marco Breveglieri 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Prometheus.Client.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {B47049D2-F3BA-413F-92FE-EF4066D88FCA} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |
2 | Prometheus Client for Delphi 3 |

Prometheus Client for Delphi

4 |
5 |
6 | 7 | This is a Delphi client library for [Prometheus](http://prometheus.io), similar to [libraries created for other languages](https://prometheus.io/docs/instrumenting/writing_clientlibs/). 8 | 9 | ## Overview 10 | 11 | The **Prometheus Delphi Client** library is a set of classes that allow you to instrument your Delphi applications with *Prometheus* metrics. 12 | 13 | It allows you to instrument your Delphi code with custom metrics and provides some built-in and ready to use metrics. 14 | 15 | The library also supports Prometheus' text based exposition format, that can be configured and made available via an HTTP endpoint on your Web application's instance using specific middlewares or directly calling the text exporter. 16 | 17 | ### What is Prometheus 18 | 19 | [Prometheus](http://prometheus.io) is a popular open-source monitoring tool that is widely used in modern software environments. It provides a powerful system for collecting and analyzing metrics from various sources, including applications, servers, and other systems. 20 | 21 | To use *Prometheus* effectively, you need a [client library](https://prometheus.io/docs/instrumenting/clientlibs/) implemented in your favorite programming language that can be integrated into your applications to expose the relevant metrics to the Prometheus server. 22 | 23 | Here we will discuss the client library for Prometheus written for [Embarcadero Delphi](https://www.embarcadero.com/products/delphi/). 24 | 25 | ### Main Features 26 | 27 | The Prometheus Delphi Client library offers a **range of features** that make it a powerful and flexible tool for monitoring Delphi applications using Prometheus. 28 | 29 | By using the library, you can gain valuable insights into the performance and behavior of your Delphi applications and make data-driven decisions to improve them. 30 | 31 | Here are some of supported features: 32 | 33 | + **Basic metrics**: the library allows you to define some basic metrics supported by Prometheus to track some relevant values in your application, like the number of times an event has occured or the current amount of allocated memory and so on. 34 | + **Labels**: these are key-value pairs that allow you to add additional context to your metrics. 35 | + **Custom Collectors**: the library allows you to define custom collectors that can be used to collect metrics from any source. 36 | 37 | ## Getting Started 38 | 39 | To get started with the Prometheus Delphi Client library, you need to follow these steps. 40 | 41 | ### ⚙ Install the library 42 | 43 | Installation is done using the [`boss install`](https://github.com/HashLoad/boss) command: 44 | ``` sh 45 | boss install marcobreveglieri/prometheus-client-delphi 46 | ``` 47 | If you choose to install it manually, download the source code from GitHub simply add the following folders to your project, in *Project > Options > Resource Compiler > Directories and Conditionals > Include file search path* 48 | ``` 49 | prometheus-client-delphi/Source 50 | ``` 51 | 52 | ### 📏 Define your metrics 53 | 54 | Define the metrics you want to track using the appropriate classes (see below). 55 | 56 | ### 📒 Register your metrics 57 | 58 | Register your metrics inside the default collector registry or in a registry of your own for subsequent handling and exportation. 59 | 60 | ### ✔ Update your metrics 61 | 62 | Update your metrics as needed calling the appropriate methods you can find on collector instance depending on the classes they are based to. 63 | 64 | ### 💾 Export all your metric samples 65 | 66 | You can export your metrics calling the text based exporter or making use of a ready to use middleware that targets your favourite Delphi Web framework (see [Middlewares](#Middlewares) section below for details). 67 | 68 | ## Metrics 69 | 70 | Prometheus Delphi Client supports the following metric types. 71 | 72 | ### Counter 73 | 74 | A **counter** is a cumulative metric that represents a single monotonically increasing counter whose value can only increase or be reset to zero on restart. For example, you can use a counter to represent the number of requests served, tasks completed, or errors. 75 | 76 | Do not use a counter to expose a value that can decrease. For example, do not use a counter for the number of currently running processes; instead use a gauge. 77 | 78 | ```delphi 79 | uses 80 | Prometheus.Collectors.Counter; 81 | 82 | begin 83 | var LCounter := TCounter.Create('sample', 'Description of this counter'); 84 | LCounter.Inc(); // increment by 1 85 | LCounter.Inc(123); // increment by 123 86 | end. 87 | ``` 88 | 89 | ### Gauge 90 | 91 | A **gauge** is a metric that represents a single numerical value that can arbitrarily go up and down. 92 | 93 | Gauges are typically used for measured values like temperatures or current memory usage, but also "counts" that can go up and down, like the number of concurrent requests. 94 | 95 | ```delphi 96 | uses 97 | Prometheus.Collectors.Gauge; 98 | 99 | begin 100 | var LGauge := TGauge.Create('sample', 'Description of this gauge'); 101 | LGauge.Inc(); // increment by 1 102 | LGauge.Inc(123); // increment by 123 103 | LGauge.Dec(10); // decrement by 10 104 | LGauge.SetTo(123); // set value directly to 123 105 | LGauge.SetDuration( // set value to duration of method execution 106 | procedure 107 | begin 108 | // User code 109 | end); 110 | end. 111 | ``` 112 | 113 | ### Histogram 114 | 115 | A **histogram** samples observations (usually things like request durations or response sizes) and counts them in configurable buckets. It also provides a sum of all observed values. 116 | 117 | ```delphi 118 | uses 119 | Prometheus.Collectors.Histogram; 120 | 121 | begin 122 | LHistogram := THistogram.Create('Name of histogram metric', 'Help text for histogram metric'); 123 | // If buckets argument is not supplied, the default values will be used: 124 | // [0.005, 0.01, 0.025, 0.05, 0.075, 0.1, 0.25, 0.5, 0.75, 1, 2.5, 5, 7.5, 10, INFINITE]. 125 | LHistogram.Observe(0.01); 126 | LHistogram.Observe(0.04); 127 | LHistogram.Observe(1); 128 | end. 129 | ``` 130 | 131 | ### Summary 132 | 133 | Similar to a histogram, a **summary** samples observations (usually things like request durations and response sizes). While it also provides a total count of observations and a sum of all observed values, it calculates configurable quantiles over a sliding time window. 134 | 135 | *** !!! Under Development !!! *** 136 | 137 | ### Custom metrics 138 | 139 | You can also implement your own custom metrics by inheriting the appropriate classes (**TCollector** or **TSimpleCollector**). 140 | 141 | ## Labels 142 | 143 | All metrics can have **labels**, allowing grouping of related time series. 144 | 145 | Taking a counter as an example: 146 | 147 | ```delphi 148 | uses 149 | Prometheus.Collectors.Counter; 150 | 151 | begin 152 | var LCounter := TCounter 153 | .Create('http_requests_handled', 'HTTP handled requests total', ['path', 'status']) 154 | .Register(); 155 | end. 156 | ``` 157 | 158 | Metrics with labels are not initialized when declared, because the client can't know what values the label can have. 159 | It is recommended to initialize the label values by calling the appropriate method and then eventually call another method to alter the value of the metric associated to label values: 160 | 161 | ```delphi 162 | uses 163 | Prometheus.Collectors.Counter; 164 | 165 | begin 166 | TCollectorRegistry.DefaultRegistry 167 | .GetCollector('http_requests_handled') 168 | .Labels(['/api', 200]) // ['path', 'status'] 169 | .Inc(); // increment child counter attached to these label values 170 | end. 171 | ``` 172 | 173 | ## Exporting metrics 174 | 175 | There are several options for exporting metrics. For example, you can export metrics from a *Windows Service Application* using a **TIdHttp** server component from *Indy Components* and exposing a "/metrics" endpoint where you export text based metrics data to Prometheus server. 176 | 177 | You can also download a middleware for your favourite Web framework or take a look at the sample projects. 178 | 179 | ## Middlewares 180 | 181 | To ease the use of Prometheus Client inside Web applications created with Delphi, you will find here **middlewares** to download and install. 182 | 183 | Each middleware integrates support for exposing metrics to Prometheus server using the appropriate format and without having to code each endpoint manually. 184 | 185 | You can find official **Prometheus Client middlewares** into these separate repositories: 186 | 187 | | Middleware | 188 | | ------------------------------------------------------------------------------------------ | 189 | | [Delphi MVC Framework](https://github.com/marcobreveglieri/dmvc-prometheus-metrics) | 190 | | [Horse](https://github.com/marcobreveglieri/horse-prometheus-metrics) | 191 | 192 | ## Delphi compatibility 193 | 194 | *Prometheus Client* works with **Delphi 11 Alexandria** as it makes use of advanced features of Delphi language, but with some slight changes it maybe could work in previous versions. 195 | 196 | ## Additional links 197 | 198 | + [Prometheus Official Page](https://prometheus.io) 199 | + [Using Delphi with Prometheus and Grafana (in Italian language)](https://www.youtube.com/watch?v=-bPDl6MP6jo) 200 | 201 | -------------------------------------------------------------------------------- /Samples/Starter-DMVC/Controllers.Demo.pas: -------------------------------------------------------------------------------- 1 | unit Controllers.Demo; 2 | 3 | interface 4 | 5 | uses 6 | System.Diagnostics, 7 | MVCFramework, 8 | MVCFramework.Commons, 9 | Prometheus.Collectors.Histogram; 10 | 11 | type 12 | 13 | { TDemoController } 14 | 15 | [MVCPath('/')] 16 | TDemoController = class(TMVCController) 17 | private 18 | FDuration: TStopwatch; 19 | function ResponseDurationHistogram: THistogram; 20 | function ResponseLengthHistogram: THistogram; 21 | function FilesSentHistogram: THistogram; 22 | protected 23 | procedure OnBeforeAction(AContext: TWebContext; const AActionName: string; 24 | var AHandled: Boolean); override; 25 | procedure OnAfterAction(AContext: TWebContext; const AActionName: string); override; 26 | public 27 | [MVCPath('/')] 28 | [MVCHTTPMethod([httpGET])] 29 | [MVCProduces(TMVCMediaType.TEXT_PLAIN)] 30 | procedure HelloWorld; 31 | [MVCPath('/redirect')] 32 | [MVCHTTPMethod([httpGET])] 33 | [MVCProduces(TMVCMediaType.TEXT_PLAIN)] 34 | procedure RedirectTo; 35 | end; 36 | 37 | implementation 38 | 39 | uses 40 | System.SysUtils, 41 | Prometheus.Collectors.Counter, 42 | Prometheus.Registry; 43 | 44 | { TDemoController } 45 | 46 | procedure TDemoController.HelloWorld; 47 | begin 48 | // Get the metric counter and increment it. 49 | TCollectorRegistry.DefaultRegistry 50 | .GetCollector('http_requests_count') 51 | .Inc(); 52 | Sleep(Random(1000)); 53 | // Render a sample string of text. 54 | Render('Hello World! It''s ' + TimeToStr(Time) + ' in the DMVCFramework Land!'); 55 | end; 56 | 57 | procedure TDemoController.RedirectTo; 58 | begin 59 | Redirect('/'); 60 | end; 61 | 62 | function TDemoController.FilesSentHistogram: THistogram; 63 | begin 64 | Result := TCollectorRegistry.DefaultRegistry 65 | .GetCollector('files_sent'); 66 | end; 67 | 68 | function TDemoController.ResponseDurationHistogram: THistogram; 69 | begin 70 | Result := TCollectorRegistry.DefaultRegistry.GetCollector('request_duration_seconds'); 71 | end; 72 | 73 | function TDemoController.ResponseLengthHistogram: THistogram; 74 | begin 75 | Result := TCollectorRegistry.DefaultRegistry.GetCollector('response_length'); 76 | end; 77 | 78 | procedure TDemoController.OnAfterAction(AContext: TWebContext; const AActionName: string); 79 | begin 80 | inherited; 81 | ResponseDurationHistogram 82 | .Labels([AContext.Request.PathInfo, AContext.Response.StatusCode.ToString ]) 83 | .Observe(FDuration.Elapsed.TotalSeconds); 84 | ResponseLengthHistogram 85 | .Observe(AContext.Response.RawWebResponse.ContentLength); 86 | FilesSentHistogram.Observe(Random(50)); 87 | end; 88 | 89 | procedure TDemoController.OnBeforeAction(AContext: TWebContext; const AActionName: string; var AHandled: Boolean); 90 | begin 91 | FDuration := TStopwatch.Create; 92 | FDuration.Start; 93 | inherited; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /Samples/Starter-DMVC/Starter.Sample.DMVC.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.DMVC; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | 6 | uses 7 | System.SysUtils, 8 | Web.WebReq, 9 | IdHTTPWebBrokerBridge, 10 | WebModules.App in 'WebModules.App.pas' {AppWebModule: TWebModule}, 11 | Controllers.Demo in 'Controllers.Demo.pas'; 12 | 13 | {$R *.res} 14 | 15 | var 16 | LServer: TIdHTTPWebBrokerBridge; 17 | 18 | procedure StartServer(APort: Integer); 19 | begin 20 | Writeln(Format('Starting HTTP Server or port %d', [APort])); 21 | LServer := TIdHTTPWebBrokerBridge.Create(nil); 22 | try 23 | LServer.DefaultPort := APort; 24 | LServer.MaxConnections := 0; 25 | LServer.ListenQueue := 200; 26 | LServer.Active := True; 27 | WriteLn('Press ENTER to quit the server.'); 28 | Readln; 29 | finally 30 | LServer.Free; 31 | end; 32 | end; 33 | 34 | begin 35 | ReportMemoryLeaksOnShutdown := True; 36 | try 37 | if WebRequestHandler <> nil then 38 | WebRequestHandler.WebModuleClass := WebModuleClass; 39 | WebRequestHandlerProc.MaxConnections := 1024; 40 | StartServer(9000); 41 | except 42 | on E: Exception do 43 | Writeln(E.ClassName, ': ', E.Message); 44 | end; 45 | end. 46 | -------------------------------------------------------------------------------- /Samples/Starter-DMVC/Starter.Sample.DMVC.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Samples/Starter-DMVC/Starter.Sample.DMVC.res -------------------------------------------------------------------------------- /Samples/Starter-DMVC/WebModules.App.dfm: -------------------------------------------------------------------------------- 1 | object AppWebModule: TAppWebModule 2 | OnCreate = WebModuleCreate 3 | OnDestroy = WebModuleDestroy 4 | Actions = < 5 | item 6 | Default = True 7 | Name = 'DefaultHandler' 8 | PathInfo = '/' 9 | end> 10 | Height = 288 11 | Width = 519 12 | PixelsPerInch = 120 13 | end 14 | -------------------------------------------------------------------------------- /Samples/Starter-DMVC/WebModules.App.pas: -------------------------------------------------------------------------------- 1 | unit WebModules.App; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | System.SysUtils, 8 | Web.HTTPApp, 9 | MVCFramework; 10 | 11 | type 12 | 13 | { TAppWebModule } 14 | 15 | TAppWebModule = class(TWebModule) 16 | procedure WebModuleCreate(Sender: TObject); 17 | procedure WebModuleDestroy(Sender: TObject); 18 | private 19 | FEngine: TMVCEngine; 20 | end; 21 | 22 | var 23 | WebModuleClass: TComponentClass = TAppWebModule; 24 | 25 | implementation 26 | 27 | {$R *.dfm} 28 | 29 | uses 30 | MVCFramework.Commons, 31 | Prometheus.Collectors.Counter, 32 | Prometheus.Collectors.Histogram, 33 | Prometheus.Registry, 34 | Controllers.Demo; 35 | 36 | { TAppWebModule } 37 | 38 | procedure TAppWebModule.WebModuleCreate(Sender: TObject); 39 | begin 40 | // Creates the Delphi MVC Framework server application engine. 41 | FEngine := TMVCEngine.Create(Self); 42 | 43 | // Add a sample controller. 44 | FEngine.AddController(TDemoController); 45 | 46 | // Configure some sample metrics... 47 | 48 | // ... a simple counter 49 | TCounter.Create('http_requests_count', 'Received HTTP request count').Register(); 50 | 51 | // ... A request time histogram with two labels for path and status 52 | THistogram.Create( 53 | 'request_duration_seconds', 'Time taken to process request- in seconds', 54 | [0.05, 0.1, 0.25, 0.5, 1, 2, 10], ['path', 'status']) 55 | .Register(); 56 | 57 | // .. A request time histogram with no labels and an increasing bucket sequence 58 | THistogram.Create('response_length', 'Number of bytes sent in response', 10, 3, 10, []).Register(); 59 | 60 | // .. A request time histogram with no labels and a custom linear increasing bucket sequence 61 | THistogram.Create('files_sent', 'Number of files sent in response', 62 | function : TBuckets 63 | var 64 | LNextValue: Double; 65 | const 66 | StartValue = 10; 67 | ValueCount = 5; 68 | StepValue = 5; 69 | begin 70 | SetLength(Result, ValueCount); 71 | LNextValue := StartValue; 72 | for var LIndex := 0 to ValueCount - 1 do 73 | begin 74 | Result[LIndex] := LNextValue; 75 | LNextValue := LNextValue + StepValue; 76 | end; 77 | end, 78 | []) 79 | .Register(); 80 | 81 | FEngine.SetExceptionHandler( 82 | procedure(E: Exception; SelectedController: TMVCController; 83 | WebContext: TWebContext; var ExceptionHandled: Boolean) 84 | const 85 | AssumedDuration = 0.05; // seconds 86 | begin 87 | // needs a duration, will hard code it 88 | TCollectorRegistry.DefaultRegistry 89 | .GetCollector('request_duration_seconds') 90 | .Labels([WebContext.Request.PathInfo, WebContext.Response.StatusCode.ToString]) 91 | .Observe(AssumedDuration); 92 | end); 93 | end; 94 | 95 | procedure TAppWebModule.WebModuleDestroy(Sender: TObject); 96 | begin 97 | FEngine.Free; 98 | end; 99 | 100 | end. 101 | -------------------------------------------------------------------------------- /Samples/Starter-Horse/Starter.Sample.Horse.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.Horse; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.Classes, 9 | System.SysUtils, 10 | Horse, 11 | Prometheus.Collectors.Counter, 12 | Prometheus.Exposers.Text, 13 | Prometheus.Registry; 14 | 15 | begin 16 | 17 | try 18 | 19 | (* 20 | PROMETHEUS SETUP 21 | *) 22 | 23 | // Creates a Prometheus "counter" metric to count HTTP handled requests 24 | // and registers it into the default collector registry for later access; 25 | // the counter will store different values varying by path and status code. 26 | TCounter 27 | .Create('http_requests_handled', 'Count all HTTP handled requests', ['path', 'status']) 28 | .Register(); 29 | 30 | // 31 | // NOTE!! If you don't want to implement the endpoint below for any of your 32 | // web project, consider downloading and installing this Horse middleware: 33 | // https://github.com/marcobreveglieri/horse-prometheus-metrics 34 | // 35 | 36 | // Creates and endpoint for Horse web framework to expose metric values. 37 | THorse.Get('/metrics', 38 | procedure(Req: THorseRequest; Res: THorseResponse) 39 | begin 40 | 41 | // We create a stream that will contain metric values exposed as text, 42 | // using the appropriate exposer from Prometheus Client to render it. 43 | var LStream := TMemoryStream.Create; 44 | try 45 | var LExposer := TTextExposer.Create; 46 | try 47 | LExposer.Render(LStream, TCollectorRegistry.DefaultRegistry.Collect()); 48 | finally 49 | LExposer.Free; 50 | end; 51 | except 52 | LStream.Free; 53 | raise; 54 | end; 55 | 56 | // Let's send all the text to the client. 57 | Res.RawWebResponse.ContentStream := LStream; 58 | Res.RawWebResponse.ContentType := Format('text/plain; charset=%s', ['utf-8']); 59 | Res.RawWebResponse.StatusCode := Integer(THTTPStatus.OK); 60 | Res.RawWebResponse.SendResponse; 61 | end); 62 | 63 | (* 64 | HORSE APPLICATION 65 | *) 66 | 67 | // Creates a test endpoint using Horse web framework. 68 | THorse.Get('/ping', 69 | procedure(Req: THorseRequest; Res: THorseResponse) 70 | begin 71 | // Increments the "counter" metric value specifying label values. 72 | TCollectorRegistry.DefaultRegistry 73 | .GetCollector('http_requests_handled') 74 | .Labels([Req.PathInfo, IntToStr(Res.Status)]) // ['path', 'status'] 75 | .Inc(); 76 | 77 | // Sends a sample response to the client. 78 | Res.Send('pong'); 79 | end); 80 | 81 | // Creates another test endpoint using Horse web framework. 82 | THorse.Get('/secret', 83 | procedure(Req: THorseRequest; Res: THorseResponse) 84 | begin 85 | // You are not authorized to see this! 86 | Res.Status(THTTPStatus.Unauthorized); 87 | 88 | // Increments the "counter" metric value specifying label values. 89 | TCollectorRegistry.DefaultRegistry 90 | .GetCollector('http_requests_handled') 91 | .Labels([Req.PathInfo, IntToStr(Res.Status)]) // ['path', 'status'] 92 | .Inc(); 93 | 94 | // Sends a sample response to the client. 95 | Res.Send('Access denied'); 96 | end); 97 | 98 | // Starts the Horse web server listening to port 9000. 99 | THorse.Listen(9000); 100 | 101 | except 102 | on E: Exception do 103 | Writeln(E.ClassName, ': ', E.Message); 104 | end; 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /Samples/Starter-Horse/Starter.Sample.Horse.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Samples/Starter-Horse/Starter.Sample.Horse.res -------------------------------------------------------------------------------- /Samples/Starter-Horse/Starter.Sample.HorseApp.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.HorseApp; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.Classes, 9 | System.SysUtils, 10 | Horse, 11 | Prometheus.Collectors.Counter, 12 | Prometheus.Exposers.Text, 13 | Prometheus.Registry; 14 | 15 | begin 16 | 17 | try 18 | 19 | (* 20 | PROMETHEUS SETUP 21 | *) 22 | 23 | // Creates a Prometheus "counter" metric to count HTTP handled requests 24 | // and registers it into the default collector registry for later access; 25 | // the counter will store different values varying by path and status code. 26 | TCounter 27 | .Create('http_requests_handled', 'Count all HTTP handled requests', ['path', 'status']) 28 | .Register(); 29 | 30 | // 31 | // NOTE!! If you don't want to implement the endpoint below for any of your 32 | // web project, consider downloading and installing this Horse middleware: 33 | // https://github.com/marcobreveglieri/horse-prometheus-metrics 34 | // 35 | 36 | // Creates and endpoint for Horse web framework to expose metric values. 37 | THorse.Get('/metrics', 38 | procedure(Req: THorseRequest; Res: THorseResponse) 39 | begin 40 | 41 | // We create a stream that will contain metric values exposed as text, 42 | // using the appropriate exposer from Prometheus Client to render it. 43 | var LStream := TMemoryStream.Create; 44 | try 45 | var LExposer := TTextExposer.Create; 46 | try 47 | LExposer.Render(LStream, TCollectorRegistry.DefaultRegistry.Collect()); 48 | finally 49 | LExposer.Free; 50 | end; 51 | except 52 | LStream.Free; 53 | raise; 54 | end; 55 | 56 | // Let's send all the text to the client. 57 | Res.RawWebResponse.ContentStream := LStream; 58 | Res.RawWebResponse.ContentType := Format('text/plain; charset=%s', ['utf-8']); 59 | Res.RawWebResponse.StatusCode := Integer(THTTPStatus.OK); 60 | Res.RawWebResponse.SendResponse; 61 | end); 62 | 63 | (* 64 | HORSE APPLICATION 65 | *) 66 | 67 | // Creates a test endpoint using Horse web framework. 68 | THorse.Get('/ping', 69 | procedure(Req: THorseRequest; Res: THorseResponse) 70 | begin 71 | // Increments the "counter" metric value specifying label values. 72 | TCollectorRegistry.DefaultRegistry 73 | .GetCollector('http_requests_handled') 74 | .Labels([Req.PathInfo, IntToStr(Res.Status)]) // ['path', 'status'] 75 | .Inc(); 76 | 77 | // Sends a sample response to the client. 78 | Res.Send('pong'); 79 | end); 80 | 81 | // Creates another test endpoint using Horse web framework. 82 | THorse.Get('/secret', 83 | procedure(Req: THorseRequest; Res: THorseResponse) 84 | begin 85 | // You are not authorized to see this! 86 | Res.Status(THTTPStatus.Unauthorized); 87 | 88 | // Increments the "counter" metric value specifying label values. 89 | TCollectorRegistry.DefaultRegistry 90 | .GetCollector('http_requests_handled') 91 | .Labels([Req.PathInfo, IntToStr(Res.Status)]) // ['path', 'status'] 92 | .Inc(); 93 | 94 | // Sends a sample response to the client. 95 | Res.Send('Access denied'); 96 | end); 97 | 98 | // Starts the Horse web server listening to port 9000. 99 | THorse.Listen(9000); 100 | 101 | except 102 | on E: Exception do 103 | Writeln(E.ClassName, ': ', E.Message); 104 | end; 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /Samples/Starter-Horse/Starter.Sample.HorseApp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Samples/Starter-Horse/Starter.Sample.HorseApp.res -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/Forms.Main.dfm: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 271 3 | Top = 114 4 | BorderIcons = [biSystemMenu, biMinimize] 5 | BorderStyle = bsSingle 6 | Caption = 'Prometheus WebBroker Demo' 7 | ClientHeight = 227 8 | ClientWidth = 333 9 | Color = clBtnFace 10 | Font.Charset = ANSI_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -13 13 | Font.Name = 'Segoe UI' 14 | Font.Style = [] 15 | ShowHint = True 16 | TextHeight = 17 17 | object PortLabel: TLabel 18 | Left = 192 19 | Top = 17 20 | Width = 24 21 | Height = 17 22 | Caption = 'Port' 23 | end 24 | object StartServerButton: TButton 25 | Left = 8 26 | Top = 16 27 | Width = 156 28 | Height = 49 29 | Action = StartServerAction 30 | Default = True 31 | TabOrder = 0 32 | end 33 | object StopServerButton: TButton 34 | Left = 8 35 | Top = 72 36 | Width = 156 37 | Height = 49 38 | Action = StopServerAction 39 | Cancel = True 40 | Default = True 41 | TabOrder = 1 42 | end 43 | object PortEdit: TEdit 44 | Left = 192 45 | Top = 40 46 | Width = 121 47 | Height = 25 48 | TabOrder = 2 49 | Text = '8081' 50 | end 51 | object OpenBrowserButton: TButton 52 | Left = 168 53 | Top = 168 54 | Width = 156 55 | Height = 49 56 | Action = OpenBrowserAction 57 | TabOrder = 3 58 | end 59 | object MainActionList: TActionList 60 | OnUpdate = MainActionListUpdate 61 | Left = 40 62 | Top = 168 63 | object StartServerAction: TAction 64 | Caption = '&Start Server' 65 | OnExecute = StartServerActionExecute 66 | end 67 | object StopServerAction: TAction 68 | Caption = 'Sto&p Server' 69 | OnExecute = StopServerActionExecute 70 | end 71 | object OpenBrowserAction: TAction 72 | Caption = '&Open Browser' 73 | OnExecute = OpenBrowserActionExecute 74 | end 75 | end 76 | end 77 | -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/Forms.Main.pas: -------------------------------------------------------------------------------- 1 | unit Forms.Main; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Messages, System.SysUtils, System.Variants, 7 | System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 8 | Vcl.AppEvnts, Vcl.StdCtrls, IdHTTPWebBrokerBridge, IdGlobal, Web.HTTPApp, 9 | System.Actions, Vcl.ActnList; 10 | 11 | type 12 | 13 | TMainForm = class(TForm) 14 | StartServerButton: TButton; 15 | StopServerButton: TButton; 16 | PortEdit: TEdit; 17 | PortLabel: TLabel; 18 | OpenBrowserButton: TButton; 19 | MainActionList: TActionList; 20 | StartServerAction: TAction; 21 | StopServerAction: TAction; 22 | OpenBrowserAction: TAction; 23 | procedure MainActionListUpdate(Action: TBasicAction; var Handled: Boolean); 24 | procedure StartServerActionExecute(Sender: TObject); 25 | procedure StopServerActionExecute(Sender: TObject); 26 | procedure OpenBrowserActionExecute(Sender: TObject); 27 | private 28 | FServer: TIdHTTPWebBrokerBridge; 29 | public 30 | constructor Create(AOwner: TComponent); override; 31 | destructor Destroy; override; 32 | end; 33 | 34 | var 35 | MainForm: TMainForm; 36 | 37 | implementation 38 | 39 | {$R *.dfm} 40 | 41 | uses 42 | Winapi.ShellApi, 43 | WinApi.Windows; 44 | 45 | constructor TMainForm.Create(AOwner: TComponent); 46 | begin 47 | inherited Create(AOwner); 48 | FServer := TIdHTTPWebBrokerBridge.Create(Self); 49 | end; 50 | 51 | destructor TMainForm.Destroy; 52 | begin 53 | if Assigned(FServer) then 54 | FreeAndNil(FServer); 55 | inherited Destroy; 56 | end; 57 | 58 | procedure TMainForm.MainActionListUpdate(Action: TBasicAction; var Handled: Boolean); 59 | var 60 | LServerRunning: Boolean; 61 | begin 62 | LServerRunning := FServer.Active; 63 | StartServerAction.Enabled := not LServerRunning; 64 | StopServerAction.Enabled := LServerRunning; 65 | OpenBrowserAction.Enabled := LServerRunning; 66 | PortEdit.Enabled := not LServerRunning; 67 | end; 68 | 69 | procedure TMainForm.OpenBrowserActionExecute(Sender: TObject); 70 | var 71 | LURL: string; 72 | begin 73 | if not FServer.Active then 74 | Exit; 75 | LURL := Format('http://localhost:%s', [PortEdit.Text]); 76 | ShellExecute(0, nil, PChar(LURL), nil, nil, SW_SHOWNOACTIVATE); 77 | end; 78 | 79 | procedure TMainForm.StartServerActionExecute(Sender: TObject); 80 | begin 81 | if FServer.Active then 82 | Exit; 83 | FServer.Bindings.Clear; 84 | FServer.DefaultPort := StrToInt(PortEdit.Text); 85 | FServer.Active := True; 86 | end; 87 | 88 | procedure TMainForm.StopServerActionExecute(Sender: TObject); 89 | begin 90 | if not FServer.Active then 91 | Exit; 92 | FServer.Active := False; 93 | FServer.Bindings.Clear; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/Services.Memory.pas: -------------------------------------------------------------------------------- 1 | unit Services.Memory; 2 | 3 | interface 4 | 5 | type 6 | 7 | { TMemoryServices } 8 | 9 | TMemoryServices = class 10 | public 11 | class function GetTotalAllocatedMemory: NativeUInt; 12 | end; 13 | 14 | implementation 15 | 16 | { TMemoryServices } 17 | 18 | class function TMemoryServices.GetTotalAllocatedMemory: NativeUInt; 19 | var 20 | LMMS: TMemoryManagerState; 21 | LSBTS: TSmallBlockTypeState; 22 | begin 23 | Result := 0; 24 | {$WARN SYMBOL_PLATFORM OFF} 25 | GetMemoryManagerState(LMMS); 26 | {$WARN SYMBOL_PLATFORM ON} 27 | for LSBTS in LMMS.SmallBlockTypeStates do 28 | Inc(Result, LSBTS.InternalBlockSize * LSBTS.AllocatedBlockCount); 29 | Inc(Result, LMMS.TotalAllocatedMediumBlockSize); 30 | Inc(Result, LMMS.TotalAllocatedLargeBlockSize); 31 | end; 32 | 33 | end. 34 | -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/Starter.Sample.WebBroker.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.WebBroker; 2 | {$APPTYPE GUI} 3 | 4 | uses 5 | Vcl.Forms, 6 | Web.WebReq, 7 | IdHTTPWebBrokerBridge, 8 | Forms.Main in 'Forms.Main.pas' {MainForm}, 9 | WebModules.Prom in 'WebModules.Prom.pas' {PromWebModule: TWebModule}, 10 | Services.Memory in 'Services.Memory.pas'; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | ReportMemoryLeaksOnShutdown := True; 16 | if WebRequestHandler <> nil then 17 | WebRequestHandler.WebModuleClass := WebModuleClass; 18 | Application.Initialize; 19 | Application.CreateForm(TMainForm, MainForm); 20 | Application.Run; 21 | end. 22 | -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/Starter.Sample.WebBroker.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Samples/Starter-WebBroker/Starter.Sample.WebBroker.res -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/Starter.Sample.WebBrokerApp.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.WebBrokerApp; 2 | {$APPTYPE GUI} 3 | 4 | uses 5 | Vcl.Forms, 6 | Web.WebReq, 7 | IdHTTPWebBrokerBridge, 8 | Forms.Main in 'Forms.Main.pas' {MainForm}, 9 | WebModules.Prom in 'WebModules.Prom.pas' {PromWebModule: TWebModule}, 10 | Services.Memory in 'Services.Memory.pas'; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | ReportMemoryLeaksOnShutdown := True; 16 | if WebRequestHandler <> nil then 17 | WebRequestHandler.WebModuleClass := WebModuleClass; 18 | Application.Initialize; 19 | Application.CreateForm(TMainForm, MainForm); 20 | Application.Run; 21 | end. 22 | -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/WebModules.Prom.dfm: -------------------------------------------------------------------------------- 1 | object PromWebModule: TPromWebModule 2 | Actions = < 3 | item 4 | Default = True 5 | Enabled = False 6 | Name = 'DefaultHandler' 7 | PathInfo = '/' 8 | OnAction = PromWebModuleDefaultHandlerAction 9 | end 10 | item 11 | MethodType = mtGet 12 | Name = 'MetricAction' 13 | PathInfo = '/metrics' 14 | OnAction = PromWebModuleMetricActionAction 15 | end 16 | item 17 | MethodType = mtGet 18 | Name = 'Leak' 19 | PathInfo = '/leak' 20 | OnAction = PromWebModuleLeakAction 21 | end> 22 | BeforeDispatch = WebModuleBeforeDispatch 23 | AfterDispatch = WebModuleAfterDispatch 24 | Height = 312 25 | Width = 401 26 | end 27 | -------------------------------------------------------------------------------- /Samples/Starter-WebBroker/WebModules.Prom.pas: -------------------------------------------------------------------------------- 1 | unit WebModules.Prom; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | System.SysUtils, 8 | Web.HTTPApp; 9 | 10 | type 11 | TPromWebModule = class(TWebModule) 12 | procedure PromWebModuleDefaultHandlerAction(Sender: TObject; 13 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 14 | procedure PromWebModuleMetricActionAction(Sender: TObject; 15 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 16 | procedure PromWebModuleLeakAction(Sender: TObject; Request: TWebRequest; 17 | Response: TWebResponse; var Handled: Boolean); 18 | procedure WebModuleAfterDispatch(Sender: TObject; Request: TWebRequest; 19 | Response: TWebResponse; var Handled: Boolean); 20 | procedure WebModuleBeforeDispatch(Sender: TObject; Request: TWebRequest; 21 | Response: TWebResponse; var Handled: Boolean); 22 | private 23 | procedure InitializeMetrics; 24 | procedure UpdateLastMinuteMetrics; 25 | public 26 | constructor Create(AOwner: TComponent); override; 27 | end; 28 | 29 | var 30 | WebModuleClass: TComponentClass = TPromWebModule; 31 | 32 | implementation 33 | 34 | {%CLASSGROUP 'Vcl.Controls.TControl'} 35 | 36 | {$R *.dfm} 37 | 38 | uses 39 | Prometheus.Collectors.Counter, 40 | Prometheus.Collectors.Gauge, 41 | Prometheus.Registry, 42 | Prometheus.Exposers.Text, 43 | Services.Memory; 44 | 45 | constructor TPromWebModule.Create(AOwner: TComponent); 46 | begin 47 | inherited Create(AOwner); 48 | InitializeMetrics; 49 | end; 50 | 51 | procedure TPromWebModule.InitializeMetrics; 52 | begin 53 | var LRegistry := TCollectorRegistry.DefaultRegistry; 54 | // Counter: http_requests_count 55 | if not LRegistry.HasCollector('http_requests_count') then 56 | begin 57 | TCounter 58 | .Create('http_requests_count', 'HTTP received request count') 59 | .Register(); 60 | end; 61 | // Counter: http_requests_handled 62 | if not LRegistry.HasCollector('http_requests_handled') then 63 | begin 64 | TCounter 65 | .Create('http_requests_handled', 'HTTP handled request count', 66 | ['path', 'status']) 67 | .Register(); 68 | end; 69 | // Gauge: memory_allocated_total 70 | if not LRegistry.HasCollector('memory_allocated_total') then 71 | begin 72 | var LGauge := TGauge 73 | .Create('memory_allocated_total', 'Total memory allocated by the process'); 74 | LGauge.SetTo(TMemoryServices.GetTotalAllocatedMemory); 75 | LGauge.Register(); 76 | end; 77 | end; 78 | 79 | procedure TPromWebModule.PromWebModuleDefaultHandlerAction(Sender: TObject; 80 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 81 | begin 82 | if Request.PathInfo <> '/' then 83 | begin 84 | Response.StatusCode := 404; 85 | Response.Content := 'Not found!'; 86 | Exit; 87 | end; 88 | Response.Content := 89 | '' + 90 | 'Web Server Application' + 91 | '' + 92 | '

Web Server Application

' + 93 | '

Prometheus Delphi Client powered!

' + 94 | '

View exposed Metrics

' + 95 | '' + 96 | ''; 97 | end; 98 | 99 | procedure TPromWebModule.PromWebModuleMetricActionAction(Sender: TObject; 100 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 101 | begin 102 | UpdateLastMinuteMetrics; 103 | Response.ContentType := 'text/plain'; 104 | Response.ContentStream := TMemoryStream.Create; 105 | var LWriter := TTextExposer.Create; 106 | try 107 | LWriter.Render(Response.ContentStream, 108 | TCollectorRegistry.DefaultRegistry.Collect); 109 | finally 110 | LWriter.Free; 111 | end; 112 | end; 113 | 114 | procedure TPromWebModule.PromWebModuleLeakAction(Sender: TObject; 115 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 116 | begin 117 | GetMemory(4096 * 10); // Intentional memory leak! 118 | Response.ContentType := 'text/plain'; 119 | Response.Content := 'Done.'; 120 | end; 121 | 122 | procedure TPromWebModule.UpdateLastMinuteMetrics; 123 | begin 124 | TCollectorRegistry.DefaultRegistry 125 | .GetCollector('memory_allocated_total') 126 | .SetTo(TMemoryServices.GetTotalAllocatedMemory); 127 | end; 128 | 129 | procedure TPromWebModule.WebModuleAfterDispatch(Sender: TObject; 130 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 131 | begin 132 | var LPath := Request.PathInfo; 133 | var LStatus := IntToStr(Response.StatusCode); 134 | TCollectorRegistry.DefaultRegistry 135 | .GetCollector('http_requests_handled') 136 | .Labels([LPath, LStatus]) // ['path', 'status'] 137 | .Inc(); 138 | end; 139 | 140 | procedure TPromWebModule.WebModuleBeforeDispatch(Sender: TObject; 141 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); 142 | begin 143 | TCollectorRegistry.DefaultRegistry 144 | .GetCollector('http_requests_count') 145 | .Inc(); 146 | end; 147 | 148 | end. 149 | -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Server.Forms.Main.pas: -------------------------------------------------------------------------------- 1 | unit Server.Forms.Main; 2 | 3 | interface 4 | 5 | uses 6 | System.Actions, 7 | System.Classes, 8 | System.SysUtils, 9 | Vcl.Forms, 10 | Vcl.ActnList, 11 | Vcl.ComCtrls, 12 | Vcl.StdCtrls, 13 | Vcl.Controls, 14 | Vcl.ExtCtrls, 15 | Vcl.Imaging.pngimage, 16 | WiRL.http.Server; 17 | 18 | type 19 | 20 | { TMainForm } 21 | 22 | TMainForm = class(TForm) 23 | TopPanel: TPanel; 24 | StartServerButton: TButton; 25 | StopServerButton: TButton; 26 | MainActionList: TActionList; 27 | StartServerAction: TAction; 28 | StopServerAction: TAction; 29 | PortNumberEdit: TEdit; 30 | PortNumberLabel: TLabel; 31 | WiRLImage: TImage; 32 | PromImage: TImage; 33 | procedure StartServerActionExecute(Sender: TObject); 34 | procedure StopServerActionExecute(Sender: TObject); 35 | procedure FormCreate(Sender: TObject); 36 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 37 | procedure MainActionListUpdate(Action: TBasicAction; var Handled: Boolean); 38 | private 39 | FServer: TWiRLServer; 40 | end; 41 | 42 | var 43 | MainForm: TMainForm; 44 | 45 | implementation 46 | 47 | {$R *.dfm} 48 | 49 | uses 50 | WiRL.Core.Engine, 51 | WiRL.Core.Application, 52 | WiRL.http.Server.Indy, 53 | Prometheus.Registry, 54 | Prometheus.Collectors.Counter; 55 | 56 | { TMainForm } 57 | 58 | procedure TMainForm.FormCreate(Sender: TObject); 59 | begin 60 | StartServerAction.Execute; 61 | end; 62 | 63 | procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); 64 | begin 65 | StopServerAction.Execute; 66 | end; 67 | 68 | procedure TMainForm.MainActionListUpdate(Action: TBasicAction; 69 | var Handled: Boolean); 70 | begin 71 | StartServerAction.Enabled := (FServer = nil) or (FServer.Active = False); 72 | StopServerAction.Enabled := not StartServerAction.Enabled; 73 | end; 74 | 75 | procedure TMainForm.StartServerActionExecute(Sender: TObject); 76 | begin 77 | // Create the WiRL HTTP Web Server. 78 | FServer := TWiRLServer.Create(nil); 79 | 80 | // Set up the server configuration. 81 | FServer 82 | .SetPort(StrToIntDef(PortNumberEdit.Text, 8080)) 83 | .AddEngine('/rest') 84 | .SetEngineName('WiRL ContentType Demo') 85 | .AddApplication('/app') 86 | .SetAppName('Content App') 87 | .SetWriters('*') 88 | .SetReaders('*') 89 | .SetResources('Server.Resources.*'); 90 | 91 | // Create a sample counter metric and register it into the default registry. 92 | TCounter 93 | .Create('http_requests_count', 'Received HTTP request count', ['path', 'status']) 94 | .Register(); 95 | 96 | // Start the Web server. 97 | if not FServer.Active then 98 | FServer.Active := True; 99 | end; 100 | 101 | procedure TMainForm.StopServerActionExecute(Sender: TObject); 102 | begin 103 | // Turn off the server. 104 | FServer.Active := False; 105 | FServer.Free; 106 | 107 | // Clear all the previously registered metrics to restart from scratch. 108 | TCollectorRegistry.DefaultRegistry.Clear; 109 | end; 110 | 111 | end. 112 | -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Server.Resources.Metrics.pas: -------------------------------------------------------------------------------- 1 | unit Server.Resources.Metrics; 2 | 3 | interface 4 | 5 | uses 6 | WiRL.Core.Attributes, 7 | WiRL.Core.MessageBody.Default, 8 | WiRL.http.Accept.MediaType; 9 | 10 | type 11 | 12 | { TMetricsResource } 13 | 14 | [Path('/metrics')] 15 | TMetricsResource = class 16 | public 17 | [GET, Produces(TMediaType.TEXT_PLAIN)] 18 | function GetMetrics: string; 19 | end; 20 | 21 | implementation 22 | 23 | uses 24 | Prometheus.Exposers.Text, 25 | Prometheus.Registry, 26 | WiRL.Core.Registry; 27 | 28 | { TMetricsResource } 29 | 30 | function TMetricsResource.GetMetrics: string; 31 | begin 32 | // Export the metrics using Prometheus text format. 33 | var LExposer := TTextExposer.Create; 34 | try 35 | Result := LExposer.Render(TCollectorRegistry.DefaultRegistry.Collect); 36 | finally 37 | LExposer.Free; 38 | end; 39 | end; 40 | 41 | initialization 42 | TWiRLResourceRegistry.Instance.RegisterResource; 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Server.Resources.Samples.pas: -------------------------------------------------------------------------------- 1 | unit Server.Resources.Samples; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | WiRL.Core.Attributes, 8 | WiRL.Core.MessageBody.Default, 9 | WiRL.http.Core, 10 | WiRL.http.Accept.MediaType; 11 | 12 | type 13 | 14 | { TSampleResource } 15 | 16 | [Path('/samples')] 17 | TSampleResource = class 18 | public 19 | [GET] 20 | [Produces(TMediaType.TEXT_PLAIN)] 21 | function Ping(): string; 22 | end; 23 | 24 | implementation 25 | 26 | uses 27 | WiRL.Core.Registry, 28 | Prometheus.Collectors.Counter, 29 | Prometheus.Registry; 30 | 31 | { TSampleResource } 32 | 33 | function TSampleResource.Ping: string; 34 | begin 35 | // Increments the "counter" metric value with label values. 36 | TCollectorRegistry.DefaultRegistry 37 | .GetCollector('http_requests_count') 38 | .Labels(['/ping', IntToStr(TWiRLHttpStatus.OK)]) // ['path', 'status'] 39 | .Inc(); 40 | 41 | // Sends a sample response to the client. 42 | Result := 'pong'; 43 | end; 44 | 45 | initialization 46 | TWiRLResourceRegistry.Instance.RegisterResource; 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Starter.Sample.WiRL.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.WiRL; 2 | 3 | uses 4 | Forms, 5 | Server.Forms.Main in 'Server.Forms.Main.pas' {MainForm}, 6 | Server.Resources.Samples in 'Server.Resources.Samples.pas', 7 | Server.Resources.Metrics in 'Server.Resources.Metrics.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | ReportMemoryLeaksOnShutdown := True; 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TMainForm, MainForm); 16 | Application.Run; 17 | end. -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Starter.Sample.WiRL.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {F9FFFB8A-8DD0-4212-BDA6-3D93DA044B95} 4 | Starter.Sample.WiRL.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 19.5 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | ./$(Platform)/$(Config) 56 | ./$(Platform)/$(Config) 57 | ..\Prometheus.Client;$(DCC_UnitSearchPath) 58 | 00400000 59 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 60 | 1040 61 | false 62 | Starter_Sample_WiRL 63 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 64 | false 65 | false 66 | false 67 | false 68 | $(BDS)\bin\delphi_PROJECTICON.ico 69 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 70 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 71 | 72 | 73 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 74 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 75 | true 76 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 77 | 1033 78 | $(BDS)\bin\default_app.manifest 79 | true 80 | CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(ModuleName);FileDescription=$(ModuleName);ProductName=$(ModuleName) 81 | 82 | 83 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 84 | Debug 85 | true 86 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 87 | 1033 88 | $(BDS)\bin\default_app.manifest 89 | true 90 | 91 | 92 | RELEASE;$(DCC_Define) 93 | 0 94 | 0 95 | false 96 | 97 | 98 | true 99 | PerMonitorV2 100 | 101 | 102 | true 103 | DEBUG;$(DCC_Define) 104 | false 105 | 106 | 107 | Debug 108 | true 109 | true 110 | 1033 111 | CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) 112 | none 113 | 114 | 115 | true 116 | PerMonitorV2 117 | 118 | 119 | 120 | MainSource 121 | 122 | 123 |
MainForm
124 | 125 | 126 | 127 | 128 | Base 129 | 130 | 131 | Cfg_1 132 | Base 133 | 134 | 135 | Cfg_2 136 | Base 137 | 138 | 139 | 140 | Delphi.Personality.12 141 | 142 | 143 | 144 | 145 | Starter.Sample.WiRL.dpr 146 | 147 | 148 | Microsoft Office 2000 Sample Automation Server Wrapper Components 149 | Microsoft Office XP Sample Automation Server Wrapper Components 150 | 151 | 152 | 153 | True 154 | False 155 | 156 | 157 | 158 | 159 | 160 | Starter_Sample_WiRL.exe 161 | true 162 | 163 | 164 | 165 | 166 | 1 167 | 168 | 169 | Contents\MacOS 170 | 1 171 | 172 | 173 | 0 174 | 175 | 176 | 177 | 178 | classes 179 | 64 180 | 181 | 182 | classes 183 | 64 184 | 185 | 186 | 187 | 188 | res\xml 189 | 1 190 | 191 | 192 | res\xml 193 | 1 194 | 195 | 196 | 197 | 198 | library\lib\armeabi-v7a 199 | 1 200 | 201 | 202 | 203 | 204 | library\lib\armeabi 205 | 1 206 | 207 | 208 | library\lib\armeabi 209 | 1 210 | 211 | 212 | 213 | 214 | library\lib\armeabi-v7a 215 | 1 216 | 217 | 218 | 219 | 220 | library\lib\mips 221 | 1 222 | 223 | 224 | library\lib\mips 225 | 1 226 | 227 | 228 | 229 | 230 | library\lib\armeabi-v7a 231 | 1 232 | 233 | 234 | library\lib\arm64-v8a 235 | 1 236 | 237 | 238 | 239 | 240 | library\lib\armeabi-v7a 241 | 1 242 | 243 | 244 | 245 | 246 | res\drawable 247 | 1 248 | 249 | 250 | res\drawable 251 | 1 252 | 253 | 254 | 255 | 256 | res\values 257 | 1 258 | 259 | 260 | res\values 261 | 1 262 | 263 | 264 | 265 | 266 | res\values-v21 267 | 1 268 | 269 | 270 | res\values-v21 271 | 1 272 | 273 | 274 | 275 | 276 | res\values 277 | 1 278 | 279 | 280 | res\values 281 | 1 282 | 283 | 284 | 285 | 286 | res\drawable 287 | 1 288 | 289 | 290 | res\drawable 291 | 1 292 | 293 | 294 | 295 | 296 | res\drawable-xxhdpi 297 | 1 298 | 299 | 300 | res\drawable-xxhdpi 301 | 1 302 | 303 | 304 | 305 | 306 | res\drawable-xxxhdpi 307 | 1 308 | 309 | 310 | res\drawable-xxxhdpi 311 | 1 312 | 313 | 314 | 315 | 316 | res\drawable-ldpi 317 | 1 318 | 319 | 320 | res\drawable-ldpi 321 | 1 322 | 323 | 324 | 325 | 326 | res\drawable-mdpi 327 | 1 328 | 329 | 330 | res\drawable-mdpi 331 | 1 332 | 333 | 334 | 335 | 336 | res\drawable-hdpi 337 | 1 338 | 339 | 340 | res\drawable-hdpi 341 | 1 342 | 343 | 344 | 345 | 346 | res\drawable-xhdpi 347 | 1 348 | 349 | 350 | res\drawable-xhdpi 351 | 1 352 | 353 | 354 | 355 | 356 | res\drawable-mdpi 357 | 1 358 | 359 | 360 | res\drawable-mdpi 361 | 1 362 | 363 | 364 | 365 | 366 | res\drawable-hdpi 367 | 1 368 | 369 | 370 | res\drawable-hdpi 371 | 1 372 | 373 | 374 | 375 | 376 | res\drawable-xhdpi 377 | 1 378 | 379 | 380 | res\drawable-xhdpi 381 | 1 382 | 383 | 384 | 385 | 386 | res\drawable-xxhdpi 387 | 1 388 | 389 | 390 | res\drawable-xxhdpi 391 | 1 392 | 393 | 394 | 395 | 396 | res\drawable-xxxhdpi 397 | 1 398 | 399 | 400 | res\drawable-xxxhdpi 401 | 1 402 | 403 | 404 | 405 | 406 | res\drawable-small 407 | 1 408 | 409 | 410 | res\drawable-small 411 | 1 412 | 413 | 414 | 415 | 416 | res\drawable-normal 417 | 1 418 | 419 | 420 | res\drawable-normal 421 | 1 422 | 423 | 424 | 425 | 426 | res\drawable-large 427 | 1 428 | 429 | 430 | res\drawable-large 431 | 1 432 | 433 | 434 | 435 | 436 | res\drawable-xlarge 437 | 1 438 | 439 | 440 | res\drawable-xlarge 441 | 1 442 | 443 | 444 | 445 | 446 | res\values 447 | 1 448 | 449 | 450 | res\values 451 | 1 452 | 453 | 454 | 455 | 456 | 1 457 | 458 | 459 | Contents\MacOS 460 | 1 461 | 462 | 463 | 0 464 | 465 | 466 | 467 | 468 | Contents\MacOS 469 | 1 470 | .framework 471 | 472 | 473 | Contents\MacOS 474 | 1 475 | .framework 476 | 477 | 478 | Contents\MacOS 479 | 1 480 | .framework 481 | 482 | 483 | 0 484 | 485 | 486 | 487 | 488 | 1 489 | .dylib 490 | 491 | 492 | 1 493 | .dylib 494 | 495 | 496 | 1 497 | .dylib 498 | 499 | 500 | Contents\MacOS 501 | 1 502 | .dylib 503 | 504 | 505 | Contents\MacOS 506 | 1 507 | .dylib 508 | 509 | 510 | Contents\MacOS 511 | 1 512 | .dylib 513 | 514 | 515 | 0 516 | .dll;.bpl 517 | 518 | 519 | 520 | 521 | 1 522 | .dylib 523 | 524 | 525 | 1 526 | .dylib 527 | 528 | 529 | 1 530 | .dylib 531 | 532 | 533 | Contents\MacOS 534 | 1 535 | .dylib 536 | 537 | 538 | Contents\MacOS 539 | 1 540 | .dylib 541 | 542 | 543 | Contents\MacOS 544 | 1 545 | .dylib 546 | 547 | 548 | 0 549 | .bpl 550 | 551 | 552 | 553 | 554 | 0 555 | 556 | 557 | 0 558 | 559 | 560 | 0 561 | 562 | 563 | 0 564 | 565 | 566 | 0 567 | 568 | 569 | Contents\Resources\StartUp\ 570 | 0 571 | 572 | 573 | Contents\Resources\StartUp\ 574 | 0 575 | 576 | 577 | Contents\Resources\StartUp\ 578 | 0 579 | 580 | 581 | 0 582 | 583 | 584 | 585 | 586 | 1 587 | 588 | 589 | 1 590 | 591 | 592 | 593 | 594 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 595 | 1 596 | 597 | 598 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 599 | 1 600 | 601 | 602 | 603 | 604 | ..\ 605 | 1 606 | 607 | 608 | ..\ 609 | 1 610 | 611 | 612 | ..\ 613 | 1 614 | 615 | 616 | 617 | 618 | Contents 619 | 1 620 | 621 | 622 | Contents 623 | 1 624 | 625 | 626 | Contents 627 | 1 628 | 629 | 630 | 631 | 632 | Contents\Resources 633 | 1 634 | 635 | 636 | Contents\Resources 637 | 1 638 | 639 | 640 | Contents\Resources 641 | 1 642 | 643 | 644 | 645 | 646 | library\lib\armeabi-v7a 647 | 1 648 | 649 | 650 | library\lib\arm64-v8a 651 | 1 652 | 653 | 654 | 1 655 | 656 | 657 | 1 658 | 659 | 660 | 1 661 | 662 | 663 | 1 664 | 665 | 666 | Contents\MacOS 667 | 1 668 | 669 | 670 | Contents\MacOS 671 | 1 672 | 673 | 674 | Contents\MacOS 675 | 1 676 | 677 | 678 | 0 679 | 680 | 681 | 682 | 683 | library\lib\armeabi-v7a 684 | 1 685 | 686 | 687 | 688 | 689 | 1 690 | 691 | 692 | 1 693 | 694 | 695 | 696 | 697 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 698 | 1 699 | 700 | 701 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 702 | 1 703 | 704 | 705 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 706 | 1 707 | 708 | 709 | 710 | 711 | ..\ 712 | 1 713 | 714 | 715 | ..\ 716 | 1 717 | 718 | 719 | ..\ 720 | 1 721 | 722 | 723 | 724 | 725 | 1 726 | 727 | 728 | 1 729 | 730 | 731 | 1 732 | 733 | 734 | 735 | 736 | ..\$(PROJECTNAME).launchscreen 737 | 64 738 | 739 | 740 | ..\$(PROJECTNAME).launchscreen 741 | 64 742 | 743 | 744 | 745 | 746 | 1 747 | 748 | 749 | 1 750 | 751 | 752 | 1 753 | 754 | 755 | 756 | 757 | Assets 758 | 1 759 | 760 | 761 | Assets 762 | 1 763 | 764 | 765 | 766 | 767 | Assets 768 | 1 769 | 770 | 771 | Assets 772 | 1 773 | 774 | 775 | 776 | 777 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 778 | 1 779 | 780 | 781 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 782 | 1 783 | 784 | 785 | 786 | 787 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 788 | 1 789 | 790 | 791 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 792 | 1 793 | 794 | 795 | 796 | 797 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 798 | 1 799 | 800 | 801 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 802 | 1 803 | 804 | 805 | 806 | 807 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 808 | 1 809 | 810 | 811 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 812 | 1 813 | 814 | 815 | 816 | 817 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 818 | 1 819 | 820 | 821 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 822 | 1 823 | 824 | 825 | 826 | 827 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 828 | 1 829 | 830 | 831 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 832 | 1 833 | 834 | 835 | 836 | 837 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 838 | 1 839 | 840 | 841 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 842 | 1 843 | 844 | 845 | 846 | 847 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 848 | 1 849 | 850 | 851 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 852 | 1 853 | 854 | 855 | 856 | 857 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 858 | 1 859 | 860 | 861 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 862 | 1 863 | 864 | 865 | 866 | 867 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 868 | 1 869 | 870 | 871 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 872 | 1 873 | 874 | 875 | 876 | 877 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 878 | 1 879 | 880 | 881 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 882 | 1 883 | 884 | 885 | 886 | 887 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 888 | 1 889 | 890 | 891 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 892 | 1 893 | 894 | 895 | 896 | 897 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 898 | 1 899 | 900 | 901 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 902 | 1 903 | 904 | 905 | 906 | 907 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 908 | 1 909 | 910 | 911 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 912 | 1 913 | 914 | 915 | 916 | 917 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 918 | 1 919 | 920 | 921 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 922 | 1 923 | 924 | 925 | 926 | 927 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 928 | 1 929 | 930 | 931 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 932 | 1 933 | 934 | 935 | 936 | 937 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 938 | 1 939 | 940 | 941 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 942 | 1 943 | 944 | 945 | 946 | 947 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 948 | 1 949 | 950 | 951 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 952 | 1 953 | 954 | 955 | 956 | 957 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 958 | 1 959 | 960 | 961 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 962 | 1 963 | 964 | 965 | 966 | 967 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 968 | 1 969 | 970 | 971 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 972 | 1 973 | 974 | 975 | 976 | 977 | 978 | 979 | 980 | 981 | 982 | 983 | 984 | 985 | 986 | 987 | 988 | 989 | 12 990 | 991 | 992 | 993 | 994 | 995 | -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Starter.Sample.WiRL.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Samples/Starter-WiRL/Starter.Sample.WiRL.res -------------------------------------------------------------------------------- /Samples/Starter-WiRL/Starter.Sample.WiRLApp.dpr: -------------------------------------------------------------------------------- 1 | program Starter.Sample.WiRLApp; 2 | 3 | uses 4 | Forms, 5 | Server.Forms.Main in 'Server.Forms.Main.pas' {MainForm}, 6 | Server.Resources.Samples in 'Server.Resources.Samples.pas', 7 | Server.Resources.Metrics in 'Server.Resources.Metrics.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | ReportMemoryLeaksOnShutdown := True; 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TMainForm, MainForm); 16 | Application.Run; 17 | end. -------------------------------------------------------------------------------- /Source/Prometheus.Client.Core.dpk: -------------------------------------------------------------------------------- 1 | package Prometheus.Client.Core; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl; 32 | 33 | contains 34 | Prometheus.Collector in 'Prometheus.Collector.pas', 35 | Prometheus.Collectors.Counter in 'Prometheus.Collectors.Counter.pas', 36 | Prometheus.Collectors.Gauge in 'Prometheus.Collectors.Gauge.pas', 37 | Prometheus.Labels in 'Prometheus.Labels.pas', 38 | Prometheus.Metrics in 'Prometheus.Metrics.pas', 39 | Prometheus.Registry in 'Prometheus.Registry.pas', 40 | Prometheus.Exposers.Text in 'Prometheus.Exposers.Text.pas', 41 | Prometheus.Resources in 'Prometheus.Resources.pas', 42 | Prometheus.Samples in 'Prometheus.Samples.pas', 43 | Prometheus.SimpleCollector in 'Prometheus.SimpleCollector.pas', 44 | Prometheus.Collectors.Histogram in 'Prometheus.Collectors.Histogram.pas'; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Source/Prometheus.Client.Core.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Source/Prometheus.Client.Core.res -------------------------------------------------------------------------------- /Source/Prometheus.Collector.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Collector; 2 | 3 | interface 4 | 5 | uses 6 | Prometheus.Samples; 7 | 8 | type 9 | 10 | { TCollector } 11 | 12 | /// 13 | /// This is the base class for all the collector types. 14 | /// Each collector is scraped for metrics and can be registered at one 15 | /// ore more registries. 16 | /// 17 | TCollector = class abstract 18 | public 19 | /// 20 | /// Collects all the metrics and the samples from this collector. 21 | /// 22 | function Collect: TArray; virtual; abstract; 23 | /// 24 | /// Gets all the metric names that are part of this collector. 25 | /// 26 | function GetNames: TArray; virtual; abstract; 27 | end; 28 | 29 | implementation 30 | 31 | end. 32 | -------------------------------------------------------------------------------- /Source/Prometheus.Collectors.Counter.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Collectors.Counter; 2 | 3 | interface 4 | 5 | uses 6 | Prometheus.Labels, 7 | Prometheus.Samples, 8 | Prometheus.SimpleCollector; 9 | 10 | type 11 | 12 | { TCounterChild } 13 | 14 | /// 15 | /// Represents a child of a counter assigned to specific label values. 16 | /// 17 | TCounterChild = class 18 | strict private 19 | FLock: TObject; 20 | FValue: Double; 21 | public 22 | /// 23 | /// Creates a new instance of this counter collector child. 24 | /// 25 | constructor Create; 26 | /// 27 | /// Performs object cleanup releasing all the owned instances. 28 | /// 29 | destructor Destroy; override; 30 | /// 31 | /// Increases this counter child by the amount provided. 32 | /// 33 | procedure Inc(const AAmount: Double = 1); 34 | /// 35 | /// Returns the current value of this counter child. 36 | /// 37 | property Value: Double read FValue; 38 | end; 39 | 40 | { TCounter } 41 | 42 | /// 43 | /// A counter is a metric that represents a single monotonically increasing 44 | /// counter whose value can only increase or be reset to zero on restart. 45 | /// 46 | /// 47 | /// You can tipically use a counter to represent the number of requests 48 | /// served, tasks completed, or errors. Do not use a counter to expose a 49 | /// value that can decrease. For example, do not use a counter for the number 50 | /// of currently running processes; use a gauge instead. 51 | /// 52 | TCounter = class (TSimpleCollector) 53 | strict private 54 | function GetValue: Double; 55 | strict protected 56 | function CreateChild: TCounterChild; override; 57 | public 58 | /// 59 | /// Collects all the metrics and the samples from this collector. 60 | /// 61 | function Collect: TArray; override; 62 | /// 63 | /// Increases the default (unlabelled) counter by the amount provided. 64 | /// 65 | procedure Inc(const AAmount: Double = 1); 66 | /// 67 | /// Gets all the metric names that are part of this collector. 68 | /// 69 | function GetNames: TArray; override; 70 | /// 71 | /// Returns the current value of the default (unlabelled) counter. 72 | /// 73 | property Value: Double read GetValue; 74 | end; 75 | 76 | implementation 77 | 78 | uses 79 | System.SysUtils, 80 | Prometheus.Resources; 81 | 82 | { TCounterChild } 83 | 84 | constructor TCounterChild.Create; 85 | begin 86 | inherited Create; 87 | FLock := TObject.Create; 88 | end; 89 | 90 | destructor TCounterChild.Destroy; 91 | begin 92 | if Assigned(FLock) then 93 | FreeAndNil(FLock); 94 | inherited Destroy; 95 | end; 96 | 97 | procedure TCounterChild.Inc(const AAmount: Double); 98 | begin 99 | TMonitor.Enter(FLock); 100 | try 101 | if AAmount <= 0 then 102 | raise EArgumentOutOfRangeException.Create(StrErrAmountLessThanZero); 103 | FValue := FValue + AAmount; 104 | finally 105 | TMonitor.Exit(FLock); 106 | end; 107 | end; 108 | 109 | { TCounter } 110 | 111 | function TCounter.Collect: TArray; 112 | begin 113 | TMonitor.Enter(Lock); 114 | try 115 | SetLength(Result, 1); 116 | var LMetric := PMetricSamples(@Result[0]); 117 | LMetric^.MetricName := Self.Name; 118 | LMetric^.MetricHelp := Self.Help; 119 | LMetric^.MetricType := TMetricType.mtCounter; 120 | SetLength(LMetric^.Samples, ChildrenCount); 121 | var LIndex := 0; 122 | EnumChildren( 123 | procedure (const ALabelValues: TLabelValues; const AChild: TCounterChild) 124 | begin 125 | var LSample := PSample(@LMetric^.Samples[LIndex]); 126 | LSample^.MetricName := Self.Name; 127 | LSample^.LabelNames := Self.LabelNames; 128 | LSample^.LabelValues := ALabelValues; 129 | LSample^.Value := AChild.Value; 130 | System.Inc(LIndex); 131 | end 132 | ); 133 | finally 134 | TMonitor.Exit(Lock); 135 | end; 136 | end; 137 | 138 | function TCounter.CreateChild: TCounterChild; 139 | begin 140 | Result := TCounterChild.Create(); 141 | end; 142 | 143 | function TCounter.GetNames: TArray; 144 | begin 145 | Result := [Name]; 146 | end; 147 | 148 | function TCounter.GetValue: Double; 149 | begin 150 | Result := GetNoLabelChild.Value; 151 | end; 152 | 153 | procedure TCounter.Inc(const AAmount: Double); 154 | begin 155 | GetNoLabelChild.Inc(AAmount); 156 | end; 157 | 158 | end. 159 | -------------------------------------------------------------------------------- /Source/Prometheus.Collectors.Gauge.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Collectors.Gauge; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | Prometheus.Labels, 8 | Prometheus.Samples, 9 | Prometheus.SimpleCollector; 10 | 11 | type 12 | 13 | { TGaugeChild } 14 | 15 | /// 16 | /// Represents a child of a gauge assigned to specific label values. 17 | /// 18 | TGaugeChild = class 19 | strict private 20 | FLock: TObject; 21 | FValue: Double; 22 | public 23 | /// 24 | /// Creates a new instance of this gauge collector child. 25 | /// 26 | constructor Create; 27 | /// 28 | /// Performs object cleanup releasing all the owned instances. 29 | /// 30 | destructor Destroy; override; 31 | /// 32 | /// Decreases this gauge child by the amount provided. 33 | /// 34 | procedure Dec(const AAmount: Double = 1); 35 | /// 36 | /// Increases this gauge child by the amount provided. 37 | /// 38 | procedure Inc(const AAmount: Double = 1); 39 | /// 40 | /// Sets the value of this gauge child to the duration 41 | /// of the execution of the specified function. 42 | /// 43 | procedure SetDuration(const AProc: TProc); 44 | /// 45 | /// Sets the value of this gauge child to the specified amount. 46 | /// 47 | procedure SetTo(const AValue: Double); 48 | /// 49 | /// Sets the value of this gauge child to the current time as a Unix. 50 | /// 51 | procedure SetToCurrentTime; 52 | /// 53 | /// Returns the current value of this gauge child. 54 | /// 55 | property Value: Double read FValue; 56 | end; 57 | 58 | { TGauge } 59 | 60 | /// 61 | /// A gauge is a metric that represents a single numerical value that can 62 | /// arbitrarily go up and down. 63 | /// 64 | /// 65 | /// Gauges are typically used for measured values like temperatures or 66 | /// current memory usage, but also "counts" that can go up and down, 67 | /// like the number of concurrent requests. 68 | /// 69 | TGauge = class (TSimpleCollector) 70 | strict private 71 | function GetValue: Double; 72 | strict protected 73 | function CreateChild: TGaugeChild; override; 74 | public 75 | /// 76 | /// Collects all the metrics and the samples from this collector. 77 | /// 78 | function Collect: TArray; override; 79 | /// 80 | /// Gets all the metric names that are part of this collector. 81 | /// 82 | function GetNames: TArray; override; 83 | /// 84 | /// Decreases the default (unlabelled) gauge by the amount provided. 85 | /// 86 | procedure Dec(const AAmount: Double = 1); 87 | /// 88 | /// Increases the default (unlabelled) gauge by the amount provided. 89 | /// 90 | procedure Inc(const AAmount: Double = 1); 91 | /// 92 | /// Set the value of the default (unlabelled) gauge to the 93 | /// duration of the execution of the specified function. 94 | /// 95 | procedure SetDuration(const AProc: TProc); 96 | /// 97 | /// Sets the value of the default (unlabelled) gauge to the specified amount. 98 | /// 99 | procedure SetTo(const AValue: Double); 100 | /// 101 | /// Sets the value of the default (unlabelled) gauge to the current time as a Unix. 102 | /// 103 | procedure SetToCurrentTime; 104 | /// 105 | /// Returns the current value of the default (unlabelled) gauge. 106 | /// 107 | property Value: Double read GetValue; 108 | end; 109 | 110 | implementation 111 | 112 | { TGaugeChild } 113 | 114 | uses 115 | System.DateUtils, 116 | System.Diagnostics, 117 | Prometheus.Resources; 118 | 119 | constructor TGaugeChild.Create; 120 | begin 121 | inherited Create; 122 | FLock := TObject.Create; 123 | end; 124 | 125 | destructor TGaugeChild.Destroy; 126 | begin 127 | if Assigned(FLock) then 128 | FreeAndNil(FLock); 129 | inherited Destroy; 130 | end; 131 | 132 | procedure TGaugeChild.Dec(const AAmount: Double); 133 | begin 134 | TMonitor.Enter(FLock); 135 | try 136 | FValue := FValue - AAmount; 137 | finally 138 | TMonitor.Exit(FLock); 139 | end; 140 | end; 141 | 142 | procedure TGaugeChild.Inc(const AAmount: Double); 143 | begin 144 | TMonitor.Enter(FLock); 145 | try 146 | FValue := FValue + AAmount; 147 | finally 148 | TMonitor.Exit(FLock); 149 | end; 150 | end; 151 | 152 | procedure TGaugeChild.SetDuration(const AProc: TProc); 153 | begin 154 | TMonitor.Enter(FLock); 155 | try 156 | if not Assigned(AProc) then 157 | raise EArgumentNilException.Create(StrErrNullProcReference); 158 | var LStopWatch := TStopwatch.StartNew; 159 | try 160 | AProc; 161 | finally 162 | LStopWatch.Stop; 163 | FValue := LStopWatch.Elapsed.TotalMilliseconds; 164 | end; 165 | finally 166 | TMonitor.Exit(FLock); 167 | end; 168 | end; 169 | 170 | procedure TGaugeChild.SetTo(const AValue: Double); 171 | begin 172 | TMonitor.Enter(FLock); 173 | try 174 | FValue := AValue; 175 | finally 176 | TMonitor.Exit(FLock); 177 | end; 178 | end; 179 | 180 | procedure TGaugeChild.SetToCurrentTime; 181 | begin 182 | TMonitor.Enter(FLock); 183 | try 184 | FValue := TDateTime.NowUTC.ToUnix(); 185 | finally 186 | TMonitor.Exit(FLock); 187 | end; 188 | end; 189 | 190 | { TGauge } 191 | 192 | function TGauge.Collect: TArray; 193 | begin 194 | TMonitor.Enter(Lock); 195 | try 196 | SetLength(Result, 1); 197 | var LMetric := PMetricSamples(@Result[0]); 198 | LMetric^.MetricName := Self.Name; 199 | LMetric^.MetricHelp := Self.Help; 200 | LMetric^.MetricType := TMetricType.mtGauge; 201 | SetLength(LMetric^.Samples, ChildrenCount); 202 | var LIndex := 0; 203 | EnumChildren( 204 | procedure (const ALabelValues: TLabelValues; const AChild: TGaugeChild) 205 | begin 206 | var LSample := PSample(@LMetric^.Samples[LIndex]); 207 | LSample^.MetricName := Self.Name; 208 | LSample^.LabelNames := Self.LabelNames; 209 | LSample^.LabelValues := ALabelValues; 210 | LSample^.Value := AChild.Value; 211 | System.Inc(LIndex); 212 | end 213 | ); 214 | finally 215 | TMonitor.Exit(Lock); 216 | end; 217 | end; 218 | 219 | function TGauge.CreateChild: TGaugeChild; 220 | begin 221 | Result := TGaugeChild.Create(); 222 | end; 223 | 224 | procedure TGauge.Dec(const AAmount: Double); 225 | begin 226 | GetNoLabelChild.Dec(AAmount); 227 | end; 228 | 229 | function TGauge.GetNames: TArray; 230 | begin 231 | Result := [Name]; 232 | end; 233 | 234 | function TGauge.GetValue: Double; 235 | begin 236 | Result := GetNoLabelChild.Value; 237 | end; 238 | 239 | procedure TGauge.Inc(const AAmount: Double); 240 | begin 241 | GetNoLabelChild.Inc(AAmount); 242 | end; 243 | 244 | procedure TGauge.SetDuration(const AProc: TProc); 245 | begin 246 | GetNoLabelChild.SetDuration(AProc); 247 | end; 248 | 249 | procedure TGauge.SetTo(const AValue: Double); 250 | begin 251 | GetNoLabelChild.SetTo(AValue); 252 | end; 253 | 254 | procedure TGauge.SetToCurrentTime; 255 | begin 256 | GetNoLabelChild.SetToCurrentTime; 257 | end; 258 | 259 | end. 260 | -------------------------------------------------------------------------------- /Source/Prometheus.Collectors.Histogram.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Collectors.Histogram; 2 | 3 | interface 4 | 5 | uses 6 | Prometheus.Labels, 7 | Prometheus.Samples, 8 | Prometheus.SimpleCollector; 9 | 10 | type 11 | 12 | { TBuckets } 13 | 14 | TBuckets = TArray; 15 | 16 | { Consts } 17 | 18 | const 19 | 20 | /// 21 | /// Default histogram buckets. 22 | /// 23 | DEFAULT_BUCKETS: TBuckets = [ 24 | 0.005, 0.01, 0.025, 0.05, 0.075, 0.1, 25 | 0.25, 0.5, 0.75, 1, 2.5, 5, 7.5, 10, 26 | INFINITE 27 | ]; 28 | 29 | type 30 | 31 | { Forward class declarations } 32 | 33 | THistogram = class; 34 | 35 | { THistogramChild } 36 | 37 | /// 38 | /// Represents a histogram data collection for a given label combination. 39 | /// 40 | /// 41 | /// Includes the individual "bucket" values for the specified labels. 42 | /// 43 | THistogramChild = class 44 | strict private 45 | FOwner: THistogram; 46 | FLock: TObject; 47 | FCount: Int64; 48 | FSum: Double; 49 | FValues: TArray; 50 | public 51 | /// 52 | /// Creates a new instance of this histogram collector child. 53 | /// 54 | constructor Create(AOwner: THistogram); 55 | /// 56 | /// Performs object cleanup releasing all the owned instances. 57 | /// 58 | destructor Destroy; override; 59 | /// 60 | /// Collects all the samples of this histogram child. 61 | /// 62 | procedure CollectChild(var ASamples: TArray; 63 | const ALabelValues: TLabelValues); 64 | /// 65 | /// Adds a single observation to the histogram. 66 | /// 67 | /// 68 | /// The buckets are cummulative and any value that is less than - or equal 69 | /// to - the upper bound will increment the bucket. 70 | /// 71 | function Observe(AValue: Double): THistogram; 72 | /// 73 | /// Gets the total number of samples collected for this labelled child. 74 | /// 75 | property Count: Int64 read FCount; 76 | /// 77 | /// Gets the total cumulative value calculated for this labelled child. 78 | /// 79 | property Sum: Double read FSum; 80 | /// 81 | /// The array of cumulative counts for values falling within 82 | /// the intervals specified by the parent (owner) histogram. 83 | /// 84 | property Values: TArray read FValues; 85 | end; 86 | 87 | { TBucketGeneratorFunc } 88 | 89 | /// 90 | /// A function that returns the buckets to be used in histogram metrics. 91 | /// 92 | TBucketGeneratorFunc = reference to function: TBuckets; 93 | 94 | { THistogram } 95 | 96 | /// 97 | /// An histogram is a metric that counts observed values using a number 98 | /// of configurable buckets and expose those ones as individual counter 99 | /// time series. 100 | /// 101 | /// 102 | /// Histograms are tipically used to allow a generic service to record the 103 | /// distribution of a stream of data values into a set of ranged buckets. 104 | /// 105 | THistogram = class(TSimpleCollector) 106 | strict private 107 | FBuckets: TBuckets; 108 | FCount: Int64; 109 | FSum: Double; 110 | function GetValue: Double; 111 | private 112 | procedure IncrementOwner(AValue: Double); 113 | strict protected 114 | function CreateChild: THistogramChild; override; 115 | public 116 | /// 117 | /// Creates a new instance of a histogram collector. 118 | /// 119 | constructor Create(const AName: string; const AHelp: string = ''; 120 | const ABuckets: TBuckets = []; const ALabelNames: TLabelNames = []); reintroduce; overload; 121 | /// 122 | /// Creates a new instance of a histogram collector 123 | /// with an increasing sequence in the bucket. 124 | /// 125 | constructor Create(const AName: string; const AHelp: string; const AStart, AFactor: Double; const ACount: Integer; 126 | const ALabelNames: TLabelNames); reintroduce; overload; 127 | /// 128 | /// Creates a new instance of a histogram collector 129 | /// with a custom sequence of buckets. 130 | /// 131 | /// 132 | /// Generate buckets by passing an appropriate function when calling this constructor. 133 | /// 134 | constructor Create(const AName: string; const AHelp: string; 135 | ABucketGeneratorFunc: TBucketGeneratorFunc; 136 | const ALabelNames: TLabelNames); reintroduce; overload; 137 | /// 138 | /// Adds an observation to the top level histogram (i.e. no labels applied). 139 | /// 140 | /// 141 | function Observe(AValue: Double): THistogram; 142 | /// 143 | /// Collects all the metrics and the samples from this collector. 144 | /// 145 | function Collect: TArray; override; 146 | /// 147 | /// Gets all the metric names that are part of this collector. 148 | /// 149 | function GetNames: TArray; override; 150 | /// 151 | /// Gets an array holding the upper limit of each histogram bucket. 152 | /// 153 | property Buckets: TBuckets read FBuckets; 154 | /// 155 | /// Returns the current count of values belonging to this metric. 156 | /// 157 | property Count: Int64 read FCount; 158 | /// 159 | /// Returns the current sum of values belonging to this metric. 160 | /// 161 | property Sum: Double read FSum; 162 | /// 163 | /// Returns the current value of the default (unlabelled) histogram. 164 | /// 165 | property Value: Double read GetValue; 166 | end; 167 | 168 | implementation 169 | 170 | uses 171 | System.Generics.Collections, 172 | System.StrUtils, 173 | System.SysUtils, 174 | Prometheus.Resources; 175 | 176 | const 177 | RESERVED_LABEL_NAME = 'le'; 178 | 179 | { THistogramChild } 180 | 181 | constructor THistogramChild.Create(AOwner: THistogram); 182 | begin 183 | inherited Create; 184 | if not Assigned(AOwner) then 185 | raise EArgumentNilException.Create(StrErrHistogramOwnerNil); 186 | if Length(AOwner.Buckets) <= 0 then 187 | raise EArgumentException.Create(StrErrHistogramOwnerNoBuckets); 188 | FLock := TObject.Create; 189 | FOwner := AOwner; 190 | SetLength(FValues, Length(AOwner.Buckets)); 191 | end; 192 | 193 | destructor THistogramChild.Destroy; 194 | begin 195 | if Assigned(FLock) then 196 | FreeAndNil(FLock); 197 | inherited Destroy; 198 | end; 199 | 200 | procedure THistogramChild.CollectChild(var ASamples: TArray; 201 | const ALabelValues: TLabelValues); 202 | begin 203 | TMonitor.Enter(FLock); 204 | try 205 | var LStartIndex := Length(ASamples); 206 | SetLength(ASamples, LStartIndex + Length(FOwner.Buckets)); 207 | 208 | var LLabelNames := FOwner.LabelNames; 209 | SetLength(LLabelNames, Length(FOwner.LabelNames) + 1); 210 | LLabelNames[Length(FOwner.LabelNames)] := RESERVED_LABEL_NAME; 211 | 212 | var LLabelValues := ALabelValues; 213 | SetLength(LLabelValues, Length(ALabelValues) + 1); 214 | 215 | for var LBucketIndex := 0 to Length(FOwner.Buckets) - 1 do 216 | begin 217 | var LSample := PSample(@ASamples[LStartIndex + LBucketIndex]); 218 | LSample^.MetricName := FOwner.Name + '_bucket'; 219 | LSample^.LabelNames := LLabelNames; 220 | if FOwner.Buckets[LBucketIndex] < INFINITE then 221 | begin 222 | var LFormatSettings := TFormatSettings.Create; 223 | LFormatSettings.DecimalSeparator := '.'; 224 | LFormatSettings.ThousandSeparator := ','; 225 | LLabelValues[Length(ALabelValues)] := FloatToStr(FOwner.Buckets[LBucketIndex], LFormatSettings) 226 | end 227 | else 228 | LLabelValues[Length(ALabelValues)] := '+Inf'; 229 | LSample^.LabelValues := LLabelValues; 230 | SetLength(LSample^.LabelValues, Length(LLabelValues)); 231 | LSample^.Value := FValues[LBucketIndex]; 232 | end; 233 | finally 234 | TMonitor.Exit(FLock); 235 | end; 236 | end; 237 | 238 | function THistogramChild.Observe(AValue: Double): THistogram; 239 | begin 240 | TMonitor.Enter(FLock); 241 | try 242 | for var LIndex := Length(FValues) - 1 downto 0 do 243 | begin 244 | if AValue <= FOwner.Buckets[LIndex] then 245 | Inc(FValues[LIndex]) 246 | else 247 | Break; 248 | end; 249 | Inc(FCount); 250 | FSum := FSum + AValue; 251 | finally 252 | TMonitor.Exit(FLock); 253 | end; 254 | FOwner.IncrementOwner(AValue); 255 | Result := FOwner; 256 | end; 257 | 258 | { THistogram } 259 | 260 | constructor THistogram.Create(const AName, AHelp: string; 261 | const ABuckets: TBuckets; const ALabelNames: TLabelNames); 262 | begin 263 | if IndexText(RESERVED_LABEL_NAME, ALabelNames) > -1 then 264 | raise EInvalidOpException.CreateFmt('Label name ''%s'' is reserved', [RESERVED_LABEL_NAME]); 265 | if Length(ABuckets) > 0 then 266 | FBuckets := ABuckets 267 | else 268 | FBuckets := DEFAULT_BUCKETS; 269 | TArray.Sort(FBuckets); 270 | var LBucketCount := Length(FBuckets); 271 | if FBuckets[LBucketCount - 1] < INFINITE then 272 | begin 273 | SetLength(FBuckets, LBucketCount + 1); 274 | FBuckets[LBucketCount] := INFINITE; 275 | end; 276 | inherited Create(AName, AHelp, ALabelNames); 277 | end; 278 | 279 | constructor THistogram.Create(const AName, AHelp: string; 280 | ABucketGeneratorFunc: TBucketGeneratorFunc; const ALabelNames: TLabelNames); 281 | begin 282 | Create(AName, AHelp, ABucketGeneratorFunc, ALabelNames); 283 | end; 284 | 285 | constructor THistogram.Create(const AName, AHelp: string; 286 | const AStart, AFactor: Double; const ACount: Integer; 287 | const ALabelNames: TLabelNames); 288 | begin 289 | Create(AName, AHelp, 290 | function (): TBuckets 291 | begin 292 | SetLength(Result, ACount); 293 | var LCurrentValue := AStart; 294 | for var LCurrentIndex := 0 to ACount - 1 do 295 | begin 296 | Result[LCurrentIndex] := LCurrentValue; 297 | LCurrentValue := LCurrentValue * AFactor; 298 | end; 299 | end, 300 | ALabelNames); 301 | end; 302 | 303 | function THistogram.CreateChild: THistogramChild; 304 | begin 305 | Result := THistogramChild.Create(Self); 306 | end; 307 | 308 | function THistogram.Collect: TArray; 309 | begin 310 | TMonitor.Enter(Lock); 311 | try 312 | SetLength(Result, 1); 313 | var LMetric := PMetricSamples(@Result[0]); 314 | LMetric^.MetricName := Self.Name; 315 | LMetric^.MetricHelp := Self.Help; 316 | LMetric^.MetricType := TMetricType.mtHistogram; 317 | LMetric^.MetricSum := FSum; 318 | LMetric^.MetricCount := FCount; 319 | SetLength(LMetric.Samples, 0); // Clear link to previous samples. 320 | EnumChildren( 321 | procedure(const ALabelValues: TLabelValues; const AChild: THistogramChild) 322 | begin 323 | if Length(LabelNames) > 0 then 324 | begin 325 | // Add the top level sum for the child. 326 | var LStartIndex := Length(LMetric.Samples); 327 | SetLength(LMetric.Samples, LStartIndex + 1); 328 | var LSample := PSample(@LMetric.Samples[LStartIndex]); 329 | LSample^.MetricName := Name + '_sum'; 330 | LSample^.LabelNames := LabelNames; 331 | LSample^.LabelValues := ALabelValues; 332 | LSample^.Value := AChild.Sum; 333 | // Add the top level count for the child. 334 | LStartIndex := Length(LMetric.Samples); 335 | SetLength(LMetric.Samples, LStartIndex + 1); 336 | LSample := PSample(@LMetric.Samples[LStartIndex]); 337 | LSample^.MetricName := Name + '_count'; 338 | LSample^.LabelNames := LabelNames; 339 | LSample^.LabelValues := ALabelValues; 340 | LSample^.Value := AChild.Count; 341 | end; 342 | AChild.CollectChild(LMetric^.Samples, ALabelValues); 343 | end 344 | ); 345 | finally 346 | TMonitor.Exit(Lock); 347 | end; 348 | end; 349 | 350 | function THistogram.GetNames: TArray; 351 | begin 352 | Result := [Name]; 353 | end; 354 | 355 | function THistogram.GetValue: Double; 356 | begin 357 | Result := GetNoLabelChild.Sum; 358 | end; 359 | 360 | procedure THistogram.IncrementOwner(AValue: Double); 361 | begin 362 | TMonitor.Enter(Lock); 363 | try 364 | Inc(FCount); 365 | FSum := FSum + AValue; 366 | finally 367 | TMonitor.Exit(Lock); 368 | end; 369 | end; 370 | 371 | function THistogram.Observe(AValue: Double): THistogram; 372 | begin 373 | Result := Self; 374 | TMonitor.Enter(Lock); 375 | try 376 | GetNoLabelChild.Observe(AValue); 377 | finally 378 | TMonitor.Exit(Lock); 379 | end; 380 | end; 381 | 382 | end. 383 | -------------------------------------------------------------------------------- /Source/Prometheus.Exposers.Text.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Exposers.Text; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | System.SysUtils, 8 | Prometheus.Samples; 9 | 10 | type 11 | 12 | { TTextExposer } 13 | 14 | /// 15 | /// Provides methods to export metrics using the Prometheus text representation. 16 | /// 17 | TTextExposer = class 18 | strict private 19 | function EscapeToken(const AText: string): string; 20 | function FormatNumber(const AValue: Double): string; 21 | public 22 | /// 23 | /// Renders the specified samples as a string. 24 | /// 25 | function Render(ASamples: TArray): string; overload; 26 | /// 27 | /// Renders the specified samples to a string buffer. 28 | /// 29 | procedure Render(ABuilder: TStringBuilder; ASamples: TArray); overload; 30 | /// 31 | /// Renders the specified samples to a destination stream. 32 | /// 33 | procedure Render(AStream: TStream; ASamples: TArray); overload; 34 | /// 35 | /// Renders the specified samples to a text writer instance. 36 | /// 37 | procedure Render(AWriter: TTextWriter; ASamples: TArray); overload; 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | System.Math; 44 | 45 | type 46 | 47 | { TTextEncoding } 48 | 49 | /// 50 | /// Represents the UTF-8 encoding that is compliant with Prometheus text format. 51 | /// 52 | TTextEncoding = class(TUTF8Encoding) 53 | public 54 | /// 55 | /// Returns this encoding preamble in a byte array. 56 | /// 57 | function GetPreamble: TBytes; override; 58 | end; 59 | 60 | function TTextEncoding.GetPreamble: TBytes; 61 | begin 62 | SetLength(Result, 0); 63 | end; 64 | 65 | { TTextExposer } 66 | 67 | function TTextExposer.EscapeToken(const AText: string): string; 68 | begin 69 | Result := AText 70 | .Replace('\', '\\') 71 | .Replace(#13#10, '\n') 72 | .Replace(#13, '\n') 73 | .Replace(#10, '\n') 74 | .Replace(#9, '\t') 75 | .Replace('"', '\"'); 76 | end; 77 | 78 | function TTextExposer.FormatNumber(const AValue: Double): string; 79 | const 80 | // This pattern avoids the use of exponential notation 81 | // since it leads to errors when parsed from Prometheus 82 | // using the strconv.ParseFloat() function call in Go 83 | // (see: https://pkg.go.dev/strconv#ParseFloat). 84 | SFormatPattern = '0.######################'; 85 | begin 86 | if AValue.IsNegativeInfinity then 87 | begin 88 | Result := '-Inf'; 89 | Exit; 90 | end; 91 | if AValue.IsPositiveInfinity then 92 | begin 93 | Result := '+Inf'; 94 | Exit; 95 | end; 96 | if AValue.IsNan then 97 | begin 98 | Result := 'Nan'; 99 | Exit; 100 | end; 101 | var LFormatSettings := TFormatSettings.Create; 102 | LFormatSettings.DecimalSeparator := '.'; 103 | LFormatSettings.ThousandSeparator := ','; 104 | Result := FormatFloat(SFormatPattern, AValue, LFormatSettings); 105 | end; 106 | 107 | function TTextExposer.Render(ASamples: TArray): string; 108 | begin 109 | var LBuffer := TStringBuilder.Create; 110 | try 111 | Render(LBuffer, ASamples); 112 | Result := LBuffer.ToString; 113 | finally 114 | LBuffer.Free; 115 | end; 116 | end; 117 | 118 | procedure TTextExposer.Render(ABuilder: TStringBuilder; ASamples: TArray); 119 | begin 120 | var LWriter := TStringWriter.Create(ABuilder); 121 | try 122 | Render(LWriter, ASamples); 123 | finally 124 | LWriter.Free; 125 | end; 126 | end; 127 | 128 | procedure TTextExposer.Render(AStream: TStream; ASamples: TArray); 129 | begin 130 | var LEncoding := TTextEncoding.Create; 131 | try 132 | var LWriter := TStreamWriter.Create(AStream, LEncoding); 133 | try 134 | Render(LWriter, ASamples); 135 | finally 136 | LWriter.Free; 137 | end; 138 | finally 139 | LEncoding.Free; 140 | end; 141 | end; 142 | 143 | procedure TTextExposer.Render(AWriter: TTextWriter; ASamples: TArray); 144 | begin 145 | for var LMetricSet in ASamples do 146 | begin 147 | if LMetricSet.IsEmpty then 148 | Continue; 149 | 150 | // Metric help 151 | AWriter.Write('# HELP'); 152 | AWriter.Write(' '); 153 | AWriter.Write(LMetricSet.MetricName); 154 | AWriter.Write(' '); 155 | AWriter.Write(EscapeToken(LMetricSet.MetricHelp)); 156 | if not LMetricSet.MetricHelp.EndsWith('.') then 157 | AWriter.Write('.'); 158 | AWriter.Write(#10); 159 | 160 | // Metric type 161 | AWriter.Write('# TYPE'); 162 | AWriter.Write(' '); 163 | AWriter.Write(LMetricSet.MetricName); 164 | AWriter.Write(' '); 165 | AWriter.Write(StrMetricType[LMetricSet.MetricType]); 166 | AWriter.Write(#10); 167 | 168 | // Metric samples 169 | for var LSample in LMetricSet.Samples do 170 | begin 171 | AWriter.Write(LSample.MetricName); 172 | if LSample.HasLabels then 173 | begin 174 | AWriter.Write('{'); 175 | var LLabelCount := Min(Length(LSample.LabelNames), Length(LSample.LabelValues)); 176 | if LLabelCount <= 0 then 177 | Continue; 178 | for var LLabelIndex := 0 to Pred(LLabelCount) do 179 | begin 180 | if LLabelIndex > 0 then 181 | AWriter.Write(','); 182 | AWriter.Write(LSample.LabelNames[LLabelIndex]); 183 | AWriter.Write('="'); 184 | AWriter.Write(EscapeToken(LSample.LabelValues[LLabelIndex])); 185 | AWriter.Write('"'); 186 | end; 187 | AWriter.Write('}'); 188 | end; 189 | AWriter.Write(' '); 190 | AWriter.Write(FormatNumber(LSample.Value)); 191 | AWriter.Write(#10); 192 | end; 193 | 194 | if LMetricSet.MetricType = TMetricType.mtHistogram then 195 | begin 196 | if LMetricSet.MetricSum > 0.0 then 197 | begin 198 | AWriter.Write(Format('%s_sum %s', [ 199 | LMetricSet.MetricName, 200 | FormatNumber(LMetricSet.MetricSum) 201 | ])); 202 | AWriter.Write(#10); 203 | end; 204 | if LMetricSet.MetricCount > 0.0 then 205 | begin 206 | AWriter.Write(Format('%s_count %s', [ 207 | LMetricSet.MetricName, 208 | IntToStr(LMetricSet.MetricCount) 209 | ])); 210 | AWriter.Write(#10); 211 | end; 212 | end; 213 | end; 214 | end; 215 | 216 | end. 217 | -------------------------------------------------------------------------------- /Source/Prometheus.Labels.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Labels; 2 | 3 | interface 4 | 5 | uses 6 | System.Generics.Defaults; 7 | 8 | type 9 | 10 | { TLabelNames } 11 | 12 | /// 13 | /// Represents a set of label names. 14 | /// 15 | TLabelNames = TArray; 16 | 17 | { TLabelValues } 18 | 19 | /// 20 | /// Represents a set of label values. 21 | /// 22 | TLabelValues = TArray; 23 | 24 | { TLabelValidator } 25 | 26 | /// 27 | /// Provides methods to validate label names. 28 | /// 29 | TLabelValidator = class sealed 30 | strict private const 31 | NamePattern: string = '^[a-zA-Z_][a-zA-Z0-9_]*$'; 32 | ReservedPattern: string = '^__.*$'; 33 | public 34 | /// 35 | /// Check if a label name is valid. 36 | /// 37 | class procedure CheckLabel(const AName: string); 38 | /// 39 | /// Check if a set of label names is valid. 40 | /// 41 | class procedure CheckLabels(const ANames: TLabelNames); 42 | end; 43 | 44 | { TLabelNamesEqualityComparer } 45 | 46 | /// 47 | /// Implements an equality comparer for label names. 48 | /// 49 | TLabelNamesEqualityComparer = class (TEqualityComparer) 50 | public 51 | function Equals(const Left, Right: TLabelNames): Boolean; override; 52 | function GetHashCode(const Value: TLabelNames): Integer; override; 53 | end; 54 | 55 | implementation 56 | 57 | uses 58 | System.Hash, 59 | System.RegularExpressions, 60 | System.SysUtils, 61 | Prometheus.Resources; 62 | 63 | { TLabelValidator } 64 | 65 | class procedure TLabelValidator.CheckLabel(const AName: string); 66 | begin 67 | if Length(Trim(AName)) <= 0 then 68 | begin 69 | raise EArgumentException.Create(StrErrEmptyLabelName); 70 | end; 71 | if not TRegEx.IsMatch(AName, NamePattern) then 72 | begin 73 | raise EArgumentException.Create(StrErrInvalidLabelName); 74 | end; 75 | if TRegEx.IsMatch(AName, ReservedPattern) then 76 | begin 77 | raise EArgumentException.Create(StrErrReservedLabelName); 78 | end; 79 | end; 80 | 81 | class procedure TLabelValidator.CheckLabels(const ANames: TLabelNames); 82 | begin 83 | for var LName in ANames do 84 | CheckLabel(LName); 85 | end; 86 | 87 | { TLabelNamesEqualityComparer } 88 | 89 | function TLabelNamesEqualityComparer.Equals( 90 | const Left, Right: TLabelNames): Boolean; 91 | begin 92 | if Length(Left) <> Length(Right) then 93 | begin 94 | Result := False; 95 | Exit; 96 | end; 97 | for var LIndex := 0 to Pred(Length(Left)) do 98 | if not SameText(Left[LIndex], Right[LIndex]) then 99 | begin 100 | Result := False; 101 | Exit; 102 | end; 103 | Result := True; 104 | end; 105 | 106 | function TLabelNamesEqualityComparer.GetHashCode( 107 | const Value: TLabelNames): Integer; 108 | begin 109 | var LText := string.Empty; 110 | for var LIndex := 0 to Pred(Length(Value)) do 111 | LText := LText + LowerCase(Value[LIndex]); 112 | Result := THashFNV1a32.GetHashValue(LText); 113 | end; 114 | 115 | end. 116 | -------------------------------------------------------------------------------- /Source/Prometheus.Metrics.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Metrics; 2 | 3 | interface 4 | 5 | type 6 | 7 | { TMetricValidator } 8 | 9 | /// 10 | /// Provides methods to validate metric names. 11 | /// 12 | TMetricValidator = class sealed 13 | strict private const 14 | NamePattern: string = '^[a-zA-Z_:][a-zA-Z0-9_:]*$'; 15 | public 16 | /// 17 | /// Check if a metric name is valid. 18 | /// 19 | class procedure CheckName(const AName: string); 20 | end; 21 | 22 | implementation 23 | 24 | { TMetricValidator } 25 | 26 | uses 27 | System.RegularExpressions, 28 | System.SysUtils, 29 | Prometheus.Resources; 30 | 31 | class procedure TMetricValidator.CheckName(const AName: string); 32 | begin 33 | if Length(AName) <= 0 then 34 | raise EArgumentException.Create(StrErrEmptyMetricName); 35 | if not TRegEx.IsMatch(AName, NamePattern) then 36 | raise EArgumentException.Create(StrErrInvalidMetricName); 37 | end; 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /Source/Prometheus.Registry.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Registry; 2 | 3 | interface 4 | 5 | uses 6 | System.Generics.Collections, 7 | Prometheus.Collector, 8 | Prometheus.Samples; 9 | 10 | type 11 | 12 | { TCollectorRegistry } 13 | 14 | /// 15 | /// A collector registry is used to contain and manage collectors 16 | /// and allows one or more of them to be registered. 17 | /// 18 | /// 19 | /// Collectors can be registered to one ore more collector registry. 20 | /// Each registry can be scraped to collect metrics and samples from 21 | /// collectors that are being managed by it. 22 | /// 23 | TCollectorRegistry = class 24 | strict private 25 | FCollectorsToNames: TDictionary>; 26 | FLock: TObject; 27 | FNamesToCollectors: TDictionary; 28 | class var FDefaultRegistry: TCollectorRegistry; 29 | class function GetDefaultRegistry: TCollectorRegistry; static; 30 | public 31 | /// 32 | /// Performs cleanup and release of resources used by this class. 33 | /// 34 | class destructor Finalize; 35 | /// 36 | /// Creates a new collector registry. 37 | /// 38 | constructor Create(AOwnsCollectors: Boolean = True); 39 | /// 40 | /// Performs object cleanup releasing all the owned instances. 41 | /// 42 | destructor Destroy; override; 43 | /// 44 | /// Clears all the registered collectors within this instance. 45 | /// 46 | procedure Clear; 47 | /// 48 | /// Collects all the metrics and their samples from the registered collectors. 49 | /// 50 | function Collect: TArray; 51 | /// 52 | /// Gets a collector of the specified type by its name. 53 | /// 54 | function GetCollector(const AName: string): T; 55 | /// 56 | /// Check if a collector is registered with the specified name. 57 | /// 58 | function HasCollector(const AName: string): Boolean; 59 | /// 60 | /// Registers a collector within this registry. 61 | /// 62 | procedure &Register(ACollector: TCollector); 63 | /// 64 | /// Unregisters a collector from this registry. 65 | /// 66 | procedure Unregister(ACollector: TCollector); 67 | /// 68 | /// Returns the default registry instance. 69 | /// 70 | /// 71 | /// Collectors can be registered in this default instance 72 | /// or you can create a new registry instance by your own. 73 | /// 74 | class property DefaultRegistry: TCollectorRegistry read GetDefaultRegistry; 75 | end; 76 | 77 | implementation 78 | 79 | uses 80 | System.SysUtils, 81 | Prometheus.Resources; 82 | 83 | { TCollectorRegistry } 84 | 85 | constructor TCollectorRegistry.Create(AOwnsCollectors: Boolean); 86 | begin 87 | inherited Create; 88 | if AOwnsCollectors then 89 | FCollectorsToNames := TObjectDictionary>.Create([doOwnsKeys]) 90 | else 91 | FCollectorsToNames := TDictionary>.Create; 92 | FLock := TObject.Create; 93 | FNamesToCollectors := TDictionary.Create; 94 | end; 95 | 96 | destructor TCollectorRegistry.Destroy; 97 | begin 98 | if Assigned(FCollectorsToNames) then 99 | FreeAndNil(FCollectorsToNames); 100 | if Assigned(FLock) then 101 | FreeAndNil(FLock); 102 | if Assigned(FNamesToCollectors) then 103 | FreeAndNil(FNamesToCollectors); 104 | inherited Destroy; 105 | end; 106 | 107 | class destructor TCollectorRegistry.Finalize; 108 | begin 109 | if Assigned(FDefaultRegistry) then 110 | FreeAndNil(FDefaultRegistry); 111 | end; 112 | 113 | procedure TCollectorRegistry.Clear; 114 | begin 115 | TMonitor.Enter(FLock); 116 | try 117 | FCollectorsToNames.Clear; 118 | FNamesToCollectors.Clear; 119 | finally 120 | TMonitor.Exit(FLock); 121 | end; 122 | end; 123 | 124 | function TCollectorRegistry.Collect: TArray; 125 | begin 126 | TMonitor.Enter(FLock); 127 | try 128 | SetLength(Result, 0); 129 | if FCollectorsToNames.Count <= 0 then 130 | Exit; 131 | var LSamples := TList>.Create; 132 | try 133 | for var LCollectorItem in FCollectorsToNames.Keys do 134 | LSamples.Add(LCollectorItem.Collect); 135 | Result := TArray.Concat(LSamples.ToArray); 136 | finally 137 | LSamples.Free; 138 | end; 139 | finally 140 | TMonitor.Exit(FLock); 141 | end; 142 | end; 143 | 144 | function TCollectorRegistry.GetCollector(const AName: string): T; 145 | var 146 | LItem: TCollector; 147 | begin 148 | TMonitor.Enter(FLock); 149 | try 150 | if FNamesToCollectors.TryGetValue(AName, LItem) then 151 | Result := T(LItem) 152 | else 153 | Result := nil; 154 | finally 155 | TMonitor.Exit(FLock); 156 | end; 157 | end; 158 | 159 | class function TCollectorRegistry.GetDefaultRegistry: TCollectorRegistry; 160 | begin 161 | if not Assigned(FDefaultRegistry) then 162 | FDefaultRegistry := TCollectorRegistry.Create; 163 | Result := FDefaultRegistry; 164 | end; 165 | 166 | function TCollectorRegistry.HasCollector(const AName: string): Boolean; 167 | begin 168 | TMonitor.Enter(FLock); 169 | try 170 | Result := FNamesToCollectors.ContainsKey(AName); 171 | finally 172 | TMonitor.Exit(FLock); 173 | end; 174 | end; 175 | 176 | procedure TCollectorRegistry.Register(ACollector: TCollector); 177 | begin 178 | TMonitor.Enter(FLock); 179 | try 180 | if not Assigned(ACollector) then 181 | raise EArgumentException.Create(StrErrNullCollector); 182 | var LCollectorNames := ACollector.GetNames; 183 | for var LNameToCheck in LCollectorNames do 184 | begin 185 | if FNamesToCollectors.ContainsKey(LNameToCheck) then 186 | raise EListError.Create(StrErrCollectorNameInUse); 187 | end; 188 | for var LNameToAdd in LCollectorNames do 189 | FNamesToCollectors.AddOrSetValue(LNameToAdd, ACollector); 190 | FCollectorsToNames.AddOrSetValue(ACollector, LCollectorNames); 191 | finally 192 | TMonitor.Exit(FLock); 193 | end; 194 | end; 195 | 196 | procedure TCollectorRegistry.Unregister(ACollector: TCollector); 197 | begin 198 | TMonitor.Enter(FLock); 199 | try 200 | FCollectorsToNames.Remove(ACollector); 201 | for var LName in ACollector.GetNames do 202 | FNamesToCollectors.Remove(LName); 203 | finally 204 | TMonitor.Exit(FLock); 205 | end; 206 | end; 207 | 208 | end. 209 | -------------------------------------------------------------------------------- /Source/Prometheus.Resources.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Resources; 2 | 3 | interface 4 | 5 | { Resource strings } 6 | 7 | resourcestring 8 | StrErrEmptyMetricName = 'Metric name is empty'; 9 | StrErrEmptyLabelName = 'Metric label name is empty'; 10 | StrErrInvalidMetricName = 'Invalid metric name'; 11 | StrErrInvalidLabelName = 'Invalid metric label name'; 12 | StrErrReservedLabelName = 'Metric label name is reserved for internal use'; 13 | StrErrLabelNameValueMismatch = 'Length must match label names'; 14 | StrErrLabelValuesMissing = 'Label values are missing'; 15 | StrErrAmountLessThanZero = 'Amount must be greater than zero'; 16 | StrErrNullProcReference = 'Reference to procedure not assigned'; 17 | StrErrNullCollector = 'Collector reference not assigned'; 18 | StrErrCollectorNameInUse = 'Name is already in use by another registered collector'; 19 | StrErrCollectorHasLabels = 'This collectors has labels: use label values to retrieve children collectors'; 20 | StrErrHistogramOwnerNil = 'Histogram owner is not assigned'; 21 | StrErrHistogramOwnerNoBuckets = 'Histogram owner has no buckets'; 22 | 23 | implementation 24 | 25 | end. 26 | -------------------------------------------------------------------------------- /Source/Prometheus.Samples.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Samples; 2 | 3 | interface 4 | 5 | uses 6 | Prometheus.Labels, 7 | Prometheus.Metrics; 8 | 9 | type 10 | 11 | { Enums } 12 | 13 | TMetricType = (mtCounter, mtGauge, mtHistogram); 14 | 15 | { TSample } 16 | 17 | /// 18 | /// Represents a typical sample that can belong to any metrics and can 19 | /// be associated to label names and values. Each sample can be scraped 20 | /// forming the actual time series data stored inside Prometheus. 21 | /// 22 | TSample = record 23 | /// 24 | /// The metric name this sample belongs to. 25 | /// 26 | MetricName: string; 27 | /// 28 | /// The names for the labels this sample is bound to. 29 | /// 30 | LabelNames: TLabelNames; 31 | /// 32 | /// The values for the labels this sample is bound to. 33 | /// 34 | LabelValues: TArray; 35 | /// 36 | /// The current value of this sample. 37 | /// 38 | Value: Double; 39 | /// 40 | /// Check if this sample is bound to label names and values. 41 | /// 42 | function HasLabels: Boolean; 43 | end; 44 | 45 | { PSample } 46 | 47 | /// 48 | /// Represents a pointer to a sample record. 49 | /// 50 | PSample = ^TSample; 51 | 52 | { TMetricSamples } 53 | 54 | /// 55 | /// Represents a set of samples collected for a specific metric. 56 | /// 57 | TMetricSamples = record 58 | /// 59 | /// The name of the metric. 60 | /// 61 | MetricName: string; 62 | /// 63 | /// The help text for the metric. 64 | /// 65 | MetricHelp: string; 66 | /// 67 | /// The type of the metric. 68 | /// 69 | MetricType: TMetricType; 70 | /// 71 | /// The set of samples collected for the metric. 72 | /// 73 | Samples: TArray; 74 | /// 75 | /// The sum off all metrics values (used for histograms). 76 | /// 77 | MetricSum: Double; 78 | /// 79 | /// The count of all observed processes (used for histograms). 80 | /// 81 | MetricCount: Int64; 82 | /// 83 | /// Indicates whether the current metric has no samples in it. 84 | /// 85 | function IsEmpty: Boolean; 86 | end; 87 | 88 | { PMetricSamples } 89 | 90 | /// 91 | /// Represents a pointer to a set of metric samples. 92 | /// 93 | PMetricSamples = ^TMetricSamples; 94 | 95 | const 96 | StrMetricType: array[TMetricType] of string = ( 97 | 'counter', 'gauge', 'histogram' 98 | ); 99 | 100 | implementation 101 | 102 | { TSample } 103 | 104 | function TSample.HasLabels: Boolean; 105 | begin 106 | Result := (Length(LabelNames) > 0) and (Length(LabelValues) > 0); 107 | end; 108 | 109 | { TMetricSamples } 110 | 111 | function TMetricSamples.IsEmpty: Boolean; 112 | begin 113 | Result := Length(Samples) <= 0; 114 | end; 115 | 116 | end. 117 | -------------------------------------------------------------------------------- /Source/Prometheus.SimpleCollector.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.SimpleCollector; 2 | 3 | interface 4 | 5 | uses 6 | System.Generics.Collections, 7 | Prometheus.Collector, 8 | Prometheus.Labels, 9 | Prometheus.Metrics, 10 | Prometheus.Registry; 11 | 12 | type 13 | 14 | { References to procedures } 15 | 16 | /// 17 | /// Represents a callback procedure that can be passed to a method that 18 | /// enumerates the children of a collector using a specific criteria. 19 | /// 20 | TChildrenCallback = reference to procedure ( 21 | const ALabelValues: TLabelValues; const AChild: TChild 22 | ); 23 | 24 | { TSimpleCollector } 25 | 26 | /// 27 | /// Represents the base class that any typical collector must inherit 28 | /// and provides all the basic features, like registration and so on. 29 | /// 30 | TSimpleCollector = class abstract(TCollector) 31 | strict private 32 | FChildren: TDictionary; 33 | FHelp: string; 34 | FLabelNames: TLabelNames; 35 | FLock: TObject; 36 | FName: string; 37 | procedure InitializeNoLabelChildIfNeeded(); 38 | function GetChildrenCount: Integer; 39 | strict protected 40 | function CreateChild: TChild; virtual; 41 | procedure EnumChildren(ACallback: TChildrenCallback); 42 | function GetNoLabelChild: TChild; 43 | property Lock: TObject read FLock; 44 | public 45 | /// 46 | /// Creates a new instance of this collector. 47 | /// 48 | constructor Create(const AName: string; const AHelp: string = ''; 49 | const ALabelNames: TLabelNames = []); virtual; 50 | /// 51 | /// Performs object cleanup releasing all the owned instances. 52 | /// 53 | destructor Destroy; override; 54 | /// 55 | /// Clears any labelled children owned by this collector. 56 | /// 57 | procedure Clear; 58 | /// 59 | /// Create or retrieve the metric child for the specified label values. 60 | /// 61 | /// 62 | /// The count of label values must match the count of label names. 63 | /// 64 | function Labels(const ALabelValues: TLabelValues): TChild; 65 | /// 66 | /// Remove the metric child for the specified label values. 67 | /// 68 | procedure RemoveLabels(const ALabelValues: TLabelValues); 69 | /// 70 | /// Registers this collector within the specified registry. 71 | /// 72 | procedure &Register(ARegistry: TCollectorRegistry = nil); 73 | /// 74 | /// Unregister this collector from the specified registry. 75 | /// 76 | procedure Unregister(ARegistry: TCollectorRegistry = nil); 77 | /// 78 | /// Returns the count of children for this collector. 79 | /// 80 | property ChildrenCount: Integer read GetChildrenCount; 81 | /// 82 | /// Returns the help text for the metric. 83 | /// 84 | property Help: string read FHelp; 85 | /// 86 | /// Returns the set of label names for the metric. 87 | /// 88 | property LabelNames: TLabelNames read FLabelNames; 89 | /// 90 | /// Returns the name of this collector. 91 | /// 92 | property Name: string read FName; 93 | end; 94 | 95 | implementation 96 | 97 | uses 98 | System.SysUtils, 99 | Prometheus.Resources; 100 | 101 | { TSimpleCollector } 102 | 103 | constructor TSimpleCollector.Create(const AName: string; 104 | const AHelp: string = ''; const ALabelNames: TLabelNames = []); 105 | begin 106 | inherited Create(); 107 | FLock := TObject.Create; 108 | TMetricValidator.CheckName(AName); 109 | if Length(ALabelNames) > 0 then 110 | TLabelValidator.CheckLabels(ALabelNames); 111 | FName := AName; 112 | FHelp := AHelp; 113 | FLabelNames := ALabelNames; 114 | FChildren := TObjectDictionary.Create([doOwnsValues], 115 | TLabelNamesEqualityComparer.Create); 116 | InitializeNoLabelChildIfNeeded; 117 | end; 118 | 119 | destructor TSimpleCollector.Destroy; 120 | begin 121 | if Assigned(FChildren) then 122 | FreeAndNil(FChildren); 123 | if Assigned(FLock) then 124 | FreeAndNil(FLock); 125 | inherited Destroy; 126 | end; 127 | 128 | function TSimpleCollector.CreateChild: TChild; 129 | begin 130 | Result := nil; 131 | end; 132 | 133 | procedure TSimpleCollector.EnumChildren(ACallback: TChildrenCallback); 134 | begin 135 | TMonitor.Enter(FLock); 136 | try 137 | for var LChild in FChildren do 138 | ACallback(LChild.Key, LChild.Value); 139 | finally 140 | TMonitor.Exit(FLock); 141 | end; 142 | end; 143 | 144 | function TSimpleCollector.GetChildrenCount: Integer; 145 | begin 146 | TMonitor.Enter(FLock); 147 | try 148 | Result := FChildren.Count; 149 | finally 150 | TMonitor.Exit(FLock); 151 | end; 152 | end; 153 | 154 | function TSimpleCollector.GetNoLabelChild: TChild; 155 | begin 156 | TMonitor.Enter(FLock); 157 | try 158 | if Length(FLabelNames) > 0 then 159 | raise EInvalidOpException.Create(StrErrCollectorHasLabels); 160 | InitializeNoLabelChildIfNeeded; 161 | Result := FChildren.Values.ToArray[0]; 162 | finally 163 | TMonitor.Exit(FLock); 164 | end; 165 | end; 166 | 167 | procedure TSimpleCollector.InitializeNoLabelChildIfNeeded; 168 | begin 169 | TMonitor.Enter(FLock); 170 | try 171 | if (Length(FLabelNames) <= 0) and (FChildren.Count <= 0) then 172 | FChildren.Add(nil, CreateChild); 173 | finally 174 | TMonitor.Exit(FLock); 175 | end; 176 | end; 177 | 178 | function TSimpleCollector.Labels(const ALabelValues: TLabelValues): TChild; 179 | begin 180 | TMonitor.Enter(FLock); 181 | try 182 | if Length(ALabelValues) <= 0 then 183 | raise EArgumentException.Create(StrErrLabelValuesMissing); 184 | if Length(ALabelValues) <> Length(FLabelNames) then 185 | raise EArgumentException.Create(StrErrLabelNameValueMismatch); 186 | if FChildren.TryGetValue(ALabelValues, Result) then 187 | Exit; 188 | Result := CreateChild; 189 | if not Assigned(Result) then 190 | Exit; 191 | try 192 | FChildren.Add(ALabelValues, Result); 193 | except 194 | FreeAndNil(Result); 195 | raise; 196 | end; 197 | finally 198 | TMonitor.Exit(FLock); 199 | end; 200 | end; 201 | 202 | procedure TSimpleCollector.Clear; 203 | begin 204 | TMonitor.Enter(FLock); 205 | try 206 | FChildren.Clear; 207 | InitializeNoLabelChildIfNeeded; 208 | finally 209 | TMonitor.Exit(FLock); 210 | end; 211 | end; 212 | 213 | procedure TSimpleCollector.Register(ARegistry: TCollectorRegistry); 214 | begin 215 | if not Assigned(ARegistry) then 216 | ARegistry := TCollectorRegistry.DefaultRegistry; 217 | ARegistry.&Register(Self); 218 | end; 219 | 220 | procedure TSimpleCollector.RemoveLabels(const ALabelValues: TLabelValues); 221 | begin 222 | TMonitor.Enter(FLock); 223 | try 224 | FChildren.Remove(ALabelValues); 225 | InitializeNoLabelChildIfNeeded; 226 | finally 227 | TMonitor.Exit(FLock); 228 | end; 229 | end; 230 | 231 | procedure TSimpleCollector.Unregister(ARegistry: TCollectorRegistry); 232 | begin 233 | if not Assigned(ARegistry) then 234 | ARegistry := TCollectorRegistry.DefaultRegistry; 235 | ARegistry.Unregister(Self); 236 | end; 237 | 238 | end. 239 | -------------------------------------------------------------------------------- /Tests/Fixtures/Prometheus.Tests.Fixtures.Collector.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Tests.Fixtures.Collector; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | 8 | type 9 | 10 | { TCollectorTestFixture } 11 | 12 | [TestFixture] 13 | TCollectorTestFixture = class 14 | strict private 15 | public 16 | [Setup] 17 | procedure Setup; 18 | [TearDown] 19 | procedure TearDown; 20 | [Test] 21 | procedure CollectorRegisterShouldUseDefaultRegistry; 22 | [Test] 23 | procedure CollectorMustSupportMoreRegistries; 24 | end; 25 | 26 | implementation 27 | 28 | uses 29 | Prometheus.Collector, 30 | Prometheus.Collectors.Counter, 31 | Prometheus.Registry; 32 | 33 | { TCollectorTestFixture } 34 | 35 | procedure TCollectorTestFixture.Setup; 36 | begin 37 | end; 38 | 39 | procedure TCollectorTestFixture.TearDown; 40 | begin 41 | end; 42 | 43 | procedure TCollectorTestFixture.CollectorMustSupportMoreRegistries; 44 | begin 45 | var LRegistry1 := TCollectorRegistry.Create(True); 46 | var LRegistry2 := TCollectorRegistry.Create(False); 47 | var LCollector := TCounter.Create('sample', 'sample collector'); 48 | LCollector.Register(LRegistry1); 49 | LCollector.Register(LRegistry2); 50 | Assert.IsTrue((LCollector = LRegistry1.GetCollector('sample')) 51 | and (LCollector = LRegistry2.GetCollector('sample'))); 52 | LRegistry1.Free; 53 | LRegistry2.Free; 54 | end; 55 | 56 | procedure TCollectorTestFixture.CollectorRegisterShouldUseDefaultRegistry; 57 | begin 58 | var LRegistry := TCollectorRegistry.DefaultRegistry; 59 | var LCollector := TCounter.Create('sample'); 60 | LCollector.Register(); 61 | Assert.AreEqual(LCollector, LRegistry.GetCollector('sample')); 62 | end; 63 | 64 | initialization 65 | 66 | TDUnitX.RegisterTestFixture(TCollectorTestFixture); 67 | 68 | end. 69 | -------------------------------------------------------------------------------- /Tests/Fixtures/Prometheus.Tests.Fixtures.Collectors.Counter.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Tests.Fixtures.Collectors.Counter; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | 8 | type 9 | 10 | { TCounterCollectorTestFixture } 11 | 12 | [TestFixture] 13 | TCounterCollectorTestFixture = class 14 | public 15 | [Test] 16 | procedure CounterMustStartAtZero; 17 | [Test] 18 | procedure CounterMustIncrementByOneAsDefault; 19 | [Test] 20 | procedure CounterMustIncrementBySpecifiedAmount; 21 | [Test] 22 | procedure CounterMustThrowExceptionIfAmountIsNegative; 23 | end; 24 | 25 | implementation 26 | 27 | uses 28 | System.SysUtils, 29 | Prometheus.Collectors.Counter; 30 | 31 | { TCounterCollectorTestFixture } 32 | 33 | procedure TCounterCollectorTestFixture.CounterMustIncrementByOneAsDefault; 34 | begin 35 | var LCounter := TCounter.Create('sample', 'sample counter'); 36 | try 37 | LCounter.Inc(); 38 | Assert.AreEqual(1, LCounter.Value, Double.Epsilon); 39 | finally 40 | LCounter.Free; 41 | end; 42 | end; 43 | 44 | procedure TCounterCollectorTestFixture.CounterMustIncrementBySpecifiedAmount; 45 | begin 46 | var LCounter := TCounter.Create('sample', 'sample counter'); 47 | try 48 | LCounter.Inc(123); 49 | Assert.AreEqual(123, LCounter.Value, Double.Epsilon); 50 | finally 51 | LCounter.Free; 52 | end; 53 | end; 54 | 55 | procedure TCounterCollectorTestFixture.CounterMustStartAtZero; 56 | begin 57 | var LCounter := TCounter.Create('sample', 'sample counter'); 58 | try 59 | Assert.AreEqual(0, LCounter.Value, Double.Epsilon); 60 | finally 61 | LCounter.Free; 62 | end; 63 | end; 64 | 65 | procedure TCounterCollectorTestFixture.CounterMustThrowExceptionIfAmountIsNegative; 66 | begin 67 | var LCounter := TCounter.Create('sample', 'sample counter'); 68 | try 69 | Assert.WillRaise( 70 | procedure 71 | begin 72 | LCounter.Inc(-1); 73 | end, EArgumentOutOfRangeException); 74 | finally 75 | LCounter.Free; 76 | end; 77 | end; 78 | 79 | initialization 80 | 81 | TDUnitX.RegisterTestFixture(TCounterCollectorTestFixture); 82 | 83 | end. 84 | -------------------------------------------------------------------------------- /Tests/Fixtures/Prometheus.Tests.Fixtures.Collectors.Gauge.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Tests.Fixtures.Collectors.Gauge; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | 8 | type 9 | 10 | { TGaugeCollectorTestFixture } 11 | 12 | [TestFixture] 13 | TGaugeCollectorTestFixture = class 14 | public 15 | [Test] 16 | procedure GaugeMustStartAtZero; 17 | [Test] 18 | procedure GaugeMustDecrementByOneAsDefault; 19 | [Test] 20 | procedure GaugeMustDecrementBySpecifiedAmount; 21 | [Test] 22 | procedure GaugeMustIncrementByOneAsDefault; 23 | [Test] 24 | procedure GaugeMustIncrementBySpecifiedAmount; 25 | [Test] 26 | procedure GaugeMustSetCurrentValue; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | System.SysUtils, 33 | Prometheus.Collectors.Gauge; 34 | 35 | { TGaugeCollectorTestFixture } 36 | 37 | procedure TGaugeCollectorTestFixture.GaugeMustStartAtZero; 38 | begin 39 | var LGauge := TGauge.Create('sample', 'sample gauge'); 40 | try 41 | Assert.AreEqual(0, LGauge.Value, Double.Epsilon); 42 | finally 43 | LGauge.Free; 44 | end; 45 | end; 46 | 47 | procedure TGaugeCollectorTestFixture.GaugeMustDecrementByOneAsDefault; 48 | begin 49 | var LGauge := TGauge.Create('sample', 'sample gauge'); 50 | try 51 | LGauge.Dec(); 52 | Assert.AreEqual(-1, LGauge.Value, Double.Epsilon); 53 | finally 54 | LGauge.Free; 55 | end; 56 | end; 57 | 58 | procedure TGaugeCollectorTestFixture.GaugeMustDecrementBySpecifiedAmount; 59 | begin 60 | var LGauge := TGauge.Create('sample', 'sample gauge'); 61 | try 62 | LGauge.Dec(123); 63 | Assert.AreEqual(-123, LGauge.Value, Double.Epsilon); 64 | finally 65 | LGauge.Free; 66 | end; 67 | end; 68 | 69 | procedure TGaugeCollectorTestFixture.GaugeMustIncrementByOneAsDefault; 70 | begin 71 | var LGauge := TGauge.Create('sample', 'sample gauge'); 72 | try 73 | LGauge.Inc(); 74 | Assert.AreEqual(1, LGauge.Value, Double.Epsilon); 75 | finally 76 | LGauge.Free; 77 | end; 78 | end; 79 | 80 | procedure TGaugeCollectorTestFixture.GaugeMustIncrementBySpecifiedAmount; 81 | begin 82 | var LGauge := TGauge.Create('sample', 'sample gauge'); 83 | try 84 | LGauge.Inc(123); 85 | Assert.AreEqual(123, LGauge.Value, Double.Epsilon); 86 | finally 87 | LGauge.Free; 88 | end; 89 | end; 90 | 91 | procedure TGaugeCollectorTestFixture.GaugeMustSetCurrentValue; 92 | begin 93 | var LGauge := TGauge.Create('sample', 'sample gauge'); 94 | try 95 | LGauge.SetTo(123); 96 | Assert.AreEqual(123, LGauge.Value, Double.Epsilon); 97 | finally 98 | LGauge.Free; 99 | end; 100 | end; 101 | 102 | initialization 103 | 104 | TDUnitX.RegisterTestFixture(TGaugeCollectorTestFixture); 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /Tests/Fixtures/Prometheus.Tests.Fixtures.Collectors.Histogram.pas: -------------------------------------------------------------------------------- 1 | unit Prometheus.Tests.Fixtures.Collectors.Histogram; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | 8 | type 9 | 10 | { THistogramCollectorTestFixture } 11 | 12 | [TestFixture] 13 | THistogramCollectorTestFixture = class 14 | public 15 | [Test] 16 | procedure HistogramBucketsMustBeSorted; 17 | [Test] 18 | procedure HistogramBucketsMustIncrementBySpecifiedAmount; 19 | [Test] 20 | procedure HistogramBucketsMustStartAtZero; 21 | [Test] 22 | procedure HistogramCountMustIncrementBySpecifiedAmount; 23 | [Test] 24 | procedure HistogramCountMustStartAtZero; 25 | [Test] 26 | procedure HistogramLabelMustThrowExceptionIfUseReservedName; 27 | [Test] 28 | procedure HistogramSumMustIncrementBySpecifiedAmount; 29 | [Test] 30 | procedure HistogramSumMustStartAtZero; 31 | end; 32 | 33 | implementation 34 | 35 | uses 36 | System.SysUtils, 37 | Prometheus.Collectors.Histogram; 38 | 39 | { THistogramCollectorTestFixture } 40 | 41 | procedure THistogramCollectorTestFixture.HistogramBucketsMustBeSorted; 42 | begin 43 | var LHistogram := THistogram.Create('Sample', '', [2, 0.5, 1]); 44 | try 45 | Assert.AreEqual(4, Length(LHistogram.Buckets)); 46 | Assert.AreEqual(0.5, LHistogram.Buckets[0], Double.Epsilon); 47 | Assert.AreEqual(1.0, LHistogram.Buckets[1], Double.Epsilon); 48 | Assert.AreEqual(2.0, LHistogram.Buckets[2], Double.Epsilon); 49 | Assert.AreEqual(INFINITE, LHistogram.Buckets[3], Double.Epsilon); 50 | finally 51 | LHistogram.Free; 52 | end; 53 | end; 54 | 55 | procedure THistogramCollectorTestFixture.HistogramBucketsMustIncrementBySpecifiedAmount; 56 | begin 57 | var LHistogram := THistogram.Create('Sample', '', [0.025, 0.05]); 58 | try 59 | LHistogram.Observe(0.01); 60 | LHistogram.Observe(0.04); 61 | LHistogram.Observe(0.05); 62 | LHistogram.Observe(1); 63 | 64 | var LMetricArray := LHistogram.Collect; 65 | Assert.AreEqual(1, Length( LMetricArray)); 66 | 67 | for var LMetric in LMetricArray do 68 | begin 69 | Assert.AreEqual('Sample', LMetric.MetricName); 70 | Assert.AreEqual(4, LMetric.MetricCount, 0); 71 | 72 | for var LSample in LMetric.Samples do 73 | begin 74 | Assert.AreEqual('Sample_bucket', LSample.MetricName); 75 | Assert.AreEqual('le', LSample.LabelNames[0]); 76 | if LSample.LabelValues[0] = '0.025' then 77 | Assert.AreEqual(1, LSample.Value, 0) 78 | else if LSample.LabelValues[0] = '0.05' then 79 | Assert.AreEqual(3, LSample.Value, 0) 80 | else if LSample.LabelValues[0] = '+Inf' then 81 | Assert.AreEqual(4, LSample.Value, 0); 82 | end; 83 | end; 84 | finally 85 | LHistogram.Free; 86 | end; 87 | end; 88 | 89 | procedure THistogramCollectorTestFixture.HistogramBucketsMustStartAtZero; 90 | begin 91 | var LHistogram := THistogram.Create('Sample', '', [0.025, 0.05]); 92 | try 93 | var LMetricArray := LHistogram.Collect; 94 | 95 | Assert.AreEqual(1, Length( LMetricArray)); 96 | for var LMetric in LMetricArray do 97 | begin 98 | Assert.AreEqual('Sample', LMetric.MetricName); 99 | Assert.AreEqual(0, LMetric.MetricCount, 0); 100 | for var LSample in LMetric.Samples do 101 | begin 102 | Assert.AreEqual('Sample_bucket', LSample.MetricName); 103 | Assert.AreEqual('le', LSample.LabelNames[0]); 104 | if LSample.LabelValues[0] = '0.025' then 105 | Assert.AreEqual(0, LSample.Value, 0); 106 | if LSample.LabelValues[0] = '0.05' then 107 | Assert.AreEqual(0, LSample.Value, 0); 108 | if LSample.LabelValues[0] = '+Inf' then 109 | Assert.AreEqual(0, LSample.Value, 0); 110 | end; 111 | end; 112 | finally 113 | LHistogram.Free; 114 | end; 115 | end; 116 | 117 | procedure THistogramCollectorTestFixture.HistogramCountMustIncrementBySpecifiedAmount; 118 | begin 119 | var LHistogram := THistogram.Create('Sample', '', [0.025, 0.05]); 120 | try 121 | LHistogram.Observe(0.01); 122 | LHistogram.Observe(0.04); 123 | LHistogram.Observe(1); 124 | Assert.AreEqual(3, LHistogram.Count, 0); 125 | finally 126 | LHistogram.Free; 127 | end; 128 | end; 129 | 130 | procedure THistogramCollectorTestFixture.HistogramCountMustStartAtZero; 131 | begin 132 | var LHistogram := THistogram.Create('Sample'); 133 | try 134 | Assert.AreEqual(0, LHistogram.Count, Double.Epsilon); 135 | finally 136 | LHistogram.Free; 137 | end; 138 | end; 139 | 140 | procedure THistogramCollectorTestFixture.HistogramLabelMustThrowExceptionIfUseReservedName; 141 | begin 142 | Assert.WillRaise( 143 | procedure 144 | begin 145 | THistogram.Create('Sample', '', [], ['le']); 146 | end, 147 | EInvalidOpException); 148 | end; 149 | 150 | procedure THistogramCollectorTestFixture.HistogramSumMustIncrementBySpecifiedAmount; 151 | begin 152 | var LHistogram := THistogram.Create('Sample', '', [0.025, 0.05]); 153 | try 154 | LHistogram.Observe(0.01); 155 | LHistogram.Observe(0.04); 156 | LHistogram.Observe(1); 157 | Assert.AreEqual(1.05, LHistogram.Sum ,0); 158 | finally 159 | LHistogram.Free; 160 | end; 161 | end; 162 | 163 | procedure THistogramCollectorTestFixture.HistogramSumMustStartAtZero; 164 | begin 165 | var LHistogram := THistogram.Create('Sample'); 166 | try 167 | Assert.AreEqual(0, LHistogram.Sum, Double.Epsilon); 168 | finally 169 | LHistogram.Free; 170 | end; 171 | end; 172 | 173 | initialization 174 | 175 | TDUnitX.RegisterTestFixture(THistogramCollectorTestFixture); 176 | 177 | end. 178 | -------------------------------------------------------------------------------- /Tests/Prometheus.Client.Tests.dpr: -------------------------------------------------------------------------------- 1 | program Prometheus.Client.Tests; 2 | 3 | {$IFNDEF TESTINSIGHT} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF} 6 | 7 | {$STRONGLINKTYPES ON} 8 | 9 | uses 10 | System.SysUtils, 11 | {$IFNDEF TESTINSIGHT} 12 | DUnitX.Loggers.Console, 13 | DUnitX.Loggers.Xml.NUnit, 14 | {$ELSE} 15 | TestInsight.DUnitX, 16 | {$ENDIF } 17 | DUnitX.TestFramework, 18 | Prometheus.Tests.Fixtures.Collector in 'Fixtures\Prometheus.Tests.Fixtures.Collector.pas', 19 | Prometheus.Tests.Fixtures.Collectors.Counter in 'Fixtures\Prometheus.Tests.Fixtures.Collectors.Counter.pas', 20 | Prometheus.Tests.Fixtures.Collectors.Gauge in 'Fixtures\Prometheus.Tests.Fixtures.Collectors.Gauge.pas', 21 | Prometheus.Tests.Fixtures.Collectors.Histogram in 'Fixtures\Prometheus.Tests.Fixtures.Collectors.Histogram.pas'; 22 | 23 | begin 24 | {$IFNDEF TESTINSIGHT} 25 | try 26 | ReportMemoryLeaksOnShutdown := True; 27 | 28 | // Check command line options, will exit if invalid. 29 | TDUnitX.CheckCommandLine; 30 | 31 | // Create the test runner. 32 | var LRunner: ITestRunner := TDUnitX.CreateRunner; 33 | 34 | // Tell the runner to use RTTI to find fixtures. 35 | LRunner.UseRTTI := True; 36 | 37 | // When true, Assertions must be made during tests. 38 | LRunner.FailsOnNoAsserts := False; 39 | 40 | // Tell the runner how we will log things. 41 | if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then 42 | begin 43 | var LLogger := TDUnitXConsoleLogger.Create( 44 | TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); 45 | LRunner.AddLogger(LLogger); 46 | end; 47 | 48 | // Generate an NUnit compatible XML File. 49 | var LXmlLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 50 | LRunner.AddLogger(LXmlLogger); 51 | 52 | // Run tests and collect results. 53 | var LResults := LRunner.Execute; 54 | if not LResults.AllPassed then 55 | System.ExitCode := EXIT_ERRORS; 56 | except 57 | on E: Exception do 58 | System.Writeln(E.ClassName, ': ', E.Message); 59 | end; 60 | {$IFNDEF CI} 61 | // We don't want this happening when running under CI. 62 | Writeln; 63 | Write('Done.. press key to quit.'); 64 | Readln; 65 | {$ENDIF} 66 | {$ELSE} 67 | TestInsight.DUnitX.RunRegisteredTests; 68 | {$ENDIF} 69 | end. 70 | -------------------------------------------------------------------------------- /Tests/Prometheus.Client.Tests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marcobreveglieri/prometheus-client-delphi/f3bb03adc4f9cf92ef7978f296943e40437a05b7/Tests/Prometheus.Client.Tests.res -------------------------------------------------------------------------------- /boss-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "hash": "d41d8cd98f00b204e9800998ecf8427e", 3 | "updated": "2023-03-23T15:46:06.176497+01:00", 4 | "installedModules": {} 5 | } -------------------------------------------------------------------------------- /boss.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "prometheus-client-delphi", 3 | "description": "Prometheus Client library for Embarcadero Delphi", 4 | "version": "0.9.1", 5 | "homepage": "https://www.breveglieri.it/progetti/prometheus-delphi-client", 6 | "mainsrc": "./Source", 7 | "projects": [], 8 | "dependencies": {} 9 | } --------------------------------------------------------------------------------