Initial commit

.config/dotnet-tools.json

@@ -0,0 +1,12 @@
+{
+  "version": 1,
+  "isRoot": true,
+  "tools": {
+    "fantomas": {
+      "version": "5.2.0-alpha-008",
+      "commands": [
+        "fantomas"
+      ]
+    }
+  }
+}

.editorconfig

@@ -0,0 +1,41 @@
+root=true
+
+[*]
+charset=utf-8
+end_of_line=crlf
+trim_trailing_whitespace=true
+insert_final_newline=true
+indent_style=space
+indent_size=4
+
+# ReSharper properties
+resharper_xml_indent_size=2
+resharper_xml_max_line_length=100
+resharper_xml_tab_width=2
+
+[*.{csproj,fsproj,sqlproj,targets,props,ts,tsx,css,json}]
+indent_style=space
+indent_size=2
+
+[*.{fs,fsi}]
+fsharp_bar_before_discriminated_union_declaration=true
+fsharp_space_before_uppercase_invocation=true
+fsharp_space_before_class_constructor=true
+fsharp_space_before_member=true
+fsharp_space_before_colon=true
+fsharp_space_before_semicolon=true
+fsharp_multiline_block_brackets_on_same_column=true
+fsharp_newline_between_type_definition_and_members=true
+fsharp_align_function_signature_to_indentation=true
+fsharp_alternative_long_member_definitions=true
+fsharp_multi_line_lambda_closing_newline=true
+fsharp_experimental_keep_indent_in_branch=true
+fsharp_max_value_binding_width=80
+fsharp_max_record_width=0
+max_line_length=120
+end_of_line=lf
+
+[*.{appxmanifest,build,dtd,nuspec,xaml,xamlx,xoml,xsd}]
+indent_style=space
+indent_size=2
+tab_width=2

.gitattributes

@@ -0,0 +1 @@
+* eol=auto

.gitignore

@@ -0,0 +1,9 @@
+bin/
+obj/
+/packages/
+riderModule.iml
+/_ReSharper.Caches/
+.idea/
+*.user
+*.DotSettings
+.DS_Store

Gitea.App/Gitea.App.fsproj

@@ -0,0 +1,20 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <OutputType>Exe</OutputType>
+        <TargetFramework>net7.0</TargetFramework>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="Program.fs" />
+    </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="..\Gitea\Gitea.fsproj" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Microsoft.Extensions.Logging.Console" Version="7.0.0" />
+  </ItemGroup>
+
+</Project>

Gitea.App/Program.fs

