WIP on legacy migration

src/JobsJobsJobs/Citizens/Data.fs

@@ -204,6 +204,71 @@ let trySecurityByToken token = backgroundTask {
 let legacy () = backgroundTask {
     return!
         dataSource ()
-        |> Sql.query $"SELECT * FROM {Table.Citizen} WHERE data ->> 'isLegacy' = 'true'"
+        |> Sql.query $"SELECT * FROM {Table.Citizen} WHERE data ->> 'isLegacy' = 'true' ORDER BY data ->> 'firstName'"
         |> Sql.executeAsync toDocument<Citizen>
 }
+
+/// Get all current citizens with verified accounts but without a profile
+let current () = backgroundTask {
+    return!
+        dataSource ()
+        |> Sql.query $"
+            SELECT c.*
+              FROM {Table.Citizen} c
+                   INNER JOIN {Table.SecurityInfo} si ON si.id = c.id
+             WHERE c.data  ->> 'isLegacy'      = 'false'
+               AND si.data ->> 'accountLocked' = 'false'
+               AND NOT EXISTS (SELECT 1 FROM {Table.Profile} p WHERE p.id = c.id)"
+        |> Sql.executeAsync toDocument<Citizen>
+}
+
+let migrateLegacy currentId legacyId = backgroundTask {
+    let  curId     = CitizenId.toString currentId
+    let  legId     = CitizenId.toString legacyId
+    let  connProps = dataSource ()
+    use  conn      = Sql.createConnection connProps
+    use! txn       = conn.BeginTransactionAsync ()
+    try
+        // Add legacy data to current user
+        let! _ =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query $"INSERT INTO {Table.Profile} SELECT @id, data FROM {Table.Profile} WHERE id = @oldId"
+            |> Sql.parameters [ "@id", Sql.string curId; "@oldId", Sql.string legId ]
+            |> Sql.executeNonQueryAsync
+        let! listings =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query $"SELECT * FROM {Table.Listing} WHERE data ->> 'citizenId' = @oldId"
+            |> Sql.parameters [ "@oldId", Sql.string legId ]
+            |> Sql.executeAsync toDocument<Listing>
+        for listing in listings do
+            let newListing = { listing with Id = ListingId.create (); CitizenId = currentId }
+            do! saveDocument
+                    Table.Listing (ListingId.toString newListing.Id) (Sql.existingConnection conn) (mkDoc newListing)
+        let! successes =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query $"SELECT * FROM {Table.Success} WHERE data ->> 'citizenId' = @oldId"
+            |> Sql.parameters [ "@oldId", Sql.string legId ]
+            |> Sql.executeAsync toDocument<Success>
+        for success in successes do
+            let newSuccess = { success with Id = SuccessId.create (); CitizenId = currentId }
+            do! saveDocument
+                    Table.Success (SuccessId.toString newSuccess.Id) (Sql.existingConnection conn) (mkDoc newSuccess)
+        // Delete legacy data
+        let! _ =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query $"
+                DELETE FROM {Table.Success} WHERE data ->> 'citizenId' = @oldId;
+                DELETE FROM {Table.Listing} WHERE data ->> 'citizenId' = @oldId;
+                DELETE FROM {Table.Citizen} WHERE id = @oldId"
+            |> Sql.parameters [ "@oldId", Sql.string legId ]
+            |> Sql.executeNonQueryAsync
+        do! txn.CommitAsync ()
+        return Ok ""
+    with :? Npgsql.PostgresException as ex ->
+        do! txn.RollbackAsync ()
+        return Error ex.MessageText
+}

src/JobsJobsJobs/Citizens/Domain.fs

@@ -151,3 +151,14 @@ type ResetPasswordForm =
         /// The new password for the account
         Password : string
     }
+
+// ~~~ LEGACY MIGRATION ~~ //
+
+[<CLIMutable; NoComparison; NoEquality>]
+type LegacyMigrationForm =
+    {   /// The ID of the current citizen
+        Id : string
+
+        /// The ID of the legacy citizen to be migrated
+        LegacyId : string
+    }

src/JobsJobsJobs/Citizens/Handlers.fs

@@ -335,10 +335,22 @@ let soLong : HttpHandler = requireUser >=> fun next ctx ->
 
 // ~~~ LEGACY MIGRATION ~~~ //
 
