WIP on legacy migration
This commit is contained in:
parent
bdb51921b3
commit
e5f76d4b1d
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -335,10 +335,22 @@ let soLong : HttpHandler = requireUser >=> fun next ctx ->
|
||||
|
||||
// ~~~ LEGACY MIGRATION ~~~ //
|
||||
|
||||
// GET: /citizen/legacy/list
|
||||
let listLegacy : HttpHandler = Auth.requireAdmin >=> fun next ctx -> task {
|
||||
let! users = Data.legacy ()
|
||||
return! Views.listLegacy users |> render "Migrate Legacy Account" next ctx
|
||||
// GET: /citizen/legacy
|
||||
let legacy : HttpHandler = Auth.requireAdmin >=> fun next ctx -> task {
|
||||
let! currentUsers = Data.current ()
|
||||
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
|
||||
]
|
||||
]
|
||||
|
||||
@ -396,20 +396,49 @@ let resetPassword (m : ResetPasswordForm) isHtmx csrf =
|
||||
|
||||
// ~~~ LEGACY MIGRATION ~~~ //
|
||||
|
||||
let listLegacy (m : Citizen list) =
|
||||
[ table [ _class "table table-sm table-hover" ] [
|
||||
let legacy (current : Citizen list) (legacy : Citizen list) csrf =
|
||||
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 [] [ str it.Email ]
|
||||
td [] [
|
||||
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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user