AzureRMR: Interface to 'Azure Resource Manager'

#' Azure resource class
#'
#' Class representing a generic Azure resource.
#'
#' @docType class
#' @section Methods:
#' - `new(...)`: Initialize a new resource object. See 'Initialization' for more details.
#' - `delete(confirm=TRUE, wait=FALSE)`: Delete this resource, after a confirmation check. Optionally wait for the delete to finish.
#' - `update(...)`: Update this resource on the host.
#' - `sync_fields()`: Synchronise the R object with the resource it represents in Azure. Returns the `properties$provisioningState` field, so you can query this programmatically to check if a resource has finished provisioning. Not all resource types require explicit provisioning, in which case this method will return NULL.
#' - `set_api_version(api_version, stable_only=TRUE)`: Set the API version to use when interacting with the host. If `api_version` is not supplied, use the latest version available, either the latest stable version (if `stable_only=TRUE`) or the latest preview version (if `stable_only=FALSE`).
#' - `get_api_version()`: Get the current API version.
#' - `get_subresource(type, name)`: Get a sub-resource of this resource. See 'Sub-resources' below.
#' - `create_subresource(type, name, ...)`: Create a sub-resource of this resource.
#' - `delete_subresource(type, name, confirm=TRUE)`: Delete a sub-resource of this resource.
#' - `do_operation(...)`: Carry out an operation. See 'Operations' for more details.
#' - `set_tags(..., keep_existing=TRUE)`: Set the tags on this resource. The tags can be either names or name-value pairs. To delete a tag, set it to `NULL`.
#' - `get_tags()`: Get the tags on this resource.
#' - `create_lock(name, level)`: Create a management lock on this resource.
#' - `get_lock(name)`: Returns a management lock object.
#' - `delete_lock(name)`: Deletes a management lock object.
#' - `list_locks()`: List all locks that apply to this resource. Note this includes locks created at the subscription or resource group level.
#' - `add_role_assignment(name, ...)`: Adds a new role assignment. See 'Role-based access control' below.
#' - `get_role_assignment(id)`: Retrieves an existing role assignment.
#' - `remove_role_assignment(id)`: Removes an existing role assignment.
#' - `list_role_assignments()`: Lists role assignments.
#' - `get_role_definition(id)`: Retrieves an existing role definition.
#' - `list_role_definitions()` Lists role definitions.
#'
#' @section Initialization:
#' There are multiple ways to initialize a new resource object. The `new()` method can retrieve an existing resource, deploy/create a new resource, or create an empty/null object (without communicating with the host), based on the arguments you supply.
#'
#' All of these initialization options have the following arguments in common.
#' 1. `token`: An OAuth 2.0 token, as generated by [get_azure_token].
#' 2. `subscription`: The subscription ID.
#' 3. `api_version`: Optionally, the API version to use when interacting with the host. By default, this is NULL in which case the latest API version will be used.
#' 4. A set of _identifying arguments_:
#'    - `resource_group`: The resource group containing the resource.
#'    - `id`: The full ID of the resource. This is a string of the form `/subscriptions/{uuid}/resourceGroups/{resource-group-name}/provider/{resource-provider-name}/{resource-path}/{resource-name}`.
#'    - `provider`: The provider of the resource, eg `Microsoft.Compute`.
#'    - `path`: The path to the resource, eg `virtualMachines`.
#'    - `type`: The combination of provider and path, eg `Microsoft.Compute/virtualMachines`.
#'    - `name`: The name of the resource instance, eg `myWindowsVM`.
#'
#' Providing `id` will fill in the values for all the other identifying arguments. Similarly, providing `type` will fill in the values for `provider` and `path`. Unless you provide `id`, you must also provide `name`.
#'
#' The default behaviour for `new()` is to retrieve an existing resource, which occurs if you supply only the arguments listed above. If you also supply an argument `deployed_properties=NULL`, this will create a null object. If you supply any other (named) arguments, `new()` will create a new object on the host, with the supplied arguments as parameters.
#'
#' Generally, the easiest way to initialize an object is via the `get_resource`, `create_resource` or `list_resources` methods of the [az_resource_group] class, which will handle all the gory details automatically.
#'
#' @section Operations:
#' The `do_operation()` method allows you to carry out arbitrary operations on the resource. It takes the following arguments:
#' - `op`: The operation in question, which will be appended to the URL path of the request.
#' - `options`: A named list giving the URL query parameters.
#' - `...`: Other named arguments passed to [call_azure_rm], and then to the appropriate call in httr. In particular, use `body` to supply the body of a PUT, POST or PATCH request.
#' - `http_verb`: The HTTP verb as a string, one of `GET`, `PUT`, `POST`, `DELETE`, `HEAD` or `PATCH`.
#'
#' Consult the Azure documentation for your resource to find out what operations are supported.
#'
#' @section Sub-resources:
#' Some resource types can have sub-resources: objects exposed by Resource Manager that make up a part of their parent's functionality. For example, a storage account (type `Microsoft.Storage/storageAccounts`) provides the blob storage service, which can be accessed via Resource Manager as a sub-resource of type `Microsoft.Storage/storageAccounts/blobServices/default`.
#'
#' To retrieve an existing sub-resource, use the `get_subresource()` method. You do not need to include the parent resource's type and name. For example, if `res` is a resource for a storage account, and you want to retrieve the sub-resource for the blob container "myblobs", call
#'
#' ```
#' res$get_subresource(type="blobServices/default/containers", name="myblobs")
#' ```
#'
#' Notice that the storage account's resource type and name are omitted from the `get_subresource` arguments. Similarly, to create a new subresource, call the `create_subresource()` method with the same naming convention, passing any required fields as named arguments; and to delete it, call `delete_subresource()`.
#'
#' @section Role-based access control:
#' AzureRMR implements a subset of the full RBAC functionality within Azure Active Directory. You can retrieve role definitions and add and remove role assignments, at the subscription, resource group and resource levels. See [rbac] for more information.
#'
#' @seealso
#' [az_resource_group], [call_azure_rm], [call_azure_url],
#' [Resources API reference](https://learn.microsoft.com/en-us/rest/api/resources/resources)
#'
#' For role-based access control methods, see [rbac]
#'
#' For management locks, see [lock]
#'
#' @examples
#' \dontrun{
#'
#' # recommended way to retrieve a resource: via a resource group object
#' # storage account:
#' stor <- resgroup$get_resource(type="Microsoft.Storage/storageAccounts", name="mystorage")
#' # virtual machine:
#' vm <- resgroup$get_resource(type="Microsoft.Compute/virtualMachines", name="myvm")
#'
#' ## carry out operations on a resource
#'
#' # storage account: get access keys
#' stor$do_operation("listKeys", http_verb="POST")
#'
#' # virtual machine: run a script
#' vm$do_operation("runCommand",
#'     body=list(
#'         commandId="RunShellScript", # RunPowerShellScript for Windows
#'         script=as.list("ifconfig > /tmp/ifconfig.out")
#'     ),
#'     encode="json",
#'     http_verb="POST")
#'
#' ## retrieve properties
#'
#' # storage account: endpoint URIs
#' stor$properties$primaryEndpoints$file
#' stor$properties$primaryEndpoints$blob
#'
#' # virtual machine: hardware profile
#' vm$properties$hardwareProfile
#'
#' ## update a resource: resizing a VM
#' properties <- list(hardwareProfile=list(vmSize="Standard_DS3_v2"))
#' vm$do_operation(http_verb="PATCH",
#'     body=list(properties=properties),
#'     encode="json")
#'
#' # sync with Azure: useful to track resource creation/update status
#' vm$sync_fields()
#'
#' ## subresource: create a public blob container
#' stor$create_subresource(type="blobservices/default/containers", name="mycontainer",
#'     properties=list(publicAccess="container"))
#'
#' ## delete a subresource and resource
#' stor$delete_subresource(type="blobservices/default/containers", name="mycontainer")
#' stor$delete()
#'
#' }
#' @format An R6 object of class `az_resource`.
#' @export
az_resource <- R6::R6Class("az_resource",

public=list(
    subscription=NULL,
    resource_group=NULL,
    type=NULL,
    name=NULL,
    id=NULL,
    identity=NULL,
    kind=NULL,
    location=NULL,
    managed_by=NULL,
    plan=NULL,
    properties=NULL,
    sku=NULL,
    tags=NULL,
    token=NULL,
    etag=NULL,
    ext=list(),

    # constructor overloads:
    # 1. deploy resource: resgroup, {provider, path}|type, name, ...
    # 2. deploy resource by id: id, ...
    # 3. get from passed-in data: deployed_properties
    # 4. get from host: resgroup, {provider, path}|type, name
    # 5. get from host by id: id
    initialize=function(token, subscription, resource_group, provider, path, type, name, id, ...,
                        deployed_properties=list(), api_version=NULL, wait=FALSE)
    {
        self$token <- token
        self$subscription <- subscription

        private$init_id_fields(resource_group, provider, path, type, name, id, deployed_properties)

        # by default this is unset at initialisation, for efficiency
        private$api_version <- api_version

        parms <- if(!is_empty(list(...)))
            private$init_and_deploy(..., wait=wait)
        else if(!is_empty(deployed_properties))
            private$init_from_parms(deployed_properties)
        else private$init_from_host()

        self$identity <- parms$identity
        self$kind <- parms$kind
        self$location <- parms$location
        self$managed_by <- parms$managedBy
        self$plan <- parms$plan
        self$properties <- parms$properties
        self$sku <- parms$sku
        self$tags <- parms$tags
        self$etag <- parms$etag
        self$ext <- get_extended_resource_fields(parms)

        NULL
    },

    get_api_version=function()
    {
        private$api_version
    },

    set_api_version=function(api_version=NULL, stable_only=TRUE)
    {
        if(!is_empty(api_version))
        {
            private$api_version <- api_version
            return(invisible(api_version))
        }

        # API versions vary across different providers; find the latest for this resource
        slash <- regexpr("/", self$type)
        provider <- substr(self$type, 1, slash - 1)
        path <- substr(self$type, slash + 1, nchar(self$type))

        temp_sub <- az_subscription$new(self$token, self$subscription, list(NULL))
        ver <- temp_sub$get_provider_api_version(provider, path, stable_only=stable_only)
        if(ver == "")
            stop("No API versions found (try setting stable_only=FALSE")

        private$api_version <- ver
        invisible(private$api_version)
    },

    sync_fields=function()
    {
        self$initialize(self$token, self$subscription, id=self$id, api_version=private$api_version)
        self$properties$provisioningState
    },

    delete=function(confirm=TRUE, wait=FALSE)
    {
        if(!delete_confirmed(confirm, file.path(self$type, self$name), "resource"))
            return(invisible(NULL))

        message("Deleting resource '", construct_path(self$type, self$name), "'")
        private$res_op(http_verb="DELETE")

        if(wait)
        {
            for(i in 1:1000)
            {
                status <- httr::status_code(private$res_op(http_status_handler="pass"))
                if(status >= 300)
                    break
                Sys.sleep(5)
            }
            if(status < 300)
                warning("Attempt to delete resource did not succeed", call.=FALSE)
        }

        invisible(NULL)
    },

    get_subresource=function(type, name, id, api_version=NULL)
    {
        name <- file.path(self$name, type, name)
        az_resource$new(self$token, self$subscription,
                        resource_group=self$resource_group, type=self$type, name=name, id=id,
                        api_version=api_version)
    },

    create_subresource=function(type, name, id, location=self$location, ...)
    {
        name <- file.path(self$name, type, name)
        az_resource$new(self$token, self$subscription,
                        resource_group=self$resource_group, type=self$type, name=name, id=id,
                        location=location, ...)
    },

    delete_subresource=function(type, name, id, api_version=NULL, confirm=TRUE, wait=FALSE)
    {
        name <- file.path(self$name, type, name)
        # supply deployed_properties arg to prevent querying host for resource info
        az_resource$
            new(self$token, self$subscription, self$resource_group,
                type=self$type, name=name, id=id,
                deployed_properties=list(NULL), api_version=api_version)$
            delete(confirm=confirm, wait=wait)
    },

    do_operation=function(..., options=list(), http_verb="GET")
    {
        private$res_op(..., options=options, http_verb=http_verb)
    },

    update=function(..., options=list())
    {
        parms <- list(...)
        # private$validate_update_parms(names(parms))
        private$res_op(
            body=jsonlite::toJSON(parms, auto_unbox=TRUE, digits=22, null="null"),
            options=options,
            encode="raw",
            http_verb="PATCH"
        )
        self$sync_fields()
    },

    set_tags=function(..., keep_existing=TRUE)
    {
        tags <- match.call(expand.dots=FALSE)$...
        unvalued <- if(is.null(names(tags)))
            rep(TRUE, length(tags))
        else names(tags) == ""

        values <- lapply(seq_along(unvalued), function(i)
        {
            if(unvalued[i]) "" else as.character(eval(tags[[i]], parent.frame(3)))
        })
        names(values) <- ifelse(unvalued, as.character(tags), names(tags))

        if(keep_existing && !is_empty(self$tags))
            values <- modifyList(self$tags, values)

        # delete tags specified to be null
        values <- values[!sapply(values, is_empty)]

        self$update(tags=values)
        invisible(NULL)
    },

    get_tags=function()
    {
        self$tags
    },

    print=function(...)
    {
        # generate label from id, since type and name are not guaranteed to be fixed for sub-resources
        cat("<Azure resource ", sub("^.+providers/(.+$)", "\\1", self$id), ">\n", sep="")
        cat(format_public_fields(self, exclude=c("subscription", "resource_group", "type", "name")))
        cat(format_public_methods(self))
        invisible(self)
    }
),

private=list(
    api_version=NULL,

    # initialise identifier fields from multiple ways of constructing object
    init_id_fields=function(resource_group, provider, path, type, name, id, parms=list())
    {
        # if these are supplied, use to fill in everything else
        if(!is_empty(parms$id) && !is_empty(parms$type) && !is_empty(parms$name))
        {
            resource_group <- sub("^.+resourceGroups/([^/]+)/.*$", "\\1", parms$id, ignore.case=TRUE)
            type <- parms$type
            name <- parms$name
            id <- parms$id
        }
        else if(!missing(id))
        {
            resource_group <- sub("^.+resourceGroups/([^/]+)/.*$", "\\1", id, ignore.case=TRUE)
            id2 <- sub("^.+providers/", "", id)
            type_delim <- attr(regexpr("^[^/]+/[^/]+/", id2), "match.length")
            type <- substr(id2, 1, type_delim - 1)
            name <- substr(id2, type_delim + 1, nchar(id2))
        }
        else
        {
            if(missing(type))
                type <- construct_path(provider, path)
            id <- construct_path("/subscriptions", self$subscription, "resourceGroups", resource_group,
                                 "providers", type, name)
        }
        self$resource_group <- resource_group
        self$type <- type
        self$name <- name
        self$id <- id
    },

    init_from_parms=function(parms)
    {
        # allow list(NULL) as special case for creating an empty object
        # if(!identical(parms, list(NULL)))
        #     private$validate_response_parms(parms)
        parms
    },

    init_from_host=function()
    {
        private$res_op()
    },

    init_and_deploy=function(..., wait)
    {
        properties <- list(...)

        # check if we were passed a json object
        if(length(properties) == 1 && is.character(properties[[1]]) && jsonlite::validate(properties[[1]]))
            properties <- jsonlite::fromJSON(properties[[1]], simplifyVector=FALSE)

        # private$validate_deploy_parms(properties)
        properties$tags <- add_creator_tag(properties$tags)
        private$res_op(body=properties, encode="json", http_verb="PUT")

        # do we wait until resource has finished provisioning?
        if(wait)
        {
            message("Waiting for provisioning to complete")
            for(i in 1:1000) # some resources can take a long time to provision (AKS, Kusto)
            {
                message(".", appendLF=FALSE)

                # some resources return from creation before they can be retrieved, let http 404's through
                res <- private$res_op(http_status_handler="pass")
                http_stat <- httr::status_code(res)
                state <- httr::content(res)$properties$provisioningState

                # some resources don't have provisioning state (eg Microsoft.Compute/sshPublicKey)
                if(is.null(state))
                    state <- "Succeeded"

                success <- http_stat < 300 && state == "Succeeded"
                failure <- http_stat >= 300 || state %in% c("Error", "Failed")
                if(success || failure)
                    break

                Sys.sleep(5)
            }
            if(success)
                message("\nDeployment successful")
            else stop("\nUnable to create resource", call.=FALSE)
            httr::content(res)
        }
        else
        {
            # allow time for provisioning setup, then get properties
            Sys.sleep(2)
            private$res_op()
        }
    },

    # validate_deploy_parms=function(parms)
    # {
    #     required_names <- character(0)
    #     optional_names <-
    #         c("identity", "kind", "location", "managedBy", "plan", "properties", "sku", "tags", "etag")
    #     validate_object_names(names(parms), required_names, optional_names)
    # },

    # validate_response_parms=function(parms)
    # {
    #     required_names <- c("id", "name", "type")
    #     optional_names <-
    #         c("identity", "kind", "location", "managedBy", "plan", "properties", "sku", "tags", "etag")
    #     validate_object_names(names(parms), required_names, optional_names)
    # },

    # validate_update_parms=function(parms)
    # {
    #     required_names <- character(0)
    #     optional_names <-
    #         c("identity", "kind", "location", "managedBy", "plan", "properties", "sku", "tags", "etag")
    #     validate_object_names(names(parms), required_names, optional_names)
    # },

    res_op=function(op="", ..., api_version=private$api_version)
    {
        # make sure we have an API to call
        if(is.null(private$api_version))
        {
            res <- try(self$set_api_version(), silent=TRUE)
            if(inherits(res, "try-error"))
            {
                warning("No stable API versions found, falling back to the latest preview version", call.=FALSE)
                res <- try(self$set_api_version(stable_only=FALSE), silent=TRUE)
            }
            if(inherits(res, "try-error"))
                stop("No API versions found", call.=FALSE)
        }

        op <- construct_path("resourcegroups", self$resource_group, "providers", self$type, self$name, op)
        call_azure_rm(self$token, self$subscription, op, ..., api_version=api_version)
    }
))


get_extended_resource_fields <- function(res_fields)
{
    known_fields <- c("id", "name", "type", "identity", "kind", "location", "managedBy",
                      "plan", "properties", "sku", "tags", "etag")
    nms <- names(res_fields)
    res_fields[!(nms %in% known_fields)]
}