oceanbox/Poseidon
6
0
Fork 0
Code Issues 48 Pull Requests 6 Actions Packages Projects Releases 149 Wiki Activity

Merge branch 'mrtz/fargo-archivist' into 'main'

Browse Source 
Convert Archivist to Fargo

See merge request oceanbox/Poseidon!44
This commit was merged in pull request #147.
This commit is contained in:
Jonas Juselius
2025-07-31 07:35:42 +02:00
parent e9a73e5da8 fa063a9508
commit 0e8c89a732
7 changed files with 841 additions and 621 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
src/Archivist/src/Cli/AclCli.fs
View File

@@ -1,12 +1,12 @@
module AclCli
open Argu
open Args
open FSharpPlus
open Serilog
open ArchiveIndex
open Oceanbox.DataAgent
open ArchiveIndex
let inline private execAsync job =
job
|> Async.RunSynchronously
@@ -16,14 +16,14 @@ let inline private execAsync job =
type private Handler = string[] -> Async<Result<unit, string>>
let addOwners (args: ParseResults<Prinicipal>) =
let owners = args.GetResult Prinicipal.Ids |> Array.ofList
let addOwners (args: PrincipalArgs) =
let owners = args.Ids |> Array.ofList
if args.Contains Prinicipal.Archive then
let aid = args.GetResult Prinicipal.Archive
if args.Archive.IsSome then
let aid = args.Archive |> Option.get
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.aclApi ()
async {
@@ -31,7 +31,7 @@ let addOwners (args: ParseResults<Prinicipal>) =
match! aclApi.addOwners (aid, owners) with
| Ok _ ->
Log.Information $"Added owners %A{owners} to archive {aid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -39,20 +39,20 @@ let addOwners (args: ParseResults<Prinicipal>) =
return Error exn.Message
})
else
async { return Ok() }
async { return Ok () }
|> Async.RunSynchronously
|> function
| Ok _ -> ()
| Error e -> Log.Error e
let addUsers (args: ParseResults<Prinicipal>) =
let users = args.GetResult Prinicipal.Ids |> Array.ofList
let addUsers (args: PrincipalArgs) =
let users = args.Ids |> Array.ofList
if args.Contains Prinicipal.Archive then
let aid = args.GetResult Prinicipal.Archive
if args.Archive.IsSome then
let aid = args.Archive |> Option.get
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.aclApi ()
async {
@@ -60,7 +60,7 @@ let addUsers (args: ParseResults<Prinicipal>) =
match! aclApi.addUsers (aid, users) with
| Ok _ ->
Log.Information $"Added users %A{users} to archive {aid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -69,15 +69,15 @@ let addUsers (args: ParseResults<Prinicipal>) =
})
else
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.adminApi ()
async {
try
match! aclApi.addUsers (users) with
match! aclApi.addUsers users with
| Ok _ ->
Log.Information $"Added users %A{users}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -89,14 +89,14 @@ let addUsers (args: ParseResults<Prinicipal>) =
| Ok _ -> ()
| Error e -> Log.Error e
let addGroups (args: ParseResults<Prinicipal>) =
let groups = args.GetResult Prinicipal.Ids |> Array.ofList
let addGroups (args: PrincipalArgs) =
let groups = args.Ids |> Array.ofList
if args.Contains Prinicipal.Archive then
let aid = args.GetResult Prinicipal.Archive
if args.Archive.IsSome then
let aid = args.Archive |> Option.get
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.aclApi ()
async {
@@ -104,7 +104,7 @@ let addGroups (args: ParseResults<Prinicipal>) =
match! aclApi.addGroups (aid, groups) with
| Ok _ ->
Log.Information $"Added groups %A{groups} to archive {aid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -113,15 +113,15 @@ let addGroups (args: ParseResults<Prinicipal>) =
})
else
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.adminApi ()
async {
try
match! aclApi.addGroups (groups) with
match! aclApi.addGroups groups with
| Ok _ ->
Log.Information $"Added groups %A{groups}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -133,14 +133,14 @@ let addGroups (args: ParseResults<Prinicipal>) =
| Ok _ -> ()
| Error e -> Log.Error e
let deleteOwners (args: ParseResults<Prinicipal>) =
let owners = args.GetResult Prinicipal.Ids |> Array.ofList
let deleteOwners (args: PrincipalArgs) =
let owners = args.Ids |> Array.ofList
if args.Contains Prinicipal.Archive then
let aid = args.GetResult Prinicipal.Archive
if args.Archive.IsSome then
let aid = args.Archive |> Option.get
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.aclApi ()
async {
@@ -148,7 +148,7 @@ let deleteOwners (args: ParseResults<Prinicipal>) =
match! aclApi.removeOwners (aid, owners) with
| Ok _ ->
Log.Information $"Removed owners %A{owners} from archive {aid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -156,20 +156,20 @@ let deleteOwners (args: ParseResults<Prinicipal>) =
return Error exn.Message
})
else
async { return Ok() }
async { return Ok () }
|> Async.RunSynchronously
|> function
| Ok _ -> ()
| Error e -> Log.Error e
let deleteUsers (args: ParseResults<Prinicipal>) =
let users = args.GetResult Prinicipal.Ids |> Array.ofList
let deleteUsers (args: PrincipalArgs) =
let users = args.Ids |> Array.ofList
if args.Contains Prinicipal.Archive then
let aid = args.GetResult Prinicipal.Archive
if args.Archive.IsSome then
let aid = args.Archive.Value
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.aclApi ()
async {
@@ -177,7 +177,7 @@ let deleteUsers (args: ParseResults<Prinicipal>) =
match! aclApi.removeUsers (aid, users) with
| Ok _ ->
Log.Information $"Removed users %A{users} from archive {aid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -186,15 +186,15 @@ let deleteUsers (args: ParseResults<Prinicipal>) =
})
else
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.adminApi ()
async {
try
match! aclApi.removeUsers (users) with
match! aclApi.removeUsers users with
| Ok _ ->
Log.Information $"Removed users %A{users}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -206,14 +206,14 @@ let deleteUsers (args: ParseResults<Prinicipal>) =
| Ok _ -> ()
| Error e -> Log.Error e
let deleteGroups (args: ParseResults<Prinicipal>) =
let groups = args.GetResult Prinicipal.Ids |> Array.ofList
let deleteGroups (args: PrincipalArgs) =
let groups = args.Ids |> Array.ofList
if args.Contains Prinicipal.Archive then
let aid = args.GetResult Prinicipal.Archive
if args.Archive.IsSome then
let aid = args.Archive |> Option.get
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.aclApi ()
async {
@@ -221,7 +221,7 @@ let deleteGroups (args: ParseResults<Prinicipal>) =
match! aclApi.removeGroups (aid, groups) with
| Ok _ ->
Log.Information $"Removed groups %A{groups} from archive {aid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -230,15 +230,15 @@ let deleteGroups (args: ParseResults<Prinicipal>) =
})
else
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let aclApi = api.adminApi ()
async {
try
match! aclApi.removeGroups (groups) with
match! aclApi.removeGroups groups with
| Ok _ ->
Log.Information $"Removed groups %A{groups}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e

174
src/Archivist/src/Cli/ArchiveCli.fs
View File

@@ -2,7 +2,6 @@ module ArchiveCli
open System
open System.IO
open Argu
open Serilog
open FSharpPlus
open Args
@@ -17,20 +16,20 @@ let inline private execAsync job =
| Ok _ -> ()
| Error e -> Log.Error e
let getArchiveId (args: ParseResults<AddArchive>) (idx: ArchiveIndex.ArchiveIndex) =
match args.TryGetResult AddArchive.Id with
let getArchiveId (args: AddArchiveArgs) (idx: ArchiveIndex.ArchiveIndex) =
match args.Id with
| Some id -> id
| None -> idx.archiveId
let getArchiveBasePath (args: ParseResults<AddArchive>) =
let getArchiveBasePath (args: AddArchiveArgs) =
let e = "neither index.json or base path specified"
let fs = args.GetResult AddArchive.Files
let fs = args.Files
match args.TryGetResult AddArchive.Index with
match args.Index with
| Some f -> getBasePath f
| None ->
if fs.Length = 1 then
// TODO: Handle exn
// TODO: Handle exn :/
if isDir fs[0] then
Path.GetFullPath fs[0]
else
@@ -42,25 +41,25 @@ let getArchiveBasePath (args: ParseResults<AddArchive>) =
let getModelAreaArchives modelId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.inventoryApi ()
cli.getModelAreaArchives (modelId, ArchiveType.FromString "*:*:*"))
let getArchive archiveId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.adminApi ()
cli.getArchiveDto archiveId)
let getFiles archiveId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.adminApi ()
cli.getFiles archiveId)
let getAllFiles archiveId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.adminApi ()
cli.getAllFiles archiveId)
@@ -78,7 +77,7 @@ let postArchive (idx, modelArea, basePath, files, reverse, json, published) =
let args = idx, modelArea, basePath, files, reverse, json, published
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let adminApi = api.adminApi ()
instantiateArchiveDto args
@@ -103,7 +102,7 @@ let postArchive (idx, modelArea, basePath, files, reverse, json, published) =
/// <param name="force">TODO: Whether to overwrite the archive when we find a conflicting ID</param>
let postSubArchive (force: bool) (dto: SubArchiveDef) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.archiveApi ()
cli.addSubArchive dto)
@@ -113,11 +112,14 @@ let postSubArchive (force: bool) (dto: SubArchiveDef) =
/// <param name="idx">Content of the archive's index file</param>
let postArchiveUpdate (idx: ArchiveIndex) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archiveApi = api.archiveApi ()
async {
match! archiveApi.getArchive idx.archiveId with
| Error err ->
failwith err
return Error err
| Ok _ ->
let form: Archmaester.Forms.ArchiveForm = {
name = idx.name
@@ -129,28 +131,28 @@ let postArchiveUpdate (idx: ArchiveIndex) =
}
return! archiveApi.updateArchive (idx.archiveId, form)
| Error err ->
failwith err
return Error err
})
let modifyArchive (args: ParseResults<ModifyArchive>) =
let aid = args.GetResult ModifyArchive.ArchiveId
let modifyArchive (args: ModifyArchiveArgs) =
let aid = args.ArchiveId
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archiveApi = api.archiveApi ()
let expiry = args.TryGetResult ModifyArchive.Expires |> Option.map DateTime.Parse
let points = args.TryGetResult ModifyArchive.Fence |> Option.map List.toArray
let expiry = args.Expires |> Option.map DateTime.Parse
let points = args.Fence |> Option.map List.toArray
async {
try
match! archiveApi.getArchive aid with
| Error e ->
Log.Error $"{e}"
return Error e
| Ok a ->
let form: Archmaester.Forms.ArchiveForm = {
name = args.GetResult(ModifyArchive.Name, a.name)
isPublished = args.GetResult(ModifyArchive.Published, a.isPublished)
isPublic = args.GetResult(ModifyArchive.Public, a.isPublic)
name = args.Name |> Option.defaultValue a.name
isPublished = args.Published |> Option.defaultValue a.isPublished
isPublic = args.Public |> Option.defaultValue a.isPublic
expires = expiry
json = if a.json = "" then None else Some a.json
geometry =
@@ -167,60 +169,57 @@ let modifyArchive (args: ParseResults<ModifyArchive>) =
|> fun y ->
Log.Debug $"%A{y}"
y
else a.polygon
else
a.polygon
}
return! archiveApi.updateArchive (aid, form)
| Error e ->
Log.Error $"{e}"
return Error e
with exn ->
return Error exn.Message
})
|> execAsync
let modifyArchiveAttribs (args: ParseResults<ModifyArchiveAttribs>) =
let aid = args.GetResult ModifyArchiveAttribs.ArchiveId
let modifyArchiveAttribs (args: ModifyArchiveAttribsArgs) =
let aid = args.ArchiveId
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let adminApi = api.adminApi ()
async {
try
if args.Contains ModifyArchiveAttribs.Add_Related then
let related = args.GetResult ModifyArchiveAttribs.Add_Related
if args.AddRelated.IsSome then
let related = args.AddRelated |> Option.get
let! _ = adminApi.addAssociation (aid, related)
()
if args.Contains ModifyArchiveAttribs.Remove_Related then
let related = args.GetResult ModifyArchiveAttribs.Remove_Related
if args.RemoveRelated.IsSome then
let related = args.RemoveRelated |> Option.get
let! _ = adminApi.removeAssociation (aid, related)
()
match! adminApi.getArchiveDto aid with
| Error e ->
Log.Error $"{e}"
return Error e
| Ok a ->
let form: Archmaester.Forms.ArchiveAttribsForm = {
description = args.GetResult(ModifyArchiveAttribs.Description, a.props.description)
basePath = args.GetResult(ModifyArchiveAttribs.Base_Path, a.files.basePath)
modelArea = args.GetResult(ModifyArchiveAttribs.Model_Area, a.props.modelArea)
focalpoint = args.GetResult(ModifyArchiveAttribs.Focal, a.props.focalPoint)
defaultZoom = args.GetResult(ModifyArchiveAttribs.Zoom, a.props.defaultZoom)
description = args.Description |> Option.defaultValue a.props.description
basePath = args.BasePath |> Option.defaultValue a.files.basePath
modelArea = args.ModelArea |> Option.defaultValue a.props.modelArea
focalpoint = args.Focal |> Option.defaultValue a.props.focalPoint
defaultZoom = args.Zoom |> Option.defaultValue a.props.defaultZoom
json = if a.json = "" then None else Some a.json
geometry = if a.polygon = [||] then None else Some a.polygon
}
return! adminApi.updateArchiveAttribs (aid, form)
| Error e ->
Log.Error $"{e}"
return Error e
with exn ->
return Error exn.Message
})
|> execAsync
let deleteArchives (args: ParseResults<Delete>) =
args.GetResult Delete.Archive |> retireArchive |> ignore
let deleteArchives (archive: string) = archive |> retireArchive |> ignore
let readDriftersInputJson file =
if File.Exists file then
@@ -229,23 +228,22 @@ let readDriftersInputJson file =
Log.Error $"Drifters input not found: {file}"
""
let rec addArchive (args: ParseResults<AddArchive>) =
let rec addArchive (args: AddArchiveArgs) =
let basePath = getArchiveBasePath args
let idx =
match args.TryGetResult AddArchive.Index with
match args.Index with
| Some ix -> ix
| None -> $"{basePath}/index.json"
|> readArchiveIdx
let files =
getArchiveFiles idx.archiveType basePath (args.GetResult AddArchive.Files |> Array.ofList)
let files = getArchiveFiles idx.archiveType basePath (args.Files |> Array.ofList)
let modelArea = initiateModelArea idx basePath
let json, reverse =
match idx.archiveType with
| Drifters(_, DriftersFormat.Particle) ->
| Drifters (_, DriftersFormat.Particle) ->
let s = readDriftersInputJson (Path.Join [| basePath; "input.json" |])
let r =
@@ -258,8 +256,8 @@ let rec addArchive (args: ParseResults<AddArchive>) =
match r with
| Ok x -> s, x
| Error e -> failwith e
| Drifters(_, DriftersFormat.Field2D)
| Drifters(_, DriftersFormat.Field3D) ->
| Drifters (_, DriftersFormat.Field2D)
| Drifters (_, DriftersFormat.Field3D) ->
let s = readDriftersInputJson (Path.Join [| basePath; "input.json" |])
let r =
@@ -274,29 +272,29 @@ let rec addArchive (args: ParseResults<AddArchive>) =
| Error e -> failwith e
| _ -> "", false
let published = args.GetResult(AddArchive.Published, defaultValue = true)
let published = args.Published |> Option.defaultValue true
let saveRes =
try
postArchive (idx, modelArea, basePath, files, reverse, json, published)
|> Async.RunSynchronously
with e ->
Log.Error(e, "Archivist.addArchive {ArchmaesterUrl}", Settings.archmaesterUrl)
Log.Error (e, "Archivist.addArchive {ArchmaesterUrl}", Settings.archmaesterUrl)
Error "Could not add archive"
match saveRes with
| Ok() -> Log.Information $"Successfully added archive %s{idx.name}"
| Ok () -> Log.Information $"Successfully added archive %s{idx.name}"
| Error err -> Log.Error $"Error: {err}"
let createSubArchive (args: ParseResults<SubArchive>) =
let createSubArchive (args: SubArchiveArgs) =
let fetchRefArchive = getArchive >> Async.RunSynchronously
let createSubArchive refArchive = {
uuid = Guid.NewGuid()
uuid = Guid.NewGuid ()
reference = refArchive.props.archiveId
name = args.GetResult SubArchive.Name
startFile = args.GetResult SubArchive.From
endFile = args.GetResult(SubArchive.To, defaultValue = Int32.MaxValue)
name = args.Name
startFile = args.From
endFile = args.To |> Option.defaultValue Int32.MaxValue
acl = {
owners = [||]
groups = [||]
@@ -306,12 +304,12 @@ let createSubArchive (args: ParseResults<SubArchive>) =
polygon = [||]
json = ""
isPublic = false
isPublished = args.GetResult(SubArchive.Published, defaultValue = true)
isPublished = args.Published |> Option.defaultValue true
}
let postSubArchive = postSubArchive false >> Async.RunSynchronously
fetchRefArchive (args.GetResult SubArchive.Ref)
fetchRefArchive args.Ref
|> Result.map createSubArchive
|> Result.bind postSubArchive
|> function
@@ -320,7 +318,7 @@ let createSubArchive (args: ParseResults<SubArchive>) =
let getAcl archiveId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.aclApi ()
cli.getAcl archiveId)
@@ -336,17 +334,17 @@ let printAcl acl =
acl.users |> formatAcl "users" |> (fun s -> printf $"{s}")
acl.groups |> formatAcl "groups" |> (fun s -> printf $"{s}")
let showArchive (args: ParseResults<ShowArchive>) =
let archiveId = args.GetResult ShowArchive.Archive
let showArchive (args: ShowArchiveArgs) =
let archiveId = args.ArchiveId
let fmt = "yyyy-MM-dd HH:mm"
async {
match! getArchive archiveId with
| Ok a ->
let! files =
if args.Contains ShowArchive.All then getAllFiles archiveId
elif args.Contains ShowArchive.Files then getFiles archiveId
else async.Return({ basePath = ""; series = [||] } |> Ok)
if args.All then getAllFiles archiveId
elif args.Files then getFiles archiveId
else async.Return ({ basePath = ""; series = [||] } |> Ok)
let! acl = getAcl archiveId
@@ -360,20 +358,20 @@ let showArchive (args: ParseResults<ShowArchive>) =
f.series
|> Array.iteri (fun n x ->
let name = String.truncate 32 x.name |> fun y -> y.PadRight(32, ' ')
printfn $" %-3d{n}: {name} | {x.startTime.ToString(fmt)} - {x.endTime.ToString(fmt)}")
let name = String.truncate 32 x.name |> fun y -> y.PadRight (32, ' ')
printfn $" %-3d{n}: {name} | {x.startTime.ToString (fmt)} - {x.endTime.ToString (fmt)}")
| Error e -> Log.Error e
| Error e -> Log.Error e
}
|> Async.RunSynchronously
let showRelatedArchives (args: ParseResults<ShowArchive>) =
let archiveId = args.GetResult ShowArchive.Archive
let showRelatedArchives (args: ShowArchiveArgs) =
let archiveId = args.ArchiveId
async {
let! r =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let cli = api.inventoryApi ()
cli.getAssociated (archiveId, ArchiveType.Any))
// cli.getRelated(archiveId, Atmo(AtmoVariant.Any, AtmoFormat.Any)))
@@ -383,12 +381,12 @@ let showRelatedArchives (args: ParseResults<ShowArchive>) =
}
|> Async.RunSynchronously
let augmentArchive (args: ParseResults<Augment>) =
let aid = args.GetResult Augment.Archive
let fnames = args.GetResult Augment.Files |> List.map Path.GetFullPath
let augmentArchive (args: AugmentArgs) =
let aid = args.Archive
let fnames = args.Files |> List.map Path.GetFullPath
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archmaester = api.adminApi ()
async {
@@ -402,7 +400,7 @@ let augmentArchive (args: ParseResults<Augment>) =
|> traverse (readDataSet a)
|> Result.bind (fun files ->
let _, _, t = List.head files
let startUtc = t.ToUniversalTime()
let startUtc = t.ToUniversalTime ()
let f = Array.ofList files
ensureContiguous startUtc archive.props.freq f |> Result.map fst)
@@ -414,8 +412,8 @@ let augmentArchive (args: ParseResults<Augment>) =
name = stripBasePath archive.files.basePath name
frames = frames
ordering = 0
startTime = t.ToUniversalTime()
endTime = t.AddSeconds(archive.props.freq * frames |> float)
startTime = t.ToUniversalTime ()
endTime = t.AddSeconds (archive.props.freq * frames |> float)
reverse = reverse
})
@@ -428,27 +426,27 @@ let augmentArchive (args: ParseResults<Augment>) =
})
|> execAsync
let resizeArchive (args: ParseResults<Resize>) =
let aid = args.GetResult Resize.Archive
let first = args.GetResult(Resize.From, Int32.MinValue)
let last = args.GetResult(Resize.To, Int32.MaxValue)
let resizeArchive (args: ResizeArgs) =
let aid = args.Archive
let first = args.From
let last = args.To |> Option.defaultValue Int32.MaxValue
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archmaester = api.archiveApi ()
async { return! archmaester.resizeArchive (aid, first, last) })
|> execAsync
let addType (t: string) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let adminApi = api.adminApi ()
async { return! adminApi.addType t })
|> execAsync
let deleteType (t: string) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let adminApi = api.adminApi ()
async { return! adminApi.removeType t })
|> execAsync

