bparodi/Bidello
1
Fork 0
Code Issues 8 Pull requests Projects Releases Packages Wiki Activity Actions

wrap in try catch

Browse source
This commit is contained in:
bparodi@lezzo.org 2024-12-13 11:53:13 +01:00
parent b146b64fcf
commit 2b362745e2
8 changed files with 123 additions and 285 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/Cron.fs
View file

@ -6,10 +6,6 @@ open Cronos
open Pentole
open Datatypes
open Pentole.String
open Pentole.Map
open Pentole
type PatternType = After of string
type WhenExpr = | Cron of Instant | Pattern of PatternType

51
src/Grains.fs
View file

@ -5,27 +5,42 @@ open System.Threading
open System.Threading.Tasks
open NodaTime
open System
open Serilog.Events
open Bidello.Datatypes
open Bidello.Shell
let try_ (lambda: (unit -> ValueTask)) (prefix: string) (level: LogEventLevel) =
try
lambda ()
with exn ->
let logger = Logging.logger
let msg = sprintf "%s - %s" prefix exn.Message
match level with
| LogEventLevel.Verbose -> logger.Debug msg
| LogEventLevel.Debug -> logger.Debug msg
| LogEventLevel.Information -> logger.Information msg
| LogEventLevel.Warning -> logger.Warning msg
| LogEventLevel.Error -> logger.Error msg
| LogEventLevel.Fatal -> logger.Fatal msg
| _ -> logger.Fatal msg
ValueTask ()
type IShellGrain =
inherit IGrainWithIntegerKey
abstract schedule: CancellationToken -> ChainOfJobs -> ValueTask
type IDbGrain =
inherit IGrainWithGuidKey
abstract save_backlog: CancellationToken -> Instant * Instant -> CronJob -> RunResult -> ValueTask
type DbGrain () =
inherit Orleans.Grain ()
interface IDbGrain with
override _.save_backlog ct (start_, end_) (job: CronJob) rc =
try
member _.save_backlog_ ct (start_: Instant, end_: Instant) (job: CronJob) rc =
let stdout = match rc with | Success stdout -> Some stdout | _ -> None
let code, stderr =
@ -67,16 +82,13 @@ type DbGrain () =
}
tsk |> Async.StartAsTask |> ValueTask
with exn -> printfn "%A" exn; ValueTask ()
interface IDbGrain with
override x.save_backlog ct (start_, end_) (job: CronJob) rc =
let lambda = fun () ->
x.save_backlog_ ct (start_, end_) job rc
try_ lambda "DatabaseGrain" LogEventLevel.Fatal
type ShellGrain() =
inherit Orleans.Grain ()
interface IShellGrain with
member x.schedule (ct) (jobs: ChainOfJobs) =
let db_actor = x.GrainFactory.GetGrain<IDbGrain>(Guid.NewGuid())
let log (job: CronJob) = function
| Success _stdout ->
@ -98,6 +110,13 @@ type ShellGrain() =
$"Action: {job.info_string()}, failed because insufficient permissions to run command as user"
|> Logging.logger.Fatal
type ShellGrain() =
inherit Orleans.Grain ()
member x.schedule_ (ct) (jobs: ChainOfJobs) =
let db_actor = x.GrainFactory.GetGrain<IDbGrain>(Guid.NewGuid())
let rec run_ (hd: CronJob) (tl: CronJob list) = async {
let start_time = SystemClock.Instance.GetCurrentInstant ()
let! rc = run_job ct hd |> Async.AwaitTask
@ -118,4 +137,8 @@ type ShellGrain() =
Async.StartAsTask (tsk, TaskCreationOptions.None, ct)
|> ValueTask)
|> Option.defaultValue (ValueTask ())
(*TODO: try block?*)
interface IShellGrain with
member x.schedule (ct) (jobs: ChainOfJobs) =
let lambda = fun () -> x.schedule_ ct jobs
try_ lambda "ShellGrain" LogEventLevel.Error

118
src/LoggingHelpers.fs
View file