@@ -0,0 +1,183 @@
+namespace Gitea
+
+open System
+open System.IO
+open System.Net.Http
+open Microsoft.Extensions.Logging
+open Microsoft.Extensions.Logging.Console
+open Microsoft.Extensions.Options
+
+module Program =
+
+    let printUserErrors (m : Map<User, AlignmentError<UserInfo>>) =
+        m |> Map.iter (fun (User u) err -> printfn $"%s{u}: {err}")
+
+    let printRepoErrors (m : Map<User, Map<RepoName, AlignmentError<Repo>>>) =
+        m
+        |> Map.iter (fun (User u) errMap -> errMap |> Map.iter (fun (RepoName r) err -> printfn $"%s{u}: %s{r}: {err}"))
+
+    let rec getUserInputDefaultNo (getUserInput : unit -> string) (message : string) : bool =
+        Console.Write $"${message} (y/N): "
+        let answer = getUserInput ()
+
+        match answer with
+        | "y"
+        | "Y" -> true
+        | "n"
+        | "N"
+        | "" -> false
+        | _ -> getUserInputDefaultNo getUserInput message
+
+    let reconcileUserErrors
+        (log : ILogger)
+        (getUserInput : unit -> string)
+        (client : Gitea.Client)
+        (m : Map<User, AlignmentError<UserInfo>>)
+        =
+        let userInputLock = obj ()
+
+        m
+        |> Map.toSeq
+        |> Seq.map (fun (User user, err) ->
+            match err with
+            | AlignmentError.DoesNotExist desired ->
+                async {
+                    let rand = Random ()
+
+                    let pwd =
+                        Array.init 15 (fun _ -> rand.Next (65, 65 + 25) |> byte)
+                        |> System.Text.Encoding.ASCII.GetString
+
+                    let options = Gitea.CreateUserOption ()
+                    options.Email <- desired.Email
+                    options.Username <- user
+                    options.FullName <- user
+
+                    options.Visibility <-
+                        match desired.Visibility with
+                        | None -> "public"
+                        | Some v -> v
+
+                    options.LoginName <- user
+                    options.MustChangePassword <- Some true
+                    options.Password <- pwd
+                    let! _ = client.AdminCreateUser options |> Async.AwaitTask
+
+                    lock
+                        userInputLock
+                        (fun () ->
+                            log.LogCritical (
+                                "Created user {User} with password {Password}, which you must now change",
+                                user,
+                                pwd
+                            )
+                        )
+
+                    return ()
+                }
+            | AlignmentError.UnexpectedlyPresent ->
+                async {
+                    lock
+                        userInputLock
+                        (fun () ->
+                            let answer =
+                                getUserInputDefaultNo getUserInput $"User %s{user} unexpectedly present. Remove?"
+
+                            if answer then
+                                client.AdminDeleteUser(user).Result
+                            else
+                                log.LogCritical ("Refusing to delete user {User}, who is unexpectedly present.", user)
+                        )
+                }
+            | AlignmentError.ConfigurationDiffers (desired, actual) ->
+                let updates = UserInfo.Resolve desired actual
+
+                async {
+                    lock
+                        userInputLock
+                        (fun () ->
+                            let body = Gitea.EditUserOption ()
+
+                            for update in updates do
+                                match update with
+                                | UserInfoUpdate.Admin (desired, _) -> body.Admin <- desired
+                                | UserInfoUpdate.Email (desired, _) -> body.Email <- desired
+                                | UserInfoUpdate.Visibility (desired, _) -> body.Visibility <- desired
+                                | UserInfoUpdate.Website (desired, actual) ->
+                                    // Per https://github.com/go-gitea/gitea/issues/17126,
+                                    // the website parameter can't currently be edited.
+                                    // This is a bug that is unlikely to be fixed.
+                                    let actual =
+                                        match actual with
+                                        | None -> "<no website>"
+                                        | Some uri -> uri.ToString ()
+
+                                    log.LogCritical (
+                                        "User {User} has conflicting website, desired {DesiredWebsite}, existing {ActualWebsite}, which a bug in Gitea means can't be reconciled via the API.",
+                                        user,
+                                        desired,
+                                        actual
+                                    )
+
+                            body.LoginName <- user
+                            client.AdminEditUser(user, body).Result |> ignore
+                        )
+                }
+        )
+        |> Async.Parallel
+        |> fun a -> async.Bind (a, Array.iter id >> async.Return)
+
+    [<EntryPoint>]
+    let main argv =
+        let configFile, giteaApiToken, githubApiToken =
+            match argv with
+            | [| f ; giteaToken |] -> FileInfo f, giteaToken, None
+            | [| f ; giteaToken ; githubToken |] -> FileInfo f, giteaToken, Some githubToken
+            | _ -> failwithf $"malformed args: %+A{argv}"
+
+        let config = GiteaConfig.get configFile
+
+        let options =
+            let options = ConsoleLoggerOptions ()
+
+            { new IOptionsMonitor<ConsoleLoggerOptions> with
+                member _.Get _ = options
+                member _.CurrentValue = options
+
+                member _.OnChange _ =
+                    { new IDisposable with
+                        member _.Dispose () = ()
+                    }
+            }
+
+        use loggerProvider = new ConsoleLoggerProvider (options)
+        let logger = loggerProvider.CreateLogger "Gitea.App"
+
+        use client = new HttpClient ()
+        client.BaseAddress <- Uri Host
+        client.DefaultRequestHeaders.Add ("Authorization", $"token {giteaApiToken}")
+
+        let client = Gitea.Client client
+
+        task {
+            Console.WriteLine "Checking users..."
+            let! userErrors = Gitea.checkUsers config client
+
+            match userErrors with
+            | Ok () -> ()
+            | Error errors -> do! reconcileUserErrors logger Console.ReadLine client errors
+
+            Console.WriteLine "Checking repos..."
+            let! repoErrors = Gitea.checkRepos config client
+
+            match repoErrors with
+            | Ok () -> ()
+            | Error errors -> do! Gitea.reconcileRepoErrors logger client githubApiToken errors
+
+            match userErrors, repoErrors with
+            | Ok (), Ok () -> return 0
+            | Ok (), Error _ -> return 1
+            | Error _, Ok () -> return 2
+            | Error _, Error _ -> return 3
+        }
+        |> fun t -> t.Result