3
src/Archivist/src/Cli/Archivist.fsproj
View File

@@ -3,6 +3,7 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net9.0</TargetFramework>
<AssemblyName>archivist</AssemblyName>
<Version>7.1.0</Version>
</PropertyGroup>
<ItemGroup>
@@ -16,7 +17,7 @@
<Compile Include="Main.fs"/>
</ItemGroup>
<ItemGroup>
<PackageReference Include="Argu" Version="6.2.5"/>
<PackageReference Include="Fargo.CmdLine" Version="1.7.5"/>
<PackageReference Include="FSharp.Data" Version="6.4.1"/>
<PackageReference Include="FSharpPlus" Version="1.7.0"/>
<PackageReference Include="Microsoft.EntityFrameworkCore" Version="9.0.1"/>

813
src/Archivist/src/Cli/Args.fs
View File

@@ -2,319 +2,552 @@ module Args
open System
open System.IO
open Argu
open Fargo
open Fargo.Operators
open Archmaester.Dto
let colorizer =
function
| ErrorCode.HelpText -> None
| _ -> Some ConsoleColor.Red
let errorHandler = ProcessExiter(colorizer = colorizer)
open Serilog
let showVersion () =
let assembly = System.Reflection.Assembly.GetExecutingAssembly()
let version = System.Diagnostics.FileVersionInfo.GetVersionInfo assembly.Location
printfn $"{version.FileVersion}"
type ListArchive =
| All
| Retired
| Refs
| Type of string
| Owner of string
| User of string
| Group of string
| Archive_Name of string: string
| Model_Name of string: string
| [<AltCommandLine("-V")>] Verbose
| Json
interface IArgParserTemplate with
member this.Usage =
match this with
| All -> "List all archives"
| Refs -> "List referencing archives"
| Retired -> "List retired archives"
| Type _ -> "List archives of the given type"
| Owner _ -> "List archives owned by user"
| User _ -> "List archives for user"
| Group _ -> "Remove archives for group"
| Archive_Name _ -> "List archives matching pattern"
| Model_Name _ -> "List archives matching model area"
| Verbose -> "Detailed listing"
| Json -> "Json output"
type CmdType =
| ListCmd
| ShowCmd
| AddCmd
| DeleteCmd
| ModifyCmd
| AugmentCmd
| ResizeCmd
type ListModel =
| Model_Name of regex: string
| Verbose
| Json
interface IArgParserTemplate with
member this.Usage =
match this with
| Model_Name _ -> "List models matching regex"
| Verbose -> "Detailed listing"
| Json -> "Json output"
type ListType =
| Archives
| Models
| Types
type List =
| [<CliPrefix(CliPrefix.None); AltCommandLine("a")>] Archives of ParseResults<ListArchive>
| [<CliPrefix(CliPrefix.None); AltCommandLine("m")>] Models of ParseResults<ListModel>
| [<CliPrefix(CliPrefix.None); AltCommandLine("t")>] Types
interface IArgParserTemplate with
member this.Usage =
match this with
| Archives _ -> "List archives"
| Models _ -> "List models"
| Types -> "List types"
type ShowType =
| Archive
| Model
type ShowArchive =
| All
| Refs
| Related
| Files
| Json
| [<MainCommand; Last>] Archive of id: ArchiveId
interface IArgParserTemplate with
member this.Usage =
match this with
| Json -> "Json output"
| Refs -> "List archives referencing archive"
| Related -> "List related archives"
| Files -> "List file names"
| All -> "List all available files (for resize)"
| Archive _ -> "Archive id"
type AddType =
| Archive
| Sub
| Model
| Owner
| User
| Group
| Type
type ShowModel =
| Verbose
| Json
| [<MainCommand; Last>] Model of id: ModelAreaId
interface IArgParserTemplate with
member this.Usage =
match this with
| Model _ -> "Model id"
| Verbose -> "Detailed listing"
| Json -> "Json output"
type DeleteType =
| Archive
| Model
| Owner
| User
| Group
| Type
type Show =
| [<CliPrefix(CliPrefix.None); AltCommandLine("a")>] Archive of ParseResults<ShowArchive>
| [<CliPrefix(CliPrefix.None); AltCommandLine("m")>] Model of ParseResults<ShowModel>
interface IArgParserTemplate with
member this.Usage =
match this with
| Archive _ -> "List archive"
| Model _ -> "List model"
type ModifyType =
| Archive
| ArchiveAttribs
| Model
type AddArchive =
| Index of index: string
| No_sort
| Id of guid: ArchiveId
| Force
| Published of bool
| [<MainCommand; Last>] Files of files: string list
interface IArgParserTemplate with
member this.Usage =
match this with
| No_sort -> "No sorting of files"
| Index _ -> "index.json"
| Id _ -> "Archive id to update"
| Files _ -> "Files to add"
| Force -> "Forcefully add or update"
| Published _ -> "Publish archive (default: true)"
type ListArchiveArgs = {
All: bool
Retired: bool
Refs: bool
Type: string option
Owner: string option
User: string option
Group: string option
ArchiveName: string option
ModelName: string option
Verbose: bool
Json: bool
}
type SubArchive =
| [<Mandatory>] Ref of guid: ArchiveId
| [<Mandatory>] From of first: int
| To of last: int
| Published of bool
| [<MainCommand; Last>] Name of name: string
interface IArgParserTemplate with
member this.Usage =
match this with
| Ref _ -> "Reference archive"
| From _ -> "Index of first file to include"
| To _ -> "Index of last file to include"
| Published _ -> "Publish archive (default: true)"
| Name _ -> "Name of the new archive"
type ListModelArgs = { ModelName: string option; Verbose: bool; Json: bool }
type AddModel =
| [<MainCommand; Last>] File of json: string
interface IArgParserTemplate with
member this.Usage =
match this with
| File _ -> "model.json"
type ShowArchiveArgs = {
All: bool
Refs: bool
Related: bool
Files: bool
Json: bool
ArchiveId: ArchiveId
}
type Prinicipal =
| Archive of id: ArchiveId
| [<MainCommand; Last>] Ids of name: string list
interface IArgParserTemplate with
member this.Usage =
match this with
| Archive _ -> "Apply to archive"
| Ids _ -> "Identies"
type ShowModelArgs = { Verbose: bool; Json: bool; ModelId: ModelAreaId }
type Add =
| [<CliPrefix(CliPrefix.None); AltCommandLine("a")>] Archive of ParseResults<AddArchive>
| [<CliPrefix(CliPrefix.None); AltCommandLine("s")>] Sub of ParseResults<SubArchive>
| [<CliPrefix(CliPrefix.None); AltCommandLine("m")>] Model of ParseResults<AddModel>
| [<CliPrefix(CliPrefix.None); AltCommandLine("o")>] Owner of ParseResults<Prinicipal>
| [<CliPrefix(CliPrefix.None); AltCommandLine("u")>] User of ParseResults<Prinicipal>
| [<CliPrefix(CliPrefix.None); AltCommandLine("g")>] Group of ParseResults<Prinicipal>
| [<CliPrefix(CliPrefix.None); AltCommandLine("t")>] Type of string
interface IArgParserTemplate with
member this.Usage =
match this with
| Archive _ -> "Add archive"
| Sub _ -> "Add sub-archive"
| Model _ -> "Add model"
| Owner _ -> "Add owner"
| User _ -> "Add user"
| Group _ -> "Add group"
| Type _ -> "Add type"
type AddArchiveArgs = {
Index: string option
NoSort: bool
Id: ArchiveId option
Force: bool
Published: bool option
Files: string list
}
type DeleteModel =
| Force
| [<MainCommand; Last>] Model of id: ModelAreaId
interface IArgParserTemplate with
member this.Usage =
match this with
| Force -> "Force delete"
| Model _ -> "Model id"
type SubArchiveArgs = {
Ref: ArchiveId
From: int
To: int option
Published: bool option
Name: string
}
type Delete =
| [<CliPrefix(CliPrefix.None); AltCommandLine("a")>] Archive of id: string
| [<CliPrefix(CliPrefix.None); AltCommandLine("m")>] Model of ParseResults<DeleteModel>
| [<CliPrefix(CliPrefix.None); AltCommandLine("o")>] Owner of ParseResults<Prinicipal>
| [<CliPrefix(CliPrefix.None); AltCommandLine("u")>] User of ParseResults<Prinicipal>
| [<CliPrefix(CliPrefix.None); AltCommandLine("g")>] Group of ParseResults<Prinicipal>
| [<CliPrefix(CliPrefix.None); AltCommandLine("t")>] Type of string
interface IArgParserTemplate with
member this.Usage =
match this with
| Archive _ -> "Delete archive"
| Model _ -> "Delete model"
| Owner _ -> "Delete owner"
| User _ -> "Delete user"
| Group _ -> "Delete group"
| Type _ -> "Delete type"
type AddModelArgs = { File: string }
type ModifyArchiveAttribs =
| Base_Path of string
| Projection of string
| Description of string
| Focal of single * single
| Zoom of single
| Retired of bool
| Polygon of file: string
| Model_Area of id: ModelAreaId
| Json of json: string
| Add_Related of ArchiveId
| Remove_Related of ArchiveId
| [<MainCommand; Last>] ArchiveId of id: ModelAreaId
interface IArgParserTemplate with
member this.Usage =
match this with
| Base_Path _ -> ""
| Projection _ -> ""
| Description _ -> ""
| Focal _ -> ""
| Zoom _ -> ""
| Retired _ -> ""
| Polygon _ -> ""
| Model_Area _ -> "'"
| Json _ -> "'"
| Add_Related _ -> ""
| Remove_Related _ -> ""
| ArchiveId _ -> ""
type PrincipalArgs = { Archive: ArchiveId option; Ids: string list }
type ModifyArchive =
| Name of string
| Published of bool
| Public of bool
| Expires of datetime: string
| Json of file: string
| Fence of string list
| End
| [<MainCommand; Last>] ArchiveId of id: ArchiveId
interface IArgParserTemplate with
member this.Usage =
match this with
| Name _ -> "Name of archive"
| Published _ -> "Publish archive"
| Public _ -> "Make archive public (careful!)"
| Expires _ -> "Set expiry"
| Json _ -> "Any json you fancy"
| Fence _ -> "Geofence points given as 'lng,lat',..."
| End -> "End fence list (sic)"
| ArchiveId _ -> "Archive to modify"
type DeleteModelArgs = { Force: bool; ModelId: ModelAreaId }
type ModifyModel =
| Name of string
| Description of string
| Focal of single * single
| Zoom of single
| Polygon of file: string
| Projection of string
| [<MainCommand; Last>] ModelId of id: ModelAreaId
interface IArgParserTemplate with
member this.Usage =
match this with
| Name _ -> ""
| Description _ -> ""
| Focal _ -> ""
| Zoom _ -> ""
| Polygon _ -> "Bounding polygon file"
| Projection _ -> "Projection of bounding polygon"
| ModelId _ -> ""
type ModifyArchiveArgs = {
Name: string option
Published: bool option
Public: bool option
Expires: string option
Json: string option
Fence: string list option
End: bool
ArchiveId: ArchiveId
}
type Modify =
| [<CliPrefix(CliPrefix.None); AltCommandLine("a")>] Archive of ParseResults<ModifyArchive>
| [<CliPrefix(CliPrefix.None); AltCommandLine("t")>] ArchiveAttribs of ParseResults<ModifyArchiveAttribs>
| [<CliPrefix(CliPrefix.None); AltCommandLine("m")>] Model of ParseResults<ModifyModel>
interface IArgParserTemplate with
member this.Usage =
match this with
| Archive _ -> "Modify archive"
| ArchiveAttribs _ -> "Modify archive attribs"
| Model _ -> "Modify model"
type ModifyArchiveAttribsArgs = {
BasePath: string option
Projection: string option
Description: string option
Focal: (single * single) option
Zoom: single option
Retired: bool option
Polygon: string option
ModelArea: ModelAreaId option
Json: string option
AddRelated: ArchiveId option
RemoveRelated: ArchiveId option
ArchiveId: ModelAreaId
}
type Augment =
| [<Mandatory>] Archive of guid: ArchiveId
| [<MainCommand; Last>] Files of name: string list
interface IArgParserTemplate with
member this.Usage =
match this with
| Archive _ -> "Archive id to augment"
| Files _ -> "Files to add"
type ModifyModelArgs = {
Name: string option
Description: string option
Focal: (single * single) option
Zoom: single option
Polygon: string option
Projection: string option
ModelId: ModelAreaId
}
type Resize =
| [<Mandatory>] From of first: int
| To of last: int
| [<MainCommand; Last>] Archive of id: ArchiveId
interface IArgParserTemplate with
member this.Usage =
match this with
| From _ -> "Index of first file to include"
| To _ -> "Index of last file to include"
| Archive _ -> "Archive to resize"
type AugmentArgs = { Archive: ArchiveId; Files: string list }
type Verbs =
| [<CliPrefix(CliPrefix.None)>] Add of ParseResults<Add>
| [<CliPrefix(CliPrefix.None); AltCommandLine([| "ls" |])>] List of ParseResults<List>
| [<CliPrefix(CliPrefix.None)>] Show of ParseResults<Show>
| [<CliPrefix(CliPrefix.None); AltCommandLine([| "rm" |])>] Delete of ParseResults<Delete>
| [<CliPrefix(CliPrefix.None)>] Modify of ParseResults<Modify>
| [<CliPrefix(CliPrefix.None)>] Augment of ParseResults<Augment>
| [<CliPrefix(CliPrefix.None)>] Resize of ParseResults<Resize>
| Log_Level of level: int
| [<AltCommandLine("-v")>] Version
interface IArgParserTemplate with
member this.Usage =
match this with
| List _ -> "List entities"
| Show _ -> "Show entities"
| Add _ -> "Add entities"
| Modify _ -> "Modify entities"
| Delete _ -> "Delete entities"
| Augment _ -> "Augment archive"
| Resize _ -> "Resize archive"
| Log_Level _ -> "0=Error, 1=Warning, 2=Info, 3=Debug, 4=Verbose"
| Version -> "Show the current version"
type ResizeArgs = { From: int; To: int option; Archive: ArchiveId }
type Command =
| ListArchives of ListArchiveArgs
| ListModels of ListModelArgs
| ListTypes of int
| ShowArchive of ShowArchiveArgs
| ShowModel of ShowModelArgs
| AddArchive of AddArchiveArgs
| AddSub of SubArchiveArgs
| AddModel of AddModelArgs
| AddOwner of PrincipalArgs
| AddUser of PrincipalArgs
| AddGroup of PrincipalArgs
| AddType of string
| DeleteArchive of string
| DeleteModel of DeleteModelArgs
| DeleteOwner of PrincipalArgs
| DeleteUser of PrincipalArgs
| DeleteGroup of PrincipalArgs
| DeleteType of string
| ModifyArchive of ModifyArchiveArgs
| ModifyArchiveAttribs of ModifyArchiveAttribsArgs
| ModifyModel of ModifyModelArgs
| Augment of AugmentArgs
| Resize of ResizeArgs
| Version of int
let parseArchiveId (s: string) =
match ArchiveId.TryParse s with
| true, g -> Ok g
| false, _ -> Error "Invalid archive ID format"
let parseModelAreaId (s: string) =
match ModelAreaId.TryParse s with
| true, g -> Ok g
| false, _ -> Error "Invalid model area ID format"
let parseFocal (s: string) =
let parts = s.Split ','
if parts.Length = 2 then
match Single.TryParse parts.[0], Single.TryParse parts.[1] with
| (true, x), (true, y) -> Ok (x, y)
| _ -> Error "Invalid focal point format (should be 'x,y')"
else
Error "Invalid focal point format (should be 'x,y')"
let argParser: Arg<Command * int> =
fargo {
let! logLevel =
opt "log-level" null "level" "Log level (0=Error, 1=Warning, 2=Info, 3=Debug, 4=Verbose)"
|> optParse (fun s ->
match Int32.TryParse s with
| true, v when v >= 0 && v <= 4 -> Ok v
| true, _ -> Error "Log level must be between 0 and 4"
| false, _ -> Error "Invalid log level value")
|> defaultValue 2
let! version = flag "version" "v" "Show version"
if version then
return Version logLevel, logLevel
else
match!
cmd "list" "ls" "List entities" |>> CmdType.ListCmd
<|> (cmd "show" "s" "Show entity details" |>> CmdType.ShowCmd)
<|> (cmd "add" "a" "Add entities" |>> CmdType.AddCmd)
<|> (cmd "delete" "rm" "Delete entities" |>> CmdType.DeleteCmd)
<|> (cmd "modify" "m" "Modify entities" |>> CmdType.ModifyCmd)
<|> (cmd "augment" "au" "Augment archive" |>> CmdType.AugmentCmd)
<|> (cmd "resize" "r" "Resize archive" |>> CmdType.ResizeCmd)
with
| CmdType.ListCmd ->
match!
cmd "archives" "a" "List archives" |>> ListType.Archives
<|> (cmd "models" "m" "List models" |>> ListType.Models)
<|> (cmd "types" "t" "List types" |>> ListType.Types)
with
| ListType.Archives ->
let! all = flag "all" null "List all archives"
and! retired = flag "retired" null "List retired archives"
and! refs = flag "refs" null "List referencing archives"
and! archType = opt "type" null "type" "List archives of the given type"
and! owner = opt "owner" null "user" "List archives owned by user"
and! user = opt "user" null "user" "List archives for user"
and! group = opt "group" null "group" "List archives for group"
and! archiveName = opt "archive-name" null "pattern" "List archives matching pattern"
and! modelName = opt "model-name" null "pattern" "List archives matching model area"
and! verbose = flag "verbose" "V" "Detailed listing"
and! json = flag "json" null "Json output"
return
ListArchives {
All = all
Retired = retired
Refs = refs
Type = archType
Owner = owner
User = user
Group = group
ArchiveName = archiveName
ModelName = modelName
Verbose = verbose
Json = json
},
logLevel
| ListType.Models ->
let! modelName = opt "model-name" null "regex" "List models matching regex"
and! verbose = flag "verbose" null "Detailed listing"
and! json = flag "json" null "Json output"
return ListModels { ModelName = modelName; Verbose = verbose; Json = json }, logLevel
| ListType.Types -> return ListTypes logLevel, logLevel
| CmdType.ShowCmd ->
match!
cmd "archive" "a" "Show archive details" |>> ShowType.Archive
<|> (cmd "model" "m" "Show model details" |>> ShowType.Model)
with
| ShowType.Archive ->
let! all = flag "all" null "List all available files (for resize)"
and! refs = flag "refs" null "List archives referencing archive"
and! related = flag "related" null "List related archives"
and! files = flag "files" null "List file names"
and! json = flag "json" null "Json output"
and! archiveId = arg "archive-id" "Archive ID" |> reqArg |> parse parseArchiveId
return
ShowArchive {
All = all
Refs = refs
Related = related
Files = files
Json = json
ArchiveId = archiveId
},
logLevel
| ShowType.Model ->
let! verbose = flag "verbose" null "Detailed listing"
and! json = flag "json" null "Json output"
and! modelId = arg "model-id" "Model ID" |> reqArg |> parse parseModelAreaId
return ShowModel { Verbose = verbose; Json = json; ModelId = modelId }, logLevel
| CmdType.AddCmd ->
match!
cmd "archive" "a" "Add archive" |>> AddType.Archive
<|> (cmd "sub" "s" "Add sub-archive" |>> AddType.Sub)
<|> (cmd "model" "m" "Add model" |>> AddType.Model)
<|> (cmd "owner" "o" "Add owner" |>> AddType.Owner)
<|> (cmd "user" "u" "Add user" |>> AddType.User)
<|> (cmd "group" "g" "Add group" |>> AddType.Group)
<|> (cmd "type" "t" "Add type" |>> AddType.Type)
with
| AddType.Archive ->
let! index = opt "index" null "file" "index.json"
and! noSort = flag "no-sort" null "No sorting of files"
and! id = opt "id" null "guid" "Archive id to update" |> optParse parseArchiveId
and! force = flag "force" null "Forcefully add or update"
and! published =
opt "published" null "bool" "Publish archive (default: true)"
|> optParse (fun s ->
match Boolean.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid boolean value")
and! files = arg "files" "Files to add" |> Pipe.orStdIn |> nonEmpty "No files to add" |> listParse (fun s ->
if File.Exists s then Ok s
else Error $"File '{s}' does not exist")
return
AddArchive {
Index = index
NoSort = noSort
Id = id
Force = force
Published = published
Files = files
},
logLevel
| AddType.Sub ->
let! refId = opt "ref" null "guid" "Reference archive" |> optParse parseArchiveId |> reqOpt
and! from =
opt "from" null "int" "Index of first file to include"
|> optParse (fun s ->
match Int32.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid integer value")
|> reqOpt
and! to' =
opt "to" null "int" "Index of last file to include"
|> optParse (fun s ->
match Int32.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid integer value")
and! published =
opt "published" null "bool" "Publish archive (default: true)"
|> optParse (fun s ->
match Boolean.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid boolean value")
and! name = arg "name" "Name of the new archive" |> reqArg
return
AddSub {
Ref = refId
From = from
To = to'
Published = published
Name = name
},
logLevel
| AddType.Model ->
let! file = arg "file" "model.json" |> reqArg
return AddModel { File = file }, logLevel
| AddType.Owner ->
let! archive = opt "archive" null "id" "Apply to archive" |> optParse parseArchiveId
and! ids = arg "ids" "Identities" |> Pipe.orStdIn |> nonEmpty "No ids to add" |> listParse (Int32.TryParse >> function
| true, v -> Ok (string v)
| false, _ -> Error "Invalid integer value")
return AddOwner { Archive = archive; Ids = ids }, logLevel
| AddType.User ->
let! archive = opt "archive" null "id" "Apply to archive" |> optParse parseArchiveId
and! ids = arg "ids" "Identities" |> Pipe.orStdIn |> nonEmpty "No ids to add" |> listParse (Int32.TryParse >> function
| true, v -> Ok (string v)
| false, _ -> Error "Invalid integer value")
return AddUser { Archive = archive; Ids = ids }, logLevel
| AddType.Group ->
let! archive = opt "archive" null "id" "Apply to archive" |> optParse parseArchiveId
and! ids = arg "ids" "Identities" |> Pipe.orStdIn |> nonEmpty "No ids to add" |> listParse (Int32.TryParse >> function
| true, v -> Ok (string v)
| false, _ -> Error "Invalid integer value")
return AddGroup { Archive = archive; Ids = ids }, logLevel
| AddType.Type ->
let! typeName = arg "type" "Type name" |> reqArg
return AddType typeName, logLevel
| CmdType.DeleteCmd ->
match!
cmd "archive" "a" "Delete archive" |>> DeleteType.Archive
<|> (cmd "model" "m" "Delete model" |>> DeleteType.Model)
<|> (cmd "owner" "o" "Delete owner" |>> DeleteType.Owner)
<|> (cmd "user" "u" "Delete user" |>> DeleteType.User)
<|> (cmd "group" "g" "Delete group" |>> DeleteType.Group)
<|> (cmd "type" "t" "Delete type" |>> DeleteType.Type)
with
| DeleteType.Archive ->
let! id = arg "id" "Archive ID" |> reqArg
return DeleteArchive id, logLevel
| DeleteType.Model ->
let! force = flag "force" null "Force delete"
and! modelId = arg "model-id" "Model ID" |> reqArg |> parse parseModelAreaId
return DeleteModel { Force = force; ModelId = modelId }, logLevel
| DeleteType.Owner ->
let! archive = opt "archive" null "id" "Apply to archive" |> optParse parseArchiveId
and! ids = arg "ids" "Identities" |> Pipe.orStdIn |> nonEmpty "No ids to add" |> listParse (Int32.TryParse >> function
| true, v -> Ok (string v)
| false, _ -> Error "Invalid integer value")
return DeleteOwner { Archive = archive; Ids = ids }, logLevel
| DeleteType.User ->
let! archive = opt "archive" null "id" "Apply to archive" |> optParse parseArchiveId
and! ids = arg "ids" "Identities" |> Pipe.orStdIn |> nonEmpty "No ids to add" |> listParse (Int32.TryParse >> function
| true, v -> Ok (string v)
| false, _ -> Error "Invalid integer value")
return DeleteUser { Archive = archive; Ids = ids }, logLevel
| DeleteType.Group ->
let! archive = opt "archive" null "id" "Apply to archive" |> optParse parseArchiveId
and! ids = arg "ids" "Identities" |> Pipe.orStdIn |> nonEmpty "No ids to add" |> listParse (Int32.TryParse >> function
| true, v -> Ok (string v)
| false, _ -> Error "Invalid integer value")
return DeleteGroup { Archive = archive; Ids = ids }, logLevel
| DeleteType.Type ->
let! typeName = arg "type" "Type name" |> reqArg
return DeleteType typeName, logLevel
| CmdType.ModifyCmd ->
match!
cmd "archive" "a" "Modify archive" |>> ModifyType.Archive
<|> (cmd "archive-attribs" "t" "Modify archive attributes"
|>> ModifyType.ArchiveAttribs)
<|> (cmd "model" "m" "Modify model" |>> ModifyType.Model)
with
| ModifyType.Archive ->
let! name = opt "name" null "name" "Name of archive"
and! published =
opt "published" null "bool" "Publish archive"
|> optParse (fun s ->
match Boolean.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid boolean value")
and! public' =
opt "public" null "bool" "Make archive public (careful!)"
|> optParse (fun s ->
match Boolean.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid boolean value")
and! expires = opt "expires" null "datetime" "Set expiry"
and! json = opt "json" null "file" "Any json you fancy"
and! fence =
opt "fence" null "points" "Geofence points given as 'lng,lat',...'"
|> optParse (fun s -> Ok (s.Split (',') |> Array.toList))
and! endFlag = flag "end" null "End fence list (sic)"
and! archiveId = arg "archive-id" "Archive to modify" |> reqArg |> parse parseArchiveId
return
ModifyArchive {
Name = name
Published = published
Public = public'
Expires = expires
Json = json
Fence = fence
End = endFlag
ArchiveId = archiveId
},
logLevel
| ModifyType.ArchiveAttribs ->
let! basePath = opt "base-path" null "path" "Base path"
and! projection = opt "projection" null "proj" "Projection"
and! description = opt "description" null "desc" "Description"
and! focal = opt "focal" null "x,y" "Focal point" |> optParse parseFocal
and! zoom =
opt "zoom" null "level" "Zoom level"
|> optParse (fun s ->
match Single.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid float value")
and! retired =
opt "retired" null "bool" "Retired status"
|> optParse (fun s ->
match Boolean.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid boolean value")
and! polygon = opt "polygon" null "file" "Polygon file"
and! modelArea = opt "model-area" null "id" "Model area ID" |> optParse parseModelAreaId
and! json = opt "json" null "json" "JSON data"
and! addRelated = opt "add-related" null "id" "Add related archive" |> optParse parseArchiveId
and! removeRelated =
opt "remove-related" null "id" "Remove related archive"
|> optParse parseArchiveId
and! archiveId = arg "archive-id" "Archive ID" |> reqArg |> parse parseModelAreaId
return
ModifyArchiveAttribs {
BasePath = basePath
Projection = projection
Description = description
Focal = focal
Zoom = zoom
Retired = retired
Polygon = polygon
ModelArea = modelArea
Json = json
AddRelated = addRelated
RemoveRelated = removeRelated
ArchiveId = archiveId
},
logLevel
| ModifyType.Model ->
let! name = opt "name" null "name" "Model name"
and! description = opt "description" null "desc" "Description"
and! focal = opt "focal" null "x,y" "Focal point" |> optParse parseFocal
and! zoom =
opt "zoom" null "level" "Zoom level"
|> optParse (fun s ->
match Single.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid float value")
and! polygon = opt "polygon" null "file" "Bounding polygon file"
and! projection = opt "projection" null "proj" "Projection of bounding polygon"
and! modelId = arg "model-id" "Model ID" |> reqArg |> parse parseModelAreaId
return
ModifyModel {
Name = name
Description = description
Focal = focal
Zoom = zoom
Polygon = polygon
Projection = projection
ModelId = modelId
},
logLevel
| CmdType.AugmentCmd ->
let! archive =
opt "archive" null "guid" "Archive id to augment"
|> optParse parseArchiveId
|> reqOpt
and! files = arg "files" "Files to add" |> Pipe.orStdIn |> nonEmpty "No files to add" |> listParse (fun s ->
if File.Exists s then Ok s
else Error $"File '{s}' does not exist")
return Augment { Archive = archive; Files = files }, logLevel
| CmdType.ResizeCmd ->
let! from =
opt "from" null "int" "Index of first file to include"
|> optParse (fun s ->
match Int32.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid integer value")
|> reqOpt
and! to' =
opt "to" null "int" "Index of last file to include"
|> optParse (fun s ->
match Int32.TryParse s with
| true, v -> Ok v
| false, _ -> Error "Invalid integer value")
and! archive = arg "archive" "Archive to resize" |> reqArg |> parse parseArchiveId
return Resize { From = from; To = to'; Archive = archive }, logLevel
}

84
src/Archivist/src/Cli/Listing.fs
View File

@@ -2,7 +2,6 @@ module Listing
open System.Text.RegularExpressions
open Archmaester.Dto
open Argu
open FSharpPlus
open Serilog
open Args
@@ -21,8 +20,10 @@ let listModels verbose (filterM: ModelArea -> bool) (filterA: ArchiveProps -> bo
|> Result.map (
Array.filter filterM
>> Array.iter (fun m ->
let archives = ArchiveCli.getModelAreaArchives m.modelAreaId |> Async.RunSynchronously
let archives =
ArchiveCli.getModelAreaArchives m.modelAreaId |> Async.RunSynchronously
match archives with
| Error e -> Log.Error e
| Ok arch ->
let ax = arch |> Array.filter filterA
@@ -32,67 +33,64 @@ let listModels verbose (filterM: ModelArea -> bool) (filterA: ArchiveProps -> bo
else
Utils.printModelTerse m
Utils.printArchivesTerse ax
printfn ""
| Error e -> Log.Error e)
printfn "")
)
|> Result.defaultWith (fun e -> Log.Error("Listing.listModels error fetching model areas {Error}", e))
|> Result.defaultWith (fun e -> Log.Error ("Listing.listModels error fetching model areas {Error}", e))
let listArchives (args: ParseResults<ListArchive>) =
let verbose = args.Contains ListArchive.Verbose
let retired = args.Contains ListArchive.Retired
let listArchives (args: ListArchiveArgs) =
let verbose = args.Verbose
let retired = args.Retired
let matchO (a: ArchiveDto) =
if args.Contains ListArchive.Owner then
let pat = args.GetResult ListArchive.Owner
a.acl.owners |> Array.exists (fun y -> Regex.IsMatch(y, pat))
else
true
match args.Owner with
| None -> true
| Some owner ->
let pat = owner
a.acl.owners |> Array.exists (fun y -> Regex.IsMatch (y, pat))
let matchU (a: ArchiveDto) =
if args.Contains ListArchive.User then
let pat = args.GetResult ListArchive.User
a.acl.users |> Array.exists (fun y -> Regex.IsMatch(y, pat))
|| a.acl.owners |> Array.exists (fun y -> Regex.IsMatch(y, pat))
else
true
match args.User with
| None -> true
| Some user ->
let pat = user
a.acl.users |> Array.exists (fun y -> Regex.IsMatch (y, pat))
|| a.acl.owners |> Array.exists (fun y -> Regex.IsMatch (y, pat))
let matchG (a: ArchiveDto) =
if args.Contains ListArchive.Group then
let pat = args.GetResult ListArchive.Group
a.acl.groups |> Array.exists (fun y -> Regex.IsMatch(y, pat))
else
true
match args.Group with
| None -> true
| Some group ->
let pat = group
a.acl.groups |> Array.exists (fun y -> Regex.IsMatch (y, pat))
let matchM (m: ModelArea) =
if args.Contains ListArchive.Model_Name then
let pat = args.GetResult ListArchive.Model_Name
Regex.IsMatch(m.name, pat)
else
true
match args.ModelName with
| None -> true
| Some modelName ->
let pat = modelName
Regex.IsMatch (m.name, pat)
let matchA (a: ArchiveProps) =
if args.Contains Archive_Name then
let pat = args.GetResult Archive_Name
printfn "List Archives pattern %s" pat
Regex.IsMatch(a.name, pat)
else
true
match args.ArchiveName with
| None -> true
| Some archiveName ->
let pat = archiveName
printfn $"List Archives pattern %s{pat}"
Regex.IsMatch (a.name, pat)
let matchBox (a: ArchiveProps) =
matchA a //&& matchO a && matchU a && matchG a
// NOTE: Only checks for archive props
let matchBox (a: ArchiveProps) = matchA a //&& matchO a && matchU a && matchG a
if args.Contains ListArchive.All then
if args.All then
listModels verbose matchM matchA
elif args.Contains ListArchive.Type then
elif args.Type.IsSome then
let t =
let spec = args.GetResult ListArchive.Type
let spec = args.Type |> Option.get
try
ArchiveType.FromString spec
with _ ->
Log.Warning $"Unknown archive type: {spec}"
Log.Warning $"Unknown archive type: %s{spec}"
ArchiveType.Any
let archiveF (a: ArchiveProps) = a.archiveType = t && matchBox a

181
src/Archivist/src/Cli/Main.fs
View File

@@ -2,7 +2,7 @@ module Archivist
open Serilog
open Serilog.Events
open Argu
open Fargo
open Args
let configureSerilog level =
@@ -17,103 +17,96 @@ let configureSerilog level =
LoggerConfiguration()
.MinimumLevel.Is(n)
.WriteTo.Console(theme = Serilog.Sinks.SystemConsole.Themes.ConsoleTheme.None)
.CreateLogger()
.CreateLogger ()
let addHandler (args: ParseResults<Add>) =
if args.Contains Add.Archive then
ArchiveCli.addArchive (args.GetResult Add.Archive)
elif args.Contains Add.Sub then
ArchiveCli.createSubArchive (args.GetResult Add.Sub)
elif args.Contains Add.Model then
ModelAreaCli.addModel (args.GetResult Add.Model)
elif args.Contains Add.Owner then
AclCli.addOwners (args.GetResult Add.Owner)
elif args.Contains Add.User then
AclCli.addUsers (args.GetResult Add.User)
elif args.Contains Add.Group then
AclCli.addGroups (args.GetResult Add.Group)
elif args.Contains Add.Type then
ArchiveCli.addType (args.GetResult Add.Type)
else
printfn $"{args.Parser.PrintUsage()}"
let executeCommand (ct: System.Threading.CancellationToken) (cmd: Command * int) =
task {
let logLevel = snd cmd
let listHandler (args: ParseResults<List>) =
if args.Contains List.Archives then
Listing.listArchives (args.GetResult List.Archives)
elif args.Contains List.Models then
ModelAreaCli.listModels (args.GetResult List.Models)
else
eprintfn "No list subcommand listed"
eprintfn "%s" (args.Parser.PrintUsage())
()
Log.Logger <- configureSerilog logLevel
let showHandler (args: ParseResults<Show>) =
if args.Contains Show.Archive then
let show = args.GetResult Show.Archive
printfn $"Archivist connection string: %s{Settings.archmaesterUrl}"
if show.Contains Related then
ArchiveCli.showRelatedArchives show
else
ArchiveCli.showArchive show
elif args.Contains Show.Model then
ModelAreaCli.showModel (args.GetResult Show.Model)
else
args.Parser.PrintUsage() |> printfn "%s"
let deleteHandler (args: ParseResults<Delete>) =
if args.Contains Delete.Archive then
ArchiveCli.deleteArchives args
elif args.Contains Delete.Model then
ModelAreaCli.deleteModel (args.GetResult Delete.Model)
elif args.Contains Delete.Owner then
AclCli.deleteOwners (args.GetResult Delete.Owner)
elif args.Contains Delete.User then
AclCli.deleteUsers (args.GetResult Delete.User)
elif args.Contains Delete.Group then
AclCli.deleteGroups (args.GetResult Delete.Group)
elif args.Contains Delete.Type then
ArchiveCli.deleteType (args.GetResult Delete.Type)
else
()
let modifyHandler (args: ParseResults<Modify>) =
if args.Contains Modify.Archive then
ArchiveCli.modifyArchive (args.GetResult Modify.Archive)
elif args.Contains Modify.ArchiveAttribs then
ArchiveCli.modifyArchiveAttribs (args.GetResult Modify.ArchiveAttribs)
elif args.Contains Modify.Model then
ModelAreaCli.modifyModel (args.GetResult Modify.Model)
else
()
match fst cmd with
| ModifyArchive args ->
ArchiveCli.modifyArchive args
return 0
| ModifyArchiveAttribs args ->
ArchiveCli.modifyArchiveAttribs args
return 0
| ModifyModel args ->
ModelAreaCli.modifyModel args
return 0
| ShowArchive args ->
if args.Related then
ArchiveCli.showRelatedArchives args
return 0
else
ArchiveCli.showArchive args
return 0
| ShowModel args ->
ModelAreaCli.showModel args
return 0
| ListArchives args ->
Listing.listArchives args
return 0
| ListModels args ->
ModelAreaCli.listModels args
return 0
| ListTypes args ->
// NOTE: Not yet defined
// ArchiveCli.c args
return 0
| AddArchive args ->
ArchiveCli.addArchive args
return 0
| AddSub args ->
ArchiveCli.createSubArchive args
return 0
| AddModel args ->
ModelAreaCli.addModel args
return 0
| AddOwner args ->
AclCli.addOwners args
return 0
| AddGroup args ->
AclCli.addGroups args
return 0
| AddUser args ->
AclCli.addUsers args
return 0
| AddType args ->
ArchiveCli.addType args
return 0
| DeleteArchive args ->
ArchiveCli.deleteArchives args
return 0
| DeleteModel args ->
ModelAreaCli.deleteModel args
return 0
| DeleteOwner args ->
AclCli.deleteOwners args
return 0
| DeleteGroup args ->
AclCli.deleteGroups args
return 0
| DeleteUser args ->
AclCli.deleteUsers args
return 0
| DeleteType args ->
ArchiveCli.deleteType args
return 0
| Augment args ->
ArchiveCli.augmentArchive args
return 0
| Resize args ->
ArchiveCli.resizeArchive args
return 0
| Version _ ->
showVersion ()
return 0
}
[<EntryPoint>]
let main argv =
let parser =
ArgumentParser.Create<Verbs>(programName = "Archivist", errorHandler = errorHandler)
let args = parser.Parse argv
Log.Logger <- configureSerilog (args.GetResult(Log_Level, defaultValue = 3))
printfn $"Archivist connection string: {Settings.archmaesterUrl}"
if args.Contains Add then
addHandler (args.GetResult Add)
elif args.Contains List then
listHandler (args.GetResult List)
elif args.Contains Show then
showHandler (args.GetResult Show)
elif args.Contains Delete then
deleteHandler (args.GetResult Delete)
elif args.Contains Modify then
modifyHandler (args.GetResult Modify)
elif args.Contains Augment then
ArchiveCli.augmentArchive (args.GetResult Augment)
elif args.Contains Resize then
ArchiveCli.resizeArchive (args.GetResult Resize)
elif args.Contains Version then
showVersion ()
else
parser.PrintUsage() |> printfn "%s"
0
run "archivist" argParser argv executeCommand

103
src/Archivist/src/Cli/ModelAreaCli.fs
View File

@@ -1,14 +1,14 @@
module ModelAreaCli
open System
open System.IO
open Archmaester
open Argu
open Args
open FSharpPlus
open Serilog
open ArchiveIndex
open Oceanbox.DataAgent
open Serilog
open System
open System.IO
open ArchiveIndex
open Archmaester
open Archmaester.Dto
let inline private execAsync job =
@@ -24,25 +24,25 @@ let inline private execAsync job =
/// <param name="modelArea">The model area</param>
let postModelArea modelArea =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let manage = api.adminApi ()
async { return! manage.addModelArea modelArea })
let findModelAreaId (name: string) : Async<Result<ModelAreaId, string>> =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archmaester = api.adminApi ()
archmaester.queryModelAreaId name)
let listModelArchives modelAreaId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let inventory = api.modelAreaApi ()
async {
try
let! m = inventory.getModelArea modelAreaId
return m |> Option.toResultWith "error"
let! m = inventory.getModelArea modelAreaId
return m |> Option.toResultWith "error"
with exn ->
Log.Error exn.Message
return Error exn.Message
@@ -50,7 +50,7 @@ let listModelArchives modelAreaId =
let listModelArchivesAdmin (mid, filter: ArchiveFilter) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archmaester = api.archiveApi ()
let tp =
@@ -67,16 +67,16 @@ let listModelArchivesAdmin (mid, filter: ArchiveFilter) =
let getModelArea modelId =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archmaester = api.modelAreaApi ()
async {
let! m = archmaester.getModelArea modelId
return m |> Option.toResultWith "error"
let! m = archmaester.getModelArea modelId
return m |> Option.toResultWith "error"
})
let getBaseModelArea () =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let archmaester = api.modelAreaApi ()
async {
@@ -90,14 +90,13 @@ let getBaseModelArea () =
let getBaseModelAreas (helloWorld: Guid) : Result<ModelArea[], string> =
Log.Information $"Fetching model area {helloWorld} model areas:"
withCliAuth (fun auth ->
let intra = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = intra.modelAreaApi()
api.getSubModelAreas helloWorld
|> Async.map Ok)
let intra = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let api = intra.modelAreaApi ()
api.getSubModelAreas helloWorld |> Async.map Ok)
|> Async.RunSynchronously
let addModel (args: ParseResults<AddModel>) =
let file = args.GetResult AddModel.File |> Path.GetFullPath
let addModel (args: AddModelArgs) =
let file = args.File |> Path.GetFullPath
let basePath = Path.GetDirectoryName file
match readModelAreaFile file with
@@ -122,7 +121,7 @@ let addModel (args: ParseResults<AddModel>) =
Log.Debug $"{mdl}"
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let adminApi = api.adminApi ()
async {
@@ -130,7 +129,7 @@ let addModel (args: ParseResults<AddModel>) =
match! adminApi.addModelArea mdl with
| Ok mid ->
Log.Information $"Added model {mid}"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -140,29 +139,29 @@ let addModel (args: ParseResults<AddModel>) =
|> execAsync
| Error e -> Log.Error $"Error: {e}"
let listModels (args: ParseResults<ListModel>) =
let listModels (args: ListModelArgs) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let inventory = api.modelAreaApi ()
async {
try
let! models =inventory.getSubModelAreas Guid.Empty
let! models = inventory.getSubModelAreas Guid.Empty
models |> Array.iter (fun m -> printfn $"{m.name}: {m.modelAreaId}")
return Ok()
return Ok ()
with exn ->
return Error exn.Message
})
|> execAsync
let showModel (args: ParseResults<ShowModel>) =
let showModel (args: ShowModelArgs) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let inventory = api.modelAreaApi ()
async {
try
match! inventory.getModelArea (args.GetResult ShowModel.Model) with
match! inventory.getModelArea (args.ModelId) with
| Some m ->
printfn $"{m.name}: {{{m.modelAreaId}}}"
printfn $" Desc.: {m.description}"
@@ -174,7 +173,7 @@ let showModel (args: ParseResults<ShowModel>) =
if m.parent.IsSome then
printfn $" Parent: {m.parent.Value}"
return Ok()
return Ok ()
| None ->
Log.Error $"error"
return Error "error"
@@ -183,36 +182,34 @@ let showModel (args: ParseResults<ShowModel>) =
})
|> execAsync
let modifyModel (args: ParseResults<ModifyModel>) =
let modifyModel (args: ModifyModelArgs) =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let modelApi = api.modelAreaApi ()
let adminApi = api.adminApi ()
let poly (m: ModelArea) =
let proj = args.TryGetResult ModifyModel.Projection
let proj = args.Projection
if args.Contains ModifyModel.Polygon then
readBoundingPolygon proj (args.GetResult ModifyModel.Polygon) |> Option.ofResult
elif m.polygon = [||] then
None
else
Some m.polygon
match args.Polygon with
| None -> Some m.polygon
| Some poly when m.polygon = [||] -> None
| Some poly -> readBoundingPolygon proj poly |> Option.ofResult
async {
try
match! modelApi.getModelArea (args.GetResult ModifyModel.ModelId) with
match! modelApi.getModelArea args.ModelId with
| Some m ->
let form: Forms.ModelAreaForm = {
name = args.GetResult(ModifyModel.Name, m.name)
description = args.GetResult(ModifyModel.Description, m.description)
focalPoint = args.GetResult(ModifyModel.Focal, m.focalPoint)
defaultZoom = args.GetResult(ModifyModel.Zoom, m.defaultZoom)
name = args.Name |> Option.defaultValue m.name
description = args.Description |> Option.defaultValue m.description
focalPoint = args.Focal |> Option.defaultValue m.focalPoint
defaultZoom = args.Zoom |> Option.defaultValue m.defaultZoom
json = if m.json = "" then None else Some m.json
geometry = poly m
}
return! adminApi.updateModelArea (args.GetResult ModifyModel.ModelId, form)
return! adminApi.updateModelArea (args.ModelId, form)
| None ->
Log.Error $"error"
return Error "error"
@@ -221,13 +218,13 @@ let modifyModel (args: ParseResults<ModifyModel>) =
})
|> execAsync
let deleteModel (args: ParseResults<DeleteModel>) =
let mid = args.GetResult DeleteModel.Model
let force = args.Contains DeleteModel.Force
let deleteModel (args: DeleteModelArgs) =
let mid = args.ModelId
let force = args.Force
let action () =
withCliAuth (fun auth ->
let api = Remoting.v1.InternalApi(Settings.archmaesterUrl, auth)
let api = Remoting.v1.InternalApi (Settings.archmaesterUrl, auth)
let adminApi = api.adminApi ()
async {
@@ -235,7 +232,7 @@ let deleteModel (args: ParseResults<DeleteModel>) =
match! adminApi.deleteModelArea mid with
| Ok _ ->
Log.Information $"Deleted model {mid} and all dependent archives"
return Ok()
return Ok ()
| Error e ->
Log.Error $"Error: {e}"
return Error e
@@ -250,7 +247,7 @@ let deleteModel (args: ParseResults<DeleteModel>) =
printfn "WARNING: This will remove the modeal area and ALL dependent archives!"
printfn "Do you want to continue YES/[no]?"
if Console.ReadLine() = "YES" then
if Console.ReadLine () = "YES" then
action ()
else
Environment.Exit 0