Add tests (#60)

Gitea.Declarative.Lib/Exception.fs

@@ -0,0 +1,10 @@
+namespace Gitea.Declarative
+
+open System.Runtime.ExceptionServices
+
+[<RequireQualifiedAccess>]
+module internal Exception =
+    let reraiseWithOriginalStackTrace<'a> (e : exn) : 'a =
+        let edi = ExceptionDispatchInfo.Capture e
+        edi.Throw ()
+        failwith "unreachable"

Gitea.Declarative.Lib/Gitea.Declarative.Lib.fsproj

@@ -19,6 +19,7 @@
   <ItemGroup>
     <Compile Include="AssemblyInfo.fs" />
     <Compile Include="Map.fs" />
+    <Compile Include="Exception.fs" />
     <Compile Include="Async.fs" />
     <Compile Include="GiteaClient.fs" />
     <Compile Include="IGiteaClient.fs" />

Gitea.Declarative.Test/Gitea.Declarative.Test.fsproj

@@ -7,7 +7,10 @@
 
   <ItemGroup>
     <Compile Include="Utils.fs" />
+    <Compile Include="Result.fs" />
+    <Compile Include="Logging.fs" />
     <Compile Include="TestUser.fs" />
+    <Compile Include="TestRepo.fs" />
     <Compile Include="TestJsonSchema.fs" />
     <Compile Include="TestSwaggerJson.fs" />
     <Content Include="GiteaConfig.json" />

Gitea.Declarative.Test/Logging.fs

@@ -0,0 +1,34 @@
+namespace Gitea.Declarative.Test
+
+open System
+open Microsoft.Extensions.Logging
+
+[<RequireQualifiedAccess>]
+module LoggerFactory =
+
+    /// Creates a test ILoggerFactory, a sink whose provided inputs you can access through the `unit -> string list`.
+    let makeTest () : ILoggerFactory * (unit -> string list) =
+        let outputs = ResizeArray<_> ()
+
+        let lf =
+            { new ILoggerFactory with
+                member _.Dispose () = ()
+
+                member _.CreateLogger (name : string) =
+                    { new ILogger with
+                        member _.IsEnabled _ = true
+
+                        member _.BeginScope _ =
+                            { new IDisposable with
+                                member _.Dispose () = ()
+                            }
+
+                        member _.Log (_, _, state, exc : exn, formatter) =
+                            let toWrite = formatter.Invoke (state, exc)
+                            lock outputs (fun () -> outputs.Add toWrite)
+                    }
+
+                member _.AddProvider provider = failwith "unsupported"
+            }
+
+        lf, (fun () -> lock outputs (fun () -> Seq.toList outputs))

Gitea.Declarative.Test/Result.fs

@@ -0,0 +1,14 @@
+namespace Gitea.Declarative.Test
+
+[<RequireQualifiedAccess>]
+module Result =
+
+    let get r =
+        match r with
+        | Ok o -> o
+        | Error e -> failwithf "Expected Ok, got: %+A" e
+
+    let getError r =
+        match r with
+        | Ok o -> failwithf "Expected Error, got: %+A" o
+        | Error e -> e

Gitea.Declarative.Test/TestRepo.fs

@@ -0,0 +1,234 @@
+namespace Gitea.Declarative.Test
+
+open System
+open System.Threading.Tasks
+open Gitea.Declarative
+open Gitea.InMemory
+open Microsoft.Extensions.Logging.Abstractions
+open NUnit.Framework
+open FsUnitTyped
+open FsCheck
+
+[<TestFixture>]
+module TestRepo =
+
+    [<Test>]
+    let ``We refuse to delete a repo if we get to Reconcile without positive confirmation`` () =
+        let property (gitHubToken : string option) =
+            let client = GiteaClientMock.Unimplemented
+
+            let lf, messages = LoggerFactory.makeTest ()
+            let logger = lf.CreateLogger "test"
+
+            [
+                User "username", Map.ofList [ RepoName "repo", AlignmentError.UnexpectedlyPresent ]
+            ]
+            |> Map.ofList
+            |> Gitea.reconcileRepoErrors logger client gitHubToken
+            |> Async.RunSynchronously
+
+            messages ()
+            |> List.filter (fun s -> s.Contains ("refusing to delete", StringComparison.OrdinalIgnoreCase))
+            |> List.length
+            |> shouldEqual 1
+
+        Check.QuickThrowOnFailure property
+
+    [<Test>]
+    let ``We refuse to delete repos when they're not configured to be deleted`` () =
+        Arb.register<CustomArb> () |> ignore
+
+        let property
+            (user : User)
+            (repos : Map<RepoName, Repo>)
+            (userInfo : UserInfo)
+            (repo : Gitea.Repository)
+            (reposToReturn : Gitea.Repository[])
+            =
+            let reposToReturn = Array.append [| repo |] reposToReturn
+
+            let reposToReturn =
+                if reposToReturn.Length >= 5 then
+                    reposToReturn.[0..3]
+                else
+                    reposToReturn
+
+            let lf, messages = LoggerFactory.makeTest ()
+            let logger = lf.CreateLogger "test"
+
+            let client =
+                { GiteaClientMock.Unimplemented with
+                    UserListRepos =
+                        fun (_username, _page, _limit) ->
+                            async {
+                                return
+                                    reposToReturn
+                                    |> Array.filter (fun r -> not (repos.ContainsKey (RepoName r.Name)))
+                            }
+                            |> Async.StartAsTask
+
+                    RepoListPushMirrors = fun _ -> async { return [||] } |> Async.StartAsTask
+
+                    RepoListBranchProtection = fun _ -> async { return [||] } |> Async.StartAsTask
+
+                    RepoListCollaborators = fun _ -> async { return [||] } |> Async.StartAsTask
+                }
+
+            let config : GiteaConfig =
+                {
+                    Users = Map.ofList [ user, userInfo ]
+                    Repos =
+                        let repos =
+                            repos
+                            |> Map.map (fun _ r ->
+                                { r with
+                                    Deleted =
+                                        match r.Deleted with
+                                        | Some true -> Some false
+                                        | _ -> None
+                                }
+                            )
+
+                        [ user, repos ] |> Map.ofList
+                }
+
+            let recoveredUser, error =
+                Gitea.checkRepos logger config client
+                |> Async.RunSynchronously
+                |> Result.getError
+                |> Map.toSeq
+                |> Seq.exactlyOne
+
+            recoveredUser |> shouldEqual user
+
+            for repoName, _configuredRepo in Map.toSeq repos do
+                match Map.tryFind repoName error with
+                | Some (AlignmentError.DoesNotExist _) -> ()
+                | a -> failwithf "Failed: %+A" a
+
+            let messages = messages ()
+            messages |> shouldEqual []
+
+        Check.QuickThrowOnFailure property
+
+    [<Test>]
+    let ``We point out when repos have been deleted`` () =
+        Arb.register<CustomArb> () |> ignore
+
+        let property (user : User) (repos : Map<RepoName, Repo>) (userInfo : UserInfo) =
+
+            let lf, messages = LoggerFactory.makeTest ()
+            let logger = lf.CreateLogger "test"
+
+            let client =
+                { GiteaClientMock.Unimplemented with
+                    UserListRepos = fun _ -> Task.FromResult [||]
+
+                    RepoListPushMirrors = fun _ -> async { return [||] } |> Async.StartAsTask
+
+                    RepoListBranchProtection = fun _ -> async { return [||] } |> Async.StartAsTask
+
+                    RepoListCollaborators = fun _ -> async { return [||] } |> Async.StartAsTask
+                }
+
+            let config : GiteaConfig =
+                {
+                    Users = Map.ofList [ user, userInfo ]
+                    Repos =
+                        let repos =
+                            repos
+                            |> Map.map (fun _ r ->
+                                { r with
+                                    Deleted = Some true
+                                }
+                            )
+
+                        [ user, repos ] |> Map.ofList
+                }
+
+            Gitea.checkRepos logger config client |> Async.RunSynchronously |> Result.get
+
+            for message in messages () do
+                message.Contains ("Remove this repo from configuration", StringComparison.OrdinalIgnoreCase)
+                |> shouldEqual true
+
+        Check.QuickThrowOnFailure property
+
+    [<Test>]
+    let ``We decide to delete repos which are configured to Deleted = true`` () =
+        Arb.register<CustomArb> () |> ignore
+
+        let property
+            (user : User)
+            (oneExistingRepoName : RepoName)
+            (oneExistingRepo : Repo)
+            (existingRepos : Map<RepoName, Repo>)
+            (userInfo : UserInfo)
+            =
+
+            let existingRepos = existingRepos |> Map.add oneExistingRepoName oneExistingRepo
+
+            let giteaUser =
+                let result = Gitea.User ()
+                result.LoginName <- user.ToString ()
+                result
+
+            let client =
+                { GiteaClientMock.Unimplemented with
+                    UserListRepos =
+                        fun _ ->
+                            async {
+                                return
+                                    existingRepos
+                                    |> Map.toSeq
+                                    |> Seq.map (fun (RepoName repoName, _repoSpec) ->
+                                        let repo = Gitea.Repository ()
+                                        repo.Name <- repoName
+                                        repo.Owner <- giteaUser
+                                        repo
+                                    )
+                                    |> Seq.toArray
+                            }
+                            |> Async.StartAsTask
+
+                    RepoListPushMirrors = fun _ -> async { return [||] } |> Async.StartAsTask
+
+                    RepoListBranchProtection = fun _ -> async { return [||] } |> Async.StartAsTask
+
+                    RepoListCollaborators = fun _ -> async { return [||] } |> Async.StartAsTask
+                }
+
+            let config : GiteaConfig =
+                {
+                    Users = Map.ofList [ user, userInfo ]
+                    Repos =
+                        let repos =
+                            existingRepos
+                            |> Map.map (fun _ r ->
+                                { r with
+                                    Deleted = Some true
+                                }
+                            )
+
+                        [ user, repos ] |> Map.ofList
+                }
+
+            let recoveredUser, errors =
+                Gitea.checkRepos NullLogger.Instance config client
+                |> Async.RunSynchronously
+                |> Result.getError
+                |> Map.toSeq
+                |> Seq.exactlyOne
+
+            recoveredUser |> shouldEqual user
+
+            CollectionAssert.AreEqual (existingRepos.Keys, errors.Keys)
+
+            for _repo, config in Map.toSeq errors do
+                match config with
+                | AlignmentError.ConfigurationDiffers (desired, _) -> desired.Deleted |> shouldEqual (Some true)
+                | a -> failwithf "Unexpected alignment: %+A" a
+
+        Check.QuickThrowOnFailure property
+
+// TODO: test that we delete repos which come up as ConfigurationDiffers (desired.Deleted = Some true)

Gitea.Declarative.Test/Utils.fs

@@ -1,12 +1,111 @@
 namespace Gitea.Declarative.Test
 
+open Gitea.Declarative
 open System
 open System.IO
 open FsCheck
+open Microsoft.FSharp.Reflection
 
 type CustomArb () =
     static member UriGen = Gen.constant (Uri "http://example.com") |> Arb.fromGen
 
+    static member User : Arbitrary<Gitea.User> =
+        gen {
+            let user = Gitea.User ()
+            let! a = Arb.generate<_>
+            user.Active <- a
+            let! a = Arb.generate<_>
+            user.Created <- a
+            let! a = Arb.generate<_>
+            user.Description <- a
+            let! a = Arb.generate<_>
+            user.Email <- a
+            let! a = Arb.generate<_>
+            user.Id <- a
+            let! a = Arb.generate<_>
+            user.Language <- a
+            let! a = Arb.generate<_>
+            user.Location <- a
+            let! a = Arb.generate<_>
+            user.Login <- a
+            let! a = Arb.generate<_>
+            user.Restricted <- a
+            let! a = Arb.generate<_>
+            user.Visibility <- a
+            let! a = Arb.generate<_>
+            user.Website <- a
+            let! a = Arb.generate<_>
+            user.FullName <- a
+            let! a = Arb.generate<_>
+            user.IsAdmin <- a
+            let! a = Arb.generate<_>
+            user.LoginName <- a
+            let! a = Arb.generate<_>
+            user.ProhibitLogin <- a
+            return user
+        }
+        |> Arb.fromGen
+
+    static member RepositoryGen : Arbitrary<Gitea.Repository> =
+        gen {
+            let repo = Gitea.Repository ()
+            let! a = Arb.generate<_>
+            repo.Archived <- a
+            let! a = Arb.generate<_>
+            repo.Description <- a
+            let! a = Arb.generate<_>
+            repo.Empty <- a
+            let! a = Arb.generate<_>
+            repo.Fork <- a
+            let! a = Arb.generate<_>
+            repo.Id <- a
+            let! a = Arb.generate<_>
+            repo.Internal <- a
+            let! a = Arb.generate<_>
+            repo.Language <- a
+            let! a = Arb.generate<_>
+            repo.Link <- a
+            let! a = Arb.generate<_>
+            repo.Mirror <- a
+            let! a = Arb.generate<_>
+            repo.Name <- a
+            let! a = Arb.generate<_>
+            repo.Owner <- a
+            let! a = Arb.generate<_>
+            repo.Private <- a
+            let! a = Arb.generate<_>
+            repo.Website <- a
+            let! a = Arb.generate<_>
+            repo.AllowRebase <- a
+            let! a = Arb.generate<_>
+            repo.AllowMergeCommits <- a
+            let! a = Arb.generate<_>
+            repo.AllowRebaseExplicit <- a
+            let! a = Arb.generate<_>
+            repo.AllowRebaseUpdate <- a
+            let! a = Arb.generate<_>
+            repo.AllowSquashMerge <- a
+            let! a = Arb.generate<_>
+            repo.DefaultBranch <- a
+            let! a = Arb.generate<_>
+            repo.HasIssues <- a
+            let! a = Arb.generate<_>
+            repo.HasProjects <- a
+            let! a = Arb.generate<_>
+            repo.HasWiki <- a
+            let! a = Arb.generate<_>
+            repo.HasPullRequests <- a
+
+            let! a =
+                FSharpType.GetUnionCases typeof<MergeStyle>
+                |> Array.map (fun uci -> FSharpValue.MakeUnion (uci, [||]) |> unbox<MergeStyle>)
+                |> Gen.elements
+
+            repo.DefaultMergeStyle <- MergeStyle.toString a
+            return repo
+        }
+        |> Arb.fromGen
+
 [<RequireQualifiedAccess>]
 module Utils =
 

Gitea.InMemory/Client.fs

@@ -61,16 +61,7 @@ module Client =
                 member _.AdminCreateUser createUserOption =
                     async {
                         let! () = server.PostAndAsyncReply (fun reply -> AddUser (createUserOption, reply))
-                        let result = Gitea.User ()
-                        result.Email <- createUserOption.Email
-                        result.Restricted <- createUserOption.Restricted
-                        // TODO: what is this username used for anyway
-                        // result.LoginName <- createUserOption.Username
-                        result.Visibility <- createUserOption.Visibility
-                        result.Created <- createUserOption.CreatedAt
-                        result.FullName <- createUserOption.FullName
-                        result.LoginName <- createUserOption.LoginName
-                        return result
+                        return Operations.createdUser createUserOption
                     }
                     |> Async.StartAsTask
 

Gitea.InMemory/Domain.fs

@@ -4,6 +4,8 @@ open System
 open System.Threading.Tasks
 open Gitea.Declarative
 
+module Types =
+
     type BranchName = | BranchName of string
 
     type BranchProtectionRule =
@@ -20,12 +22,6 @@ type Repo =
         | GitHubMirror of Uri
         | NativeRepo of NativeRepo
 
-type GiteaState =
-    {
-        Users : User Set
-        Repositories : Map<User * RepoName, Repo>
-    }
-
 /// Allows us to use handy record-updating syntax.
 /// (I have a considerable dislike of Moq and friends.)
 type GiteaClientMock =

Gitea.InMemory/Gitea.InMemory.fsproj

@@ -8,6 +8,7 @@
 
     <ItemGroup>
         <Compile Include="Domain.fs" />
+        <Compile Include="Server.fs" />
         <Compile Include="Client.fs" />
     </ItemGroup>
 

Gitea.InMemory/Server.fs

@@ -0,0 +1,18 @@
+namespace Gitea.InMemory
+
+open Gitea.Declarative
+
+[<RequireQualifiedAccess>]
+module Operations =
+    let createdUser (createUserOption : Gitea.CreateUserOption) : Gitea.User =
+        let result = Gitea.User ()
+        result.Email <- createUserOption.Email
+        result.Restricted <- createUserOption.Restricted
+        // TODO: what is this username used for anyway
+        // result.LoginName <- createUserOption.Username
+        result.Visibility <- createUserOption.Visibility
+        result.Created <- createUserOption.CreatedAt
+        result.FullName <- createUserOption.FullName
+        result.LoginName <- createUserOption.LoginName
+
+        result