namespace Gitea.Declarative open System open System.IO open Newtonsoft.Json type MergeStyle = | Merge | Rebase | RebaseMerge | Squash static member Parse (s : string) : MergeStyle = if s = "merge" then MergeStyle.Merge elif s = "squash" then MergeStyle.Squash elif s = "rebase" then MergeStyle.Rebase elif s = "rebase-merge" then MergeStyle.RebaseMerge else failwithf "Unrecognised merge style '%s'" s static member toString (s : MergeStyle) : string = match s with | Merge -> "merge" | RebaseMerge -> "rebase-merge" | Rebase -> "rebase" | Squash -> "squash" type PushMirror = { GitHubAddress : Uri } static member OfSerialised (s : SerialisedPushMirror) : PushMirror = { GitHubAddress = Uri s.GitHubAddress } type NativeRepo = { DefaultBranch : string Private : bool option IgnoreWhitespaceConflicts : bool option HasPullRequests : bool option HasProjects : bool option HasIssues : bool option HasWiki : bool option DefaultMergeStyle : MergeStyle option DeleteBranchAfterMerge : bool option AllowSquashMerge : bool option AllowRebaseUpdate : bool option AllowRebase : bool option AllowRebaseExplicit : bool option AllowMergeCommits : bool option Mirror : PushMirror option } static member Default : NativeRepo = { DefaultBranch = "main" Private = Some false IgnoreWhitespaceConflicts = Some true HasPullRequests = Some true HasProjects = Some false HasIssues = Some true HasWiki = Some false DefaultMergeStyle = Some MergeStyle.Rebase DeleteBranchAfterMerge = Some true AllowSquashMerge = Some true AllowRebaseUpdate = Some false AllowRebase = Some false AllowRebaseExplicit = Some false AllowMergeCommits = Some false Mirror = None } member this.OverrideDefaults () = { DefaultBranch = this.DefaultBranch Private = this.Private |> Option.orElse NativeRepo.Default.Private IgnoreWhitespaceConflicts = this.IgnoreWhitespaceConflicts |> Option.orElse NativeRepo.Default.IgnoreWhitespaceConflicts HasPullRequests = this.HasPullRequests |> Option.orElse NativeRepo.Default.HasPullRequests HasProjects = this.HasProjects |> Option.orElse NativeRepo.Default.HasProjects HasIssues = this.HasIssues |> Option.orElse NativeRepo.Default.HasIssues HasWiki = this.HasWiki |> Option.orElse NativeRepo.Default.HasWiki DefaultMergeStyle = this.DefaultMergeStyle |> Option.orElse NativeRepo.Default.DefaultMergeStyle DeleteBranchAfterMerge = this.DeleteBranchAfterMerge |> Option.orElse NativeRepo.Default.DeleteBranchAfterMerge AllowSquashMerge = this.AllowSquashMerge |> Option.orElse NativeRepo.Default.AllowSquashMerge AllowRebaseUpdate = this.AllowRebaseUpdate |> Option.orElse NativeRepo.Default.AllowRebaseUpdate AllowRebase = this.AllowRebase |> Option.orElse NativeRepo.Default.AllowRebase AllowRebaseExplicit = this.AllowRebaseExplicit |> Option.orElse NativeRepo.Default.AllowRebaseExplicit AllowMergeCommits = this.AllowMergeCommits |> Option.orElse NativeRepo.Default.AllowMergeCommits Mirror = this.Mirror } static member internal OfSerialised (s : SerialisedNativeRepo) = { NativeRepo.DefaultBranch = s.DefaultBranch Private = s.Private |> Option.ofNullable IgnoreWhitespaceConflicts = s.IgnoreWhitespaceConflicts |> Option.ofNullable HasPullRequests = s.HasPullRequests |> Option.ofNullable HasProjects = s.HasProjects |> Option.ofNullable HasIssues = s.HasIssues |> Option.ofNullable HasWiki = s.HasWiki |> Option.ofNullable DefaultMergeStyle = s.DefaultMergeStyle |> Option.ofObj |> Option.map MergeStyle.Parse DeleteBranchAfterMerge = s.DeleteBranchAfterMerge |> Option.ofNullable AllowSquashMerge = s.AllowSquashMerge |> Option.ofNullable AllowRebaseUpdate = s.AllowRebaseUpdate |> Option.ofNullable AllowRebase = s.AllowRebase |> Option.ofNullable AllowRebaseExplicit = s.AllowRebaseExplicit |> Option.ofNullable AllowMergeCommits = s.AllowMergeCommits |> Option.ofNullable Mirror = s.Mirror |> Option.ofNullable |> Option.map PushMirror.OfSerialised } type GitHubRepo = { Uri : Uri /// This is a Golang string. MirrorInterval : string } static member internal OfSerialised (s : SerialisedGitHubRepo) : GitHubRepo = { Uri = Uri s.Uri MirrorInterval = // Rather odd behaviour of the API here! if s.MirrorInterval = null then "8h0m0s" else s.MirrorInterval } type Repo = { Description : string GitHub : GitHubRepo option Native : NativeRepo option } member this.OverrideDefaults () = { this with Native = this.Native |> Option.map (fun s -> s.OverrideDefaults ()) } static member Render (client : Gitea.Client) (u : Gitea.Repository) : Repo Async = if not (String.IsNullOrEmpty u.OriginalUrl) then { Description = u.Description GitHub = { Uri = Uri u.OriginalUrl MirrorInterval = u.MirrorInterval } |> Some Native = None } |> async.Return else async { let! mirror = getAllPushMirrors client u.Owner.LoginName u.FullName let mirror = if mirror.Length = 0 then None elif mirror.Length = 1 then Some mirror.[0] else failwith "Multiple mirrors not supported yet" return { Description = u.Description GitHub = None Native = { Private = u.Private DefaultBranch = u.DefaultBranch IgnoreWhitespaceConflicts = u.IgnoreWhitespaceConflicts HasPullRequests = u.HasPullRequests HasProjects = u.HasProjects HasIssues = u.HasIssues HasWiki = u.HasWiki DefaultMergeStyle = u.DefaultMergeStyle |> Option.ofObj |> Option.map MergeStyle.Parse DeleteBranchAfterMerge = u.DefaultDeleteBranchAfterMerge AllowSquashMerge = u.AllowSquashMerge AllowRebaseUpdate = u.AllowRebaseUpdate AllowRebase = u.AllowRebase AllowRebaseExplicit = u.AllowRebaseExplicit AllowMergeCommits = u.AllowMergeCommits Mirror = mirror |> Option.map (fun m -> { GitHubAddress = Uri m.RemoteAddress } ) } |> Some } } static member internal OfSerialised (s : SerialisedRepo) = { Repo.Description = s.Description GitHub = Option.ofNullable s.GitHub |> Option.map GitHubRepo.OfSerialised Native = s.Native |> Option.ofNullable |> Option.map NativeRepo.OfSerialised } type UserInfoUpdate = | Admin of desired : bool option * actual : bool option | Email of desired : string * actual : string | Website of desired : Uri * actual : Uri option | Visibility of desired : string * actual : string option type UserInfo = { IsAdmin : bool option Email : string Website : Uri option Visibility : string option } static member Render (u : Gitea.User) : UserInfo = { IsAdmin = u.IsAdmin Email = u.Email Website = if String.IsNullOrEmpty u.Website then None else Some (Uri u.Website) Visibility = if String.IsNullOrEmpty u.Visibility then None else Some u.Visibility } static member internal OfSerialised (s : SerialisedUserInfo) = { UserInfo.IsAdmin = s.IsAdmin |> Option.ofNullable Email = s.Email Website = Option.ofObj s.Website Visibility = Option.ofObj s.Visibility } static member Resolve (desired : UserInfo) (actual : UserInfo) : UserInfoUpdate list = [ if desired.IsAdmin <> actual.IsAdmin then yield UserInfoUpdate.Admin (desired.IsAdmin, actual.IsAdmin) if desired.Email <> actual.Email then yield UserInfoUpdate.Email (desired.Email, actual.Email) if desired.Website <> actual.Website then match desired.Website with | Some w -> yield UserInfoUpdate.Website (w, actual.Website) | None -> () if desired.Visibility <> actual.Visibility then match desired.Visibility with | Some v -> yield UserInfoUpdate.Visibility (v, actual.Visibility) | None -> () ] type GiteaConfig = { Users : Map Repos : Map> } static member internal OfSerialised (s : SerialisedGiteaConfig) = { GiteaConfig.Users = s.Users |> Seq.map (fun (KeyValue (user, info)) -> user, UserInfo.OfSerialised info) |> Map.ofSeq Repos = s.Repos |> Seq.map (fun (KeyValue (user, repos)) -> let repos = repos |> Seq.map (fun (KeyValue (repoName, repo)) -> repoName, Repo.OfSerialised repo) |> Map.ofSeq user, repos ) |> Map.ofSeq } [] module GiteaConfig = let get (file : FileInfo) : GiteaConfig = let s = use reader = new StreamReader (file.OpenRead ()) reader.ReadToEnd () JsonConvert.DeserializeObject s |> GiteaConfig.OfSerialised