Gitea.Test/Gitea.Test.fsproj

@@ -0,0 +1,27 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <TargetFramework>net7.0</TargetFramework>
+    <IsPackable>false</IsPackable>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="TestJsonSchema.fs" />
+    <Content Include="GiteaConfig.json" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="FsUnit" Version="5.1.0" />
+    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.3.2" />
+    <PackageReference Include="Newtonsoft.Json.Schema" Version="3.0.14" />
+    <PackageReference Include="NUnit" Version="3.13.3" />
+    <PackageReference Include="NUnit3TestAdapter" Version="4.2.1" />
+    <PackageReference Include="NUnit.Analyzers" Version="3.3.0" />
+    <PackageReference Include="coverlet.collector" Version="3.1.2" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="..\Gitea\Gitea.fsproj" />
+  </ItemGroup>
+
+</Project>

Gitea.Test/GiteaConfig.json

@@ -0,0 +1,34 @@
+{
+  "users": {
+    "admin": {
+      "isAdmin": true,
+      "email": "some-admin-email@example.com",
+      "visibility": "private"
+    },
+    "nonadmin-user": {
+      "isAdmin": false,
+      "email": "some-nonadmin-email@example.com",
+      "website": "https://example.com",
+      "visibility": "public"
+    }
+  },
+  "repos": {
+    "nonadmin-user": {
+      "synced-from-github-repo-1": {
+        "description": "A repo that is imported from GitHub",
+        "gitHub": "https://github.com/MyName/repo-name"
+      },
+      "synced-from-github-repo-2": {
+        "description": "Another repo that is imported from GitHub",
+        "gitHub": "https://github.com/MyName/repo-name-2"
+      },
+      "new-repo": {
+        "description": "A repo that's created directly on this Gitea",
+        "native": {
+          "defaultBranch": "main",
+          "private": false
+        }
+      }
+    }
+  }
+}

Gitea.Test/TestJsonSchema.fs

@@ -0,0 +1,91 @@
+namespace Gitea.Test
+
+open System.IO
+open System.Reflection
+open Gitea
+open NUnit.Framework
+open FsUnitTyped
+open Newtonsoft.Json
+open Newtonsoft.Json.Schema
+open Newtonsoft.Json.Schema.Generation
+open Newtonsoft.Json.Serialization
+
+[<TestFixture>]
+module TestSchema =
+    let schemaGen = JSchemaGenerator ()
+    schemaGen.ContractResolver <- CamelCasePropertyNamesContractResolver ()
+
+    let rec findFileAbove (fileName : string) (di : DirectoryInfo) =
+        if isNull di then
+            failwith "hit the root without finding anything"
+
+        let candidate =
+            Path.Combine (di.FullName, fileName) |> FileInfo
+
+        if candidate.Exists then
+            candidate
+        else
+            findFileAbove fileName di.Parent
+
+    let rec findExampleFile (di : DirectoryInfo) =
+        if isNull di then
+            failwith "hit the root without finding anything"
+
+        let candidate =
+            Path.Combine (di.FullName, "GiteaConfig.json") |> FileInfo
+
+        if candidate.Exists then
+            candidate
+        else
+            findExampleFile di.Parent
+
+    [<Test>]
+    let ``Schema is consistent`` () =
+        let schemaFile =
+            Assembly.GetExecutingAssembly().Location
+            |> FileInfo
+            |> fun fi -> fi.Directory
+            |> findFileAbove "Gitea/GiteaConfig.schema.json"
+
+        let existing = JSchema.Parse (File.ReadAllText schemaFile.FullName)
+        let derived = schemaGen.Generate typeof<SerialisedGiteaConfig>
+
+        existing.ToString () |> shouldEqual (derived.ToString ())
+
+    [<Test>]
+    let ``Example conforms to schema`` () =
+        let executing =
+            Assembly.GetExecutingAssembly().Location
+            |> FileInfo
+        let schemaFile = findFileAbove "GiteaConfig.json" executing.Directory
+
+        let existing = JSchema.Parse (File.ReadAllText schemaFile.FullName)
+
+        let jsonFile = findExampleFile executing.Directory
+        let json = File.ReadAllText jsonFile.FullName
+
+        use reader = new JsonTextReader (new StringReader (json))
+        use validatingReader = new JSchemaValidatingReader (reader)
+        validatingReader.Schema <- existing
+
+        let messages = ResizeArray ()
+        validatingReader.ValidationEventHandler.Add (fun args -> messages.Add args.Message)
+
+        let ser = JsonSerializer ()
+        ser.ContractResolver <- CamelCasePropertyNamesContractResolver ()
+        let _config = ser.Deserialize<SerialisedGiteaConfig> validatingReader
+
+        messages |> shouldBeEmpty
+
+    [<Test>]
+    [<Explicit "Run this to regenerate the schema file">]
+    let ``Update schema file`` () =
+        let schemaFile =
+            Assembly.GetExecutingAssembly().Location
+            |> FileInfo
+            |> fun fi -> fi.Directory
+            |> findFileAbove "Gitea/GiteaConfig.schema.json"
+
+        let schema = schemaGen.Generate typeof<SerialisedGiteaConfig>
+
+        File.WriteAllText (schemaFile.FullName, schema.ToString ())

