AzureRMR: Interface to 'Azure Resource Manager'

#' Azure template class
#'
#' Class representing an Azure deployment template.
#'
#' @docType class
#' @section Methods:
#' - `new(token, subscription, resource_group, name, ...)`: Initialize a new template object. See 'Initialization' for more details.
#' - `check()`: Check the deployment status of the template; throw an error if the template has been deleted.
#' - `cancel(free_resources=FALSE)`: Cancel an in-progress deployment. Optionally free any resources that have already been created.
#' - `delete(confirm=TRUE, free_resources=FALSE)`: Delete a deployed template, after a confirmation check. Optionally free any resources that were created. If the template was deployed in Complete mode (its resource group is exclusive to its use), the latter process will delete the entire resource group. Otherwise resources are deleted in the order given by the template's output resources list; in this case, some may be left behind if the ordering is incompatible with dependencies.
#' - `list_resources()`: Returns a list of Azure resource objects that were created by the template. This returns top-level resources only, not those that represent functionality provided by another resource.
#' - `get_tags()`: Returns the tags for the deployment template (note: this is not the same as the tags applied to resources that are deployed).
#'
#' @section Initialization:
#' Initializing a new object of this class can either retrieve an existing template, or deploy a new template on the host. Generally, the easiest way to create a template object is via the `get_template`, `deploy_template` or `list_templates` methods of the [az_resource_group] class, which handle the details automatically.
#'
#' To initialize an object that refers to an existing deployment, supply the following arguments to `new()`:
#' - `token`: An OAuth 2.0 token, as generated by [get_azure_token].
#' - `subscription`: The subscription ID.
#' - `resource_group`: The resource group.
#' - `name`: The deployment name`.
#'
#' If you also supply the following arguments to `new()`, a new template will be deployed:
#' - `template`: The template to deploy. This can be provided in a number of ways:
#'   1. A nested list of R objects, which will be converted to JSON via `jsonlite::toJSON`
#'   2. A vector of strings containing unparsed JSON
#'   3. The name of a template file
#'   4. A URL from which the host can download the template
#' - `parameters`: The parameters for the template. This can be provided using any of the same methods as the `template` argument.
#' - `wait`: Optionally, whether to wait until the deployment is complete. Defaults to FALSE, in which case the method will return immediately.
#'
#' You can use the `build_template_definition` and `build_template_parameters` helper functions to construct the inputs for deploying a template. These can take as inputs R lists, JSON text strings, or file connections, and can also be extended by other packages.
#'
#' @seealso
#' [az_resource_group], [az_resource], [build_template_definition], [build_template_parameters]
#' [Template overview](https://learn.microsoft.com/en-us/azure/templates/),
#' [Template API reference](https://learn.microsoft.com/en-us/rest/api/resources/deployments)
#'
#' @examples
#' \dontrun{
#'
#' # recommended way to deploy a template: via a resource group object
#'
#' tpl <- resgroup$deploy_template("mydeployment",
#'     template="template.json",
#'     parameters="parameters.json")
#'
#' # retrieve list of created resource objects
#' tpl$list_resources()
#'
#' # delete template (will not touch resources)
#' tpl$delete()
#'
#' # delete template and free resources
#' tpl$delete(free_resources=TRUE)
#'
#' }
#' @format An R6 object of class `az_template`.
#' @export
az_template <- R6::R6Class("az_template",

public=list(
    subscription=NULL,
    resource_group=NULL,
    id=NULL,
    name=NULL,
    properties=NULL,
    tags=NULL,
    token=NULL,

    # constructor overloads: 1) get an existing template from host; 2) from passed-in data; 3) deploy new template
    initialize=function(token, subscription, resource_group, name=NULL, template, parameters, ...,
                        deployed_properties=list(), wait=FALSE)
    {
        self$token <- token
        self$subscription <- subscription
        self$resource_group <- resource_group

        parms <- if(!is_empty(name) && !missing(template))
            private$init_and_deploy(name, template, parameters, ..., wait=wait)
        else if(!is_empty(name))
            private$init_from_host(name)
        else if(!is_empty(deployed_properties))
            private$init_from_parms(deployed_properties)
        else stop("Invalid initialization call")

        self$id <- parms$id
        self$properties <- parms$properties
        self$tags <- parms$tags
        NULL
    },

    cancel=function(free_resources=FALSE)
    {
        message("Cancelling deployment of template '", self$name, "'")
        if(free_resources)
        {
            message("Also freeing associated resources:")
            private$free_resources()
        }
        else message("Associated resources will not be freed")

        private$tpl_op("cancel", http_verb="POST")
        invisible(NULL)
    },

    delete=function(confirm=TRUE, free_resources=FALSE)
    {
        # mode = Complete and free_resources = TRUE:  delete entire resource group
        # mode = Incr and free_resources = TRUE:      delete resources individually
        # mode = Complete and free_resources = FALSE: delete template
        # mode = Incr and free_resources = FALSE:     delete template
        del <- if(!free_resources)
            "tpl"
        else if(self$properties$mode == "Complete")
            "rg"
        else "res"

        type <- if(del %in% c("tpl", "res")) "template" else "resource group"
        name <- if(del == "tpl")
            sprintf("'%s'", self$name)
        else if(del == "rg")
            sprintf("'%s'", self$resource_group)
        else sprintf("'%s' and associated resources", self$name)

        if(!(delete_confirmed(confirm, name, type, FALSE)))
            return(invisible(NULL))

        if(del == "rg")
            return(az_resource_group$new(self$token, self$subscription, self$resource_group)$delete(confirm=FALSE))

        message("Deleting template '", self$name, "'")
        if(free_resources)
        {
            message("Also freeing associated resources:")
            private$free_resources()
        }
        else message("Associated resources will not be freed")

        private$tpl_op(http_verb="DELETE")
        invisible(NULL)
    },

    # update state of template: deployment accepted/deployment failed/updating/running
    check=function()
    {
        self$initialize(self$token, self$subscription, self$resource_group, self$name)
        self$properties$provisioningState
    },

    list_resources=function()
    {
        outlst <- lapply(self$properties$outputResources, function(res)
        {
            res <- res$id
            # return only top-level resources; error out if resource has been deleted
            if(grepl("providers/[^/]+/[^/]+/[^/]+$", res))
                az_resource$new(self$token, self$subscription, self$resource_group, id=res)
            else NULL
        })
        nulls <- sapply(outlst, is.null)
        named_list(outlst[!nulls], c("type", "name"))
    },

    get_tags=function()
    {
        self$tags
    },

    print=function(...)
    {
        cat("<Azure template ", self$name, ">\n", sep="")
        cat(format_public_fields(self, exclude=c("subscription", "resource_group", "name")))
        cat(format_public_methods(self))
        invisible(self)
    }
),

private=list(

    init_from_host=function(name)
    {
        self$name <- name
        private$tpl_op()
    },

    init_from_parms=function(parms)
    {
        # private$validate_response_parms(parms)
        self$name <- parms$name
        parms
    },

    # deployment workhorse function
    init_and_deploy=function(name, template, parameters, ..., wait=FALSE)
    {
        message("Deploying template '", name, "'")

        default_properties <- list(
            debugSetting=list(detailLevel="requestContent, responseContent"),
            mode="Incremental"
        )
        properties <- modifyList(default_properties, list(...))
        # private$validate_deploy_parms(properties)

        # rather than working with R objects, convert to JSON and do text munging
        # this allows adding template/params that are already JSON text without conversion roundtrip
        properties <- generate_json(properties)

        # fold template data into properties
        properties <- if(is.list(template))
            append_json(properties, template=generate_json(template))
        else if(is_file_spec(template))
            append_json(properties, template=readLines(template))
        else if(is_url(template))
            append_json(properties, templateLink=generate_json(list(uri=template)))
        else append_json(properties, template=template)

        # handle case of missing or empty parameters arg
        # must be a _named_ list for jsonlite to turn into an object, not an array
        if(missing(parameters) || is_empty(parameters))
            parameters <- named_list()

        # fold parameter data into properties
        properties <- if(is_empty(parameters))
            append_json(properties, parameters=generate_json(parameters))
        else if(is.list(parameters))
            append_json(properties, parameters=do.call(build_template_parameters, parameters))
        else if(is_file_spec(parameters))
            append_json(properties, parameters=readLines(parameters))
        else if(is_url(parameters))
            append_json(properties, parametersLink=generate_json(list(uri=parameters)))
        else append_json(properties, parameters=parameters)

        self$name <- name
        tags <- jsonlite::toJSON(list(createdBy="AzureR/AzureRMR"), auto_unbox=TRUE)
        parms <- private$tpl_op(
            body=jsonlite::prettify(sprintf('{"properties": %s, "tags": %s}', properties, tags)),
            encode="raw",
            http_verb="PUT"
        )

        # do we wait until template has finished provisioning?
        if(wait)
        {
            message("Waiting for provisioning to complete")
            for(i in 1:1000) # some templates can take a long time to provision (HDInsight)
            {
                message(".", appendLF=FALSE)
                parms <- private$tpl_op()
                status <- parms$properties$provisioningState
                if(status %in% c("Succeeded", "Error", "Failed"))
                    break
                Sys.sleep(5)
            }
            if(status == "Succeeded")
                message("\nDeployment successful")
            else
            {
                err_details <- lapply(parms$properties$error$details, `[[`, "message")
                msg <- if(is.list(err_details) && !is_empty(err_details))
                    paste0("\nUnable to deploy template. Message(s):\n", do.call(paste, c(err_details, sep="\n")))
                else "\nUnable to deploy template"
                stop(msg, call.=FALSE)
            }
        }
        parms
    },

    # validate_response_parms=function(parms)
    # {
    #     required_names <- c("name")
    #     optional_names <- c("id", "properties")
    #     validate_object_names(names(parms), required_names, optional_names)
    # },

    # validate_deploy_parms=function(parms)
    # {
    #     required_names <- c("debugSetting", "mode")
    #     optional_names <- c("onErrorDeployment")
    #     validate_object_names(names(parms), required_names, optional_names)
    # },

    # delete resources that were created (which may not be the same as resources that are required)
    free_resources=function()
    {
        # assumption: outputResources is sorted to allow for dependencies
        resources <- self$properties$outputResources
        for(i in seq_along(resources))
        {
            id <- resources[[i]]$id

            # only attempt to delete top-level resources
            if(grepl("/providers/[^/]+/[^/]+/[^/]+$", id))
            {
                # supply deployed_properties arg to prevent querying host for resource info
                try(az_resource $
                    new(self$token, self$subscription, id=id, deployed_properties=list(NULL)) $
                    delete(confirm=FALSE, wait=TRUE))
            }
        }
    },

    tpl_op=function(op="", ...)
    {
        op <- construct_path("resourcegroups", self$resource_group,
                             "providers/Microsoft.Resources/deployments", self$name, op)
        call_azure_rm(self$token, self$subscription, op, ...)
    }
))