@ -1,118 +0,0 @@
module Pentole.LoggingHelpers
open System
open Serilog
open Serilog.Events
open Serilog.Sinks.SystemConsole.Themes
open Serilog.Sinks.File
type Override =
| Verbose of string
| Debug of string
| Information of string
| Warning of string
| Error of string
| Fatal of string
type Buffered = Yes | No
type Shared = Yes | No
type RollOnSizeLimit = Yes | No
type FileConfiguration = {
path: string
level: LogEventLevel
template: string
format_provider: System.IFormatProvider
file_size_bytes_limit: uint64
level_switch: Core.LoggingLevelSwitch option
buffered: Buffered
shared: Shared
flush_interval: TimeSpan option
rolling_interval: RollingInterval
roll_on_size_limit: RollOnSizeLimit
retained_files: uint
lifecycle_hooks: FileLifecycleHooks option
}
type Configuration = {
theme: SystemConsoleTheme
overrides: Override list
template: string
files: FileConfiguration list
}
let from_config (c: Configuration) =
let override_ (lc: LoggerConfiguration) = function
| Verbose namespace_ ->
lc.MinimumLevel.Override (namespace_, LogEventLevel.Verbose)
| Debug namespace_ ->
lc.MinimumLevel.Override (namespace_, LogEventLevel.Debug)
| Information namespace_ ->
lc.MinimumLevel.Override (namespace_, LogEventLevel.Information)
| Warning namespace_ ->
lc.MinimumLevel.Override (namespace_, LogEventLevel.Warning)
| Error namespace_ ->
lc.MinimumLevel.Override (namespace_, LogEventLevel.Error)
| Fatal namespace_ ->
lc.MinimumLevel.Override (namespace_, LogEventLevel.Fatal)
let lc =
c.overrides
|> List.fold (fun lc target -> override_ lc target) (LoggerConfiguration())
let null_or = function | Some a -> a | None -> null
let buffered = function | Buffered.Yes -> true | Buffered.No -> false
let shared = function | Shared.Yes -> true | Shared.No -> false
let roll = function | RollOnSizeLimit.Yes -> true | RollOnSizeLimit.No -> false
let flush_interval = function Some ts -> Nullable ts | None -> Nullable<TimeSpan> ()
let lc =
c.files
|> List.fold (fun (lc: LoggerConfiguration) (fc: FileConfiguration) ->
lc.WriteTo.File(
path = fc.path,
restrictedToMinimumLevel = fc.level,
outputTemplate = fc.template,
formatProvider = fc.format_provider,
fileSizeLimitBytes = Nullable (int64 fc.file_size_bytes_limit),
levelSwitch = null_or fc.level_switch,
buffered = buffered fc.buffered,
shared = shared fc.shared,
flushToDiskInterval = flush_interval fc.flush_interval,
rollingInterval = fc.rolling_interval,
rollOnFileSizeLimit = roll fc.roll_on_size_limit,
retainedFileCountLimit = Nullable (int fc.retained_files),
encoding = System.Text.Encoding.UTF8,
hooks = null_or fc.lifecycle_hooks,
retainedFileTimeLimit = TimeSpan.Zero))
lc
lc
.WriteTo.Console(theme=c.theme, outputTemplate=c.template)
.CreateLogger()
module Default =
let retained_files = 31 (* one month *)
let file_size_bytes = 1 * 1024 * 1024 * 1024 (* 1GB *)
let size_limit = 1 * 1024 * 1024 * 1024 (* 1GB *)
let template = "{Timestamp:yyyy-MM-dd HH:mm:ss.fff zzz} [{Level:u3}] {Message:lj}{NewLine}{Exception}";
let debug_template = "[{Timestamp:HH:mm:ss} {Level:u3}] |{SourceContext}| {Message:lj}{NewLine}{Exception}"
let theme = Serilog.Sinks.SystemConsole.Themes.SystemConsoleTheme.Literate
let overrides = [
Warning "Orleans.Runtime"
Warning "Orleans.Hosting"
Warning "Microsoft"
// Warning "Microsoft.AspNetCore"
// Warning "Microsoft.AspNetCore.Hosting"
// Warning "Microsoft.AspNetCore.Mvc"
// Warning "Microsoft.AspNetCore.Routing"
// Warning "Orleans.Runtime.Silo"
// Warning "Orleans.Runtime.SiloOptionsLogger"
// Warning "Orleans.Runtime.SiloHostedService"
]

50
src/Result.fs
View file

@ -1,50 +0,0 @@
namespace Pentole
module Result =
let inline protect ([<InlineIfLambda>]f) x =
try
Ok (f x)
with e -> Error e
let inline pairwise_map fun_ (x: 'a, y: 'a) =
match fun_ x with
| Error e -> Error e
| Ok o ->
match fun_ y with | Ok o' -> Ok (o, o') | Error e -> Error e
let of_option = function | Some s -> Ok s | None -> Error ()
let zip a b =
match (a, b) with
| Ok a, Ok b -> Ok (a, b)
| Error e, _ -> Error e
| _, Error e -> Error e
let inline get r =
match r with
| Ok o -> o
| Error e ->
$"Tried to access value from Result r, error={e}"
|> System.ArgumentException
|> raise
type ToStringWrapper(toString) =
override _.ToString() = toString ()
let Result l = ToStringWrapper(fun _ ->
match l with
| Ok o -> sprintf "Ok %O" o
| _ -> failwith "")
module ResultList =
let collect (lambda: 'a -> Result<'ok, 'err>) (seq_: 'a seq) =
let rec iter_ acc seq_ =
match Seq.tryHead seq_ with
| None -> Ok acc
| Some x ->
match lambda x with
| Error e -> Error e
| Ok o -> iter_ (o::acc) (Seq.tail seq_)
iter_ [] seq_