-// GET: /citizen/legacy/list
+// GET: /citizen/legacy
-let listLegacy : HttpHandler = Auth.requireAdmin >=> fun next ctx -> task {
+let legacy : HttpHandler = Auth.requireAdmin >=> fun next ctx -> task {
-    let! users = Data.legacy ()
+    let! currentUsers = Data.current ()
-    return! Views.listLegacy users |> render "Migrate Legacy Account" next ctx
+    let! legacyUsers  = Data.legacy ()
+    return! Views.legacy currentUsers legacyUsers (csrf ctx) |> render "Migrate Legacy Account" next ctx
+}
+
+// POST: /citizen/legacy/migrate
+let migrateLegacy : HttpHandler = Auth.requireAdmin >=> validateCsrf >=> fun next ctx -> task {
+    let! form      = ctx.BindFormAsync<LegacyMigrationForm> ()
+    let  currentId = CitizenId.ofString form.Id
+    let  legacyId  = CitizenId.ofString form.LegacyId
+    match! Data.migrateLegacy currentId legacyId with
+    | Ok _ -> do! addSuccess "Migration successful" ctx
+    | Error err -> do! addError err ctx
+    return! redirectToGet "/citizen/legacy" next ctx
 }
 
 open Giraffe.EndpointRouting
@@ -358,7 +370,7 @@ let endpoints =
             route  "/register"          register
             routef "/reset-password/%s" resetPassword
             route  "/so-long"           soLong
-            route  "/legacy/list"       listLegacy
+            route  "/legacy"            legacy
         ]
         POST [
             route "/delete"          delete
@@ -367,5 +379,6 @@ let endpoints =
             route "/register"        doRegistration
             route "/reset-password"  doResetPassword
             route "/save-account"    saveAccount
+            route "/legacy/migrate"  migrateLegacy
         ]
     ]

src/JobsJobsJobs/Citizens/Views.fs

@@ -396,20 +396,49 @@ let resetPassword (m : ResetPasswordForm) isHtmx csrf =
 
 // ~~~ LEGACY MIGRATION ~~~ //
 
-let listLegacy (m : Citizen list) =
+let legacy (current : Citizen list) (legacy : Citizen list) csrf =
-    [   table [ _class "table table-sm table-hover" ] [
+    form [ _class "container"; _hxPost "/citizen/legacy/migrate" ] [
+        antiForgery csrf
+        let canProcess = not (List.isEmpty current)
+        div [ _class "row" ] [
+            if canProcess then
+                div [ _class "col-12 col-lg-6 col-xxl-4" ] [
+                    div [ _class "form-floating" ] [
+                        select [ _id "current"; _name "Id"; _class "form-control" ] [
+                            option [ _value "" ] [ txt "– Select –" ]
+                            yield!
+                                current
+                                |> List.sortBy Citizen.name
+                                |> List.map (fun it ->
+                                    option [ _value (CitizenId.toString it.Id) ] [
+                                        str (Citizen.name it); txt " ("; str it.Email; txt ")"
+                                    ])
+                        ]
+                        label [ _for "current" ] [ txt "Current User" ]
+                    ]
+                ]
+            else p [] [ txt "There are no current accounts to which legacy accounts can be migrated" ]
+        ]
+        table [ _class "table table-sm table-hover" ] [
             thead [] [
                 tr [] [
-                    th [ _scope "col" ] [ txt "Action" ]
+                    th [ _scope "col" ] [ txt "Select" ]
                     th [ _scope "col" ] [ txt "NAS Profile" ]
                 ]
             ]
-            m |> List.map (fun it ->
+            legacy |> List.map (fun it ->
+                let theId = CitizenId.toString it.Id
                 tr [] [
-                    td [] [ a [ _href $"/citizen/legacy/{CitizenId.toString it.Id}/associate" ] [ txt "Migrate" ] ]
+                    td [] [
-                    td [] [ str it.Email ]
+                        if canProcess then
+                            input [ _type "radio"; _id $"legacy_{theId}"; _name "LegacyId"; _value theId ]
+                        else txt " "
+                    ]
+                    td [] [ label [ _for $"legacy_{theId}" ] [ str it.Email ] ]
                 ])
             |> tbody []
         ]
+        submitButton "save" "Migrate Account"
     ]
+    |> List.singleton
     |> pageWithTitle "Migrate Legacy Account"