Gitea.sln

@@ -0,0 +1,28 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Gitea", "Gitea\Gitea.fsproj", "{5F99DAF4-A9F0-4A76-A205-AF586C07FE40}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Gitea.Test", "Gitea.Test\Gitea.Test.fsproj", "{1E3E6442-11C5-4366-A1E8-A38E069934F7}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Gitea.App", "Gitea.App\Gitea.App.fsproj", "{77DA39F7-AF01-448A-B71C-3D495EE2F6F4}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|Any CPU = Debug|Any CPU
+		Release|Any CPU = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{5F99DAF4-A9F0-4A76-A205-AF586C07FE40}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{5F99DAF4-A9F0-4A76-A205-AF586C07FE40}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{5F99DAF4-A9F0-4A76-A205-AF586C07FE40}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{5F99DAF4-A9F0-4A76-A205-AF586C07FE40}.Release|Any CPU.Build.0 = Release|Any CPU
+		{1E3E6442-11C5-4366-A1E8-A38E069934F7}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{1E3E6442-11C5-4366-A1E8-A38E069934F7}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{1E3E6442-11C5-4366-A1E8-A38E069934F7}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{1E3E6442-11C5-4366-A1E8-A38E069934F7}.Release|Any CPU.Build.0 = Release|Any CPU
+		{77DA39F7-AF01-448A-B71C-3D495EE2F6F4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{77DA39F7-AF01-448A-B71C-3D495EE2F6F4}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{77DA39F7-AF01-448A-B71C-3D495EE2F6F4}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{77DA39F7-AF01-448A-B71C-3D495EE2F6F4}.Release|Any CPU.Build.0 = Release|Any CPU
+	EndGlobalSection
+EndGlobal

Gitea/Array.fs

@@ -0,0 +1,20 @@
+namespace Gitea
+
+[<RequireQualifiedAccess>]
+module internal Array =
+
+    /// f takes a page number and a count.
+    let getPaginated (f : int64 -> int64 -> 'a array Async) : 'a list Async =
+        let count = 30
+
+        let rec go (page : int) (acc : 'a array list) =
+            async {
+                let! result = f page count
+
+                if result.Length >= count then
+                    return! go (page + 1) (result :: acc)
+                else
+                    return (result :: acc) |> Seq.concat |> Seq.toList
+            }
+
+        go 1 []

Gitea/AssemblyInfo.fs

@@ -0,0 +1,6 @@
+namespace Gitea.AssemblyInfo
+
+open System.Runtime.CompilerServices
+
+[<assembly : InternalsVisibleTo("Gitea.Test")>]
+do ()

Gitea/ConfigSchema.fs

@@ -0,0 +1,126 @@
+namespace Gitea
+
+open System
+open System.IO
+open Newtonsoft.Json
+
+type NativeRepo =
+    {
+        DefaultBranch : string
+        Private : bool option
+    }
+
+    static member internal OfSerialised (s : SerialisedNativeRepo) =
+        {
+            NativeRepo.DefaultBranch = s.DefaultBranch
+            Private = s.Private |> Option.ofNullable
+        }
+
+type Repo =
+    {
+        Description : string
+        GitHub : Uri option
+        Native : NativeRepo option
+    }
+
+    static member Render (u : Gitea.Repository) : Repo =
+        {
+            Description = u.Description
+            GitHub =
+                if String.IsNullOrEmpty u.OriginalUrl then
+                    None
+                else
+                    Some (Uri u.OriginalUrl)
+            Native =
+                if String.IsNullOrEmpty u.OriginalUrl then
+                    {
+                        Private = u.Private
+                        DefaultBranch = u.DefaultBranch
+                    }
+                    |> Some
+                else
+                    None
+        }
+
+    static member internal OfSerialised (s : SerialisedRepo) =
+        {
+            Repo.Description = s.Description
+            GitHub = Option.ofObj s.GitHub
+            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<User, UserInfo>
+        Repos : Map<User, Map<RepoName, Repo>>
+    }
+
+    static member internal OfSerialised (s : SerialisedGiteaConfig) =
+        {
+            GiteaConfig.Users = s.Users |> Map.map (fun _ -> UserInfo.OfSerialised)
+            Repos = s.Repos |> Map.map (fun _ -> Map.map (fun _ -> Repo.OfSerialised))
+        }
+
+[<RequireQualifiedAccess>]
+module GiteaConfig =
+    let get (file : FileInfo) : GiteaConfig =
+        let s =
+            use reader = new StreamReader (file.OpenRead ())
+            reader.ReadToEnd ()
+
+        JsonConvert.DeserializeObject<SerialisedGiteaConfig> s
+        |> GiteaConfig.OfSerialised

Gitea/Domain.fs

@@ -0,0 +1,30 @@
+namespace Gitea
+
+open System
+open System.ComponentModel
+
+[<TypeConverter(typeof<UserTypeConverter>)>]
+type User =
+    | User of string
+
+    override this.ToString () =
+        match this with
+        | User u -> u
+
+and UserTypeConverter () =
+    inherit TypeConverter ()
+    override _.CanConvertFrom (_, t : Type) : bool = t = typeof<string>
+    override _.ConvertFrom (_, _, v : obj) : obj = v |> unbox<string> |> User |> box
+
+[<TypeConverter(typeof<RepoNameTypeConverter>)>]
+type RepoName =
+    | RepoName of string
+
+    override this.ToString () =
+        match this with
+        | RepoName r -> r
+
+and RepoNameTypeConverter () =
+    inherit TypeConverter ()
+    override _.CanConvertFrom (_, t : Type) : bool = t = typeof<string>
+    override _.ConvertFrom (_, _, v : obj) : obj = v |> unbox<string> |> RepoName |> box

Gitea/Gitea.fs

@@ -0,0 +1,201 @@
+namespace Gitea
+
+open System
+open Microsoft.Extensions.Logging
+
+type AlignmentError<'a> =
+    | UnexpectedlyPresent
+    | DoesNotExist of desired : 'a
+    | ConfigurationDiffers of desired : 'a * actual : 'a
+
+    override this.ToString () =
+        match this with
+        | UnexpectedlyPresent -> "Found on Gitea, but was not in configuration."
+        | DoesNotExist _ -> "Present in configuration, but absent on Gitea."
+        | ConfigurationDiffers (desired, actual) -> $"Differs from config. Desired: {desired}. Actual: {actual}."
+
+[<RequireQualifiedAccess>]
+module Gitea =
+
+    let checkUsers
+        (config : GiteaConfig)
+        (client : Gitea.Client)
+        : Async<Result<unit, Map<User, AlignmentError<UserInfo>>>>
+        =
+        async {
+            let desiredUsers = config.Users
+
+            let! actualUsers =
+                Array.getPaginated (fun page count ->
+                    client.AdminGetAllUsers (Some page, Some count) |> Async.AwaitTask
+                )
+
+            let actualUsers =
+                actualUsers |> Seq.map (fun u -> User u.Login, UserInfo.Render u) |> Map.ofSeq
+
+            let errors =
+                actualUsers
+                |> Map.toSeq
+                |> Seq.choose (fun (user, actual) ->
+                    match Map.tryFind user desiredUsers with
+                    | None -> (user, AlignmentError.UnexpectedlyPresent) |> Some
+                    | Some desired ->
+                        if desired <> actual then
+                            (user, AlignmentError.ConfigurationDiffers (desired, actual)) |> Some
+                        else
+                            None
+                )
+                |> Map.ofSeq
+
+            let otherErrors =
+                desiredUsers
+                |> Map.toSeq
+                |> Seq.choose (fun (user, desired) ->
+                    match Map.tryFind user actualUsers with
+                    | None -> (user, AlignmentError.DoesNotExist desired) |> Some
+                    | Some actual ->
+                        if desired <> actual then
+                            (user, AlignmentError.ConfigurationDiffers (desired, actual)) |> Some
+                        else
+                            None
+                )
+                |> Map.ofSeq
+
+            let together = Map.union (fun _ x _ -> x) errors otherErrors
+            return if together.IsEmpty then Ok () else Error together
+        }
+
+    // TODO: check whether mirrors are out of sync e.g. in Public/Private status
+    let checkRepos
+        (config : GiteaConfig)
+        (client : Gitea.Client)
+        : Async<Result<unit, Map<User, Map<RepoName, AlignmentError<Repo>>>>>
+        =
+        async {
+            let! errors =
+                config.Repos
+                |> Map.toSeq
+                |> Seq.map (fun (User user as u, desiredRepos) ->
+                    async {
+                        let! repos =
+                            Array.getPaginated (fun page count ->
+                                client.UserListRepos (user, Some page, Some count) |> Async.AwaitTask
+                            )
+
+                        let actualRepos =
+                            repos |> Seq.map (fun repo -> RepoName repo.Name, Repo.Render repo) |> Map.ofSeq
+
+                        let errors1 =
+                            actualRepos
+                            |> Map.toSeq
+                            |> Seq.choose (fun (repo, actual) ->
+                                match Map.tryFind repo desiredRepos with
+                                | None -> Some (repo, AlignmentError.UnexpectedlyPresent)
+                                | Some desired ->
+                                    if desired <> actual then
+                                        (repo, AlignmentError.ConfigurationDiffers (desired, actual)) |> Some
+                                    else
+                                        None
+                            )
+                            |> Map.ofSeq
+
+                        let errors2 =
+                            desiredRepos
+                            |> Map.toSeq
+                            |> Seq.choose (fun (repo, desired) ->
+                                match Map.tryFind repo actualRepos with
+                                | None -> Some (repo, AlignmentError.DoesNotExist desired)
+                                | Some actual ->
+                                    if desired <> actual then
+                                        (repo, AlignmentError.ConfigurationDiffers (desired, actual)) |> Some
+                                    else
+                                        None
+                            )
+                            |> Map.ofSeq
+
+                        return u, Map.union (fun _ v _ -> v) errors1 errors2
+                    }
+                )
+                |> Async.Parallel
+
+            let errors = errors |> Array.filter (fun (_, m) -> not m.IsEmpty)
+
+            return
+                if errors.Length = 0 then
+                    Ok ()
+                else
+                    Error (Map.ofArray errors)
+        }
+
+    let reconcileRepoErrors
+        (logger : ILogger)
+        (client : Gitea.Client)
+        (githubApiToken : string option)
+        (m : Map<User, Map<RepoName, AlignmentError<Repo>>>)
+        : Async<unit>
+        =
+        m
+        |> Map.toSeq
+        |> Seq.collect (fun (User user, errMap) ->
+            errMap
+            |> Map.toSeq
+            |> Seq.map (fun (RepoName r, err) ->
+                match err with
+                | AlignmentError.DoesNotExist desired ->
+                    async {
+                        let! _ =
+                            match desired.GitHub, desired.Native with
+                            | None, Some native ->
+                                let options = Gitea.CreateRepoOption ()
+                                options.Description <- desired.Description
+                                options.Name <- r
+                                options.Private <- native.Private
+                                options.DefaultBranch <- native.DefaultBranch
+
+                                try
+                                    client.AdminCreateRepo (user, options) |> Async.AwaitTask
+                                with e ->
+                                    raise (AggregateException ($"Error creating {user}:{r}", e))
+                            | Some uri, None ->
+                                let options = Gitea.MigrateRepoOptions ()
+                                options.Description <- desired.Description
+                                options.Mirror <- Some true
+                                options.RepoName <- r
+                                options.RepoOwner <- user
+                                options.CloneAddr <- uri.ToString ()
+                                options.Issues <- Some true
+                                options.Labels <- Some true
+                                options.Lfs <- Some true
+                                options.Milestones <- Some true
+                                options.Releases <- Some true
+                                options.Wiki <- Some true
+                                options.PullRequests <- Some true
+                                // TODO - migrate private status
+                                githubApiToken |> Option.iter (fun t -> options.AuthToken <- t)
+
+                                try
+                                    client.RepoMigrate options |> Async.AwaitTask
+                                with e ->
+                                    raise (AggregateException ($"Error migrating {user}:{r}", e))
+                            | None, None ->
+                                // TODO: express this in JsonSchema
+                                failwith $"You must supply exactly one of Native or GitHub for {user}:{r}."
+                            | Some _, Some _ ->
+                                failwith $"Repo {user}:{r} has both Native and GitHub set; you must set exactly one."
+
+                        logger.LogInformation ("Created repo {User}: {Repo}", user.ToString (), r.ToString ())
+                        return ()
+                    }
+                | err ->
+                    async {
+                        logger.LogInformation (
+                            "Unable to reconcile: {User}, {Repo}: {Error}",
+                            user.ToString (),
+                            r.ToString (),
+                            err
+                        )
+                    }
+            )
+        )
+        |> Async.Parallel
+        |> fun a -> async.Bind (a, Array.iter id >> async.Return)

Gitea/Gitea.fsproj

@@ -0,0 +1,27 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <TargetFramework>net6.0</TargetFramework>
+    <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
+    <GenerateDocumentationFile>true</GenerateDocumentationFile>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="AssemblyInfo.fs" />
+    <Compile Include="Map.fs" />
+    <Compile Include="GiteaClient.fs" />
+    <Compile Include="Domain.fs" />
+    <Compile Include="SerialisedConfigSchema.fs" />
+    <Compile Include="ConfigSchema.fs" />
+    <Compile Include="Array.fs" />
+    <Compile Include="Gitea.fs" />
+    <Content Include="GiteaConfig.schema.json" />
+    <EmbeddedResource Include="version.json" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Microsoft.Extensions.Logging" Version="7.0.0" />
+    <PackageReference Include="SwaggerProvider" Version="1.0.1" />
+    <PackageReference Include="Newtonsoft.Json" Version="13.0.2" />
+  </ItemGroup>
+</Project>

Gitea/GiteaClient.fs

@@ -0,0 +1,11 @@
+namespace Gitea
+
+open SwaggerProvider
+
+[<AutoOpen>]
+module GiteaClient =
+
+    [<Literal>]
+    let Host = "https://gitea.patrickstevens.co.uk/swagger.v1.json"
+
+    type Gitea = SwaggerClientProvider<Host>

Gitea/GiteaConfig.schema.json

@@ -0,0 +1,109 @@
+{
+  "definitions": {
+    "Nullable<SerialisedNativeRepo>": {
+      "description": "If this repo is to be created natively on Gitea, the information about the repo.",
+      "type": [
+        "object",
+        "null"
+      ],
+      "additionalProperties": false,
+      "properties": {
+        "defaultBranch": {
+          "description": "The default branch name for this repository, e.g. 'main'",
+          "type": "string"
+        },
+        "private": {
+          "description": "Whether this repository is a Gitea private repo",
+          "type": "boolean"
+        }
+      },
+      "required": [
+        "defaultBranch"
+      ]
+    },
+    "SerialisedRepo": {
+      "type": [
+        "object",
+        "null"
+      ],
+      "additionalProperties": false,
+      "properties": {
+        "description": {
+          "description": "The text that will accompany this repository in the Gitea UI",
+          "type": "string"
+        },
+        "gitHub": {
+          "description": "If this repo is to sync from GitHub, the URI (e.g. 'https://github.com/Smaug123/nix-maui')",
+          "type": [
+            "string",
+            "null"
+          ],
+          "format": "uri"
+        },
+        "native": {
+          "$ref": "#/definitions/Nullable<SerialisedNativeRepo>"
+        }
+      },
+      "required": [
+        "description"
+      ]
+    },
+    "SerialisedUserInfo": {
+      "type": [
+        "object",
+        "null"
+      ],
+      "additionalProperties": false,
+      "properties": {
+        "isAdmin": {
+          "type": "boolean"
+        },
+        "email": {
+          "type": "string"
+        },
+        "website": {
+          "type": [
+            "string",
+            "null"
+          ],
+          "format": "uri"
+        },
+        "visibility": {
+          "type": [
+            "string",
+            "null"
+          ]
+        }
+      },
+      "required": [
+        "email"
+      ]
+    }
+  },
+  "type": "object",
+  "additionalProperties": false,
+  "properties": {
+    "users": {
+      "type": "object",
+      "additionalProperties": {
+        "$ref": "#/definitions/SerialisedUserInfo"
+      }
+    },
+    "repos": {
+      "type": "object",
+      "additionalProperties": {
+        "type": [
+          "object",
+          "null"
+        ],
+        "additionalProperties": {
+          "$ref": "#/definitions/SerialisedRepo"
+        }
+      }
+    }
+  },
+  "required": [
+    "users",
+    "repos"
+  ]
+}

Gitea/Map.fs

@@ -0,0 +1,21 @@
+namespace Gitea
+
+[<RequireQualifiedAccess>]
+module internal Map =
+
+    let inline union<'k, 'v when 'k : comparison>
+        ([<InlineIfLambda>] f : 'k -> 'v -> 'v -> 'v)
+        (m1 : Map<'k, 'v>)
+        (m2 : Map<'k, 'v>)
+        : Map<'k, 'v>
+        =
+        (m1, m2)
+        ||> Map.fold (fun acc k v2 ->
+            acc
+            |> Map.change
+                k
+                (function
+                | None -> Some v2
+                | Some v1 -> Some (f k v1 v2)
+                )
+        )

Gitea/SerialisedConfigSchema.fs

@@ -0,0 +1,57 @@
+namespace Gitea
+
+open System
+open System.ComponentModel
+open Newtonsoft.Json
+
+[<RequireQualifiedAccess>]
+[<Struct>]
+[<Description "Information about a repo that is to be created on Gitea without syncing from GitHub.">]
+type internal SerialisedNativeRepo =
+    {
+        [<Description "The default branch name for this repository, e.g. 'main'">]
+        [<JsonProperty(Required = Required.Always)>]
+        DefaultBranch : string
+        [<Description "Whether this repository is a Gitea private repo">]
+        [<JsonProperty(Required = Required.DisallowNull)>]
+        Private : Nullable<bool>
+    }
+
+[<RequireQualifiedAccess>]
+[<CLIMutable>]
+type internal SerialisedRepo =
+    {
+        [<JsonProperty(Required = Required.Always)>]
+        [<Description "The text that will accompany this repository in the Gitea UI">]
+        Description : string
+        [<Description "If this repo is to sync from GitHub, the URI (e.g. 'https://github.com/Smaug123/nix-maui')">]
+        [<JsonProperty(Required = Required.Default)>]
+        GitHub : Uri
+        [<Description "If this repo is to be created natively on Gitea, the information about the repo.">]
+        [<JsonProperty(Required = Required.Default)>]
+        Native : Nullable<SerialisedNativeRepo>
+    }
+
+[<RequireQualifiedAccess>]
+[<CLIMutable>]
+type internal SerialisedUserInfo =
+    {
+        [<JsonProperty(Required = Required.DisallowNull)>]
+        IsAdmin : Nullable<bool>
+        [<JsonProperty(Required = Required.Always)>]
+        Email : string
+        [<JsonProperty(Required = Required.Default)>]
+        Website : Uri
+        [<JsonProperty(Required = Required.Default)>]
+        Visibility : string
+    }
+
+[<RequireQualifiedAccess>]
+[<CLIMutable>]
+type internal SerialisedGiteaConfig =
+    {
+        [<JsonProperty(Required = Required.Always)>]
+        Users : Map<User, SerialisedUserInfo>
+        [<JsonProperty(Required = Required.Always)>]
+        Repos : Map<User, Map<RepoName, SerialisedRepo>>
+    }

Gitea/version.json

@@ -0,0 +1,7 @@
+{
+  "version": "0.1",
+  "publicReleaseRefSpec": [
+    "^refs/heads/main$"
+  ],
+  "pathFilters": null
+}

hooks/pre-push

@@ -0,0 +1,6 @@
+#!/bin/sh
+
+if ! dotnet tool run fantomas --check -r . ; then
+  echo "Formatting incomplete. Consider running 'dotnet tool run fantomas -r .'"
+  exit 1
+fi