7
src/String.fs
View file

@ -1,7 +0,0 @@
module Pentole.String
let (|Prefix|_|) (p: string) (s: string) =
if s.StartsWith p then
s.Substring p.Length |> Some
else
None

5
src/src.fsproj
View file

@ -8,11 +8,8 @@
<ItemGroup>
<Compile Include="Environment.fs" />
<Compile Include="LoggingHelpers.fs" />
<Compile Include="Map.fs" />
<Compile Include="Seq.fs" />
<Compile Include="Result.fs" />
<Compile Include="String.fs" />
<Compile Include="Datatypes.fs" />
<Compile Include="Logging.fs" />
<Compile Include="Shell.fs" />
@ -38,7 +35,7 @@
<PackageReference Include="Microsoft.Orleans.Streaming" Version="8.2.0" />
<PackageReference Include="NodaTime" Version="3.2.0" />
<PackageReference Include="Npgsql" Version="8.0.5" />
<PackageReference Include="Pentole" Version="0.0.4" />
<PackageReference Include="Pentole" Version="0.0.6" />
<PackageReference Include="Serilog.Extensions.Hosting" Version="8.0.0" />
<PackageReference Include="Serilog.Sinks.Console" Version="6.0.0" />
<PackageReference Include="Serilog.Sinks.File" Version="6.0.0" />

21
tests/UnitTest1.fs
View file

@ -1,12 +1,10 @@
module tests
open NUnit.Framework
open Pentole.TestsExtensions
open Pentole
open Bidello.Datatypes
open Bidello
open Pentole.String
let now = NodaTime.SystemClock.Instance.GetCurrentInstant ()
[<Test>]
@ -34,7 +32,7 @@ let run_function x =
Cron.sort_jobs now x
|> Result.map (List.map reduce)
|> Pentole.Result.get
|> Result.Unsafe.get
[<Test>]
let job_deps_simple () =
@ -46,7 +44,7 @@ let job_deps_simple () =
let expected = [[("h1", "j1")]]
setEqual expected cjs
Assert.setEqual expected cjs
[<Test>]
let job_deps () =
@ -61,7 +59,7 @@ let job_deps () =
let cjs = run_function requirements
let expected = [[("h1", "j1"); ("h1", "j1_after")]; [("h2", "j1")]; [("h1", "j2")]]
setEqual expected cjs
Assert.setEqual expected cjs
[<Test>]
let job_deps2 () =
@ -79,7 +77,7 @@ let job_deps2 () =
let expected = [[("h1", "j1"); ("h1", "j1_after")];
[("h1", "j2"); ("h1", "j2_after")];
[("h2", "j1")]]
setEqual expected cjs
Assert.setEqual expected cjs
[<Test>]
let should_fail_no_host () =
@ -95,7 +93,7 @@ let should_fail_no_host () =
Cron.sort_jobs now requirements
|> Result.isError
|> isTrue
|> Assert.isTrue
[<Test>]
let job_deps_chain0 () =
@ -108,11 +106,10 @@ let job_deps_chain0 () =
]
let cjs = run_function requirements
printfn "GOT: %A" cjs
let expected = [[("h1", "j1"); ("h1", "j2_after_j1"); ("h1", "j3_after_j2")];
[("h2", "j1")]]
setEqual expected cjs
Assert.setEqual expected cjs
[<Test>]
let job_deps_chain1 () =
@ -131,7 +128,7 @@ let job_deps_chain1 () =
("h1", "j2_after_j1"); ("h1", "j3_after_j2")];
[("h2", "j1")]]
setEqual expected cjs
Assert.setEqual expected cjs
[<Test>]
let job_deps_chain_failure () =
@ -142,4 +139,4 @@ let job_deps_chain_failure () =
Cron.sort_jobs now requirements
|> Result.isError
|> isTrue
|> Assert.isTrue

2
tests/tests.fsproj
View file

@ -19,7 +19,7 @@
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0" />
<PackageReference Include="NUnit.Analyzers" Version="3.6.1" />
<PackageReference Include="coverlet.collector" Version="6.0.0" />
<PackageReference Include="Pentole" Version="0.0.4" />
<PackageReference Include="Pentole" Version="0.0.6" />
</ItemGroup>
<ItemGroup>