/
retrieve_credentials.R
224 lines (184 loc) · 7.01 KB
/
retrieve_credentials.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
# nocov start
#' View all available **blastula** credential keys
#'
#' To understand which keys have been set using the [create_smtp_creds_key()]
#' function (and how they are identified), we can use the
#' `view_credential_keys()` function. What's provided is a tibble with three
#' columns: `id`, `key_name`, and `username`.
#'
#' Support for using the `view_credential_keys()` function (and for doing any
#' credential key management) is provided through the **keyring** package. This
#' function cannot be used without that package being available on the system.
#' We can use `install.packages("keyring")` to install **keyring**.
#'
#' @examples
#' # View the available SMTP credentials
#' # that are in the system's secure
#' # key-value store; the `id` values
#' # in the returned tibble provide what's
#' # necessary to send email through
#' # `smtp_send()` and the `creds_key()`
#' # credential helper function
#'
#' # view_credential_keys()
#'
#' @export
view_credential_keys <- function() {
# Viewing credentials that are on the system-wide key-value
# store requires the installation of the keyring package
validate_keyring_available(fn_name = "view_credential_keys")
get_keyring_creds_table()
}
#' Delete a single **blastula** credential key
#'
#' It may be important to delete a credential key and the
#' `delete_credential_key()` function makes this possible. To understand which
#' keys are available in the key-value store (and to get their `id` values), use
#' the [view_credential_keys()] function.
#'
#' Support for using the `delete_credential_key()` function (and for doing any
#' credential key management) is provided through the **keyring** package. This
#' function cannot be used without that package being available on the system.
#' We can use `install.packages("keyring")` to install **keyring**.
#'
#' @param id The identifying label for the credential key. Use the same `id`
#' that was used to create the key with the [create_smtp_creds_key()]
#' function.
#'
#' @examples
#' # Delete the credential key with
#' # the `id` value of "outlook"
#'
#' # delete_credential_key("outlook")
#'
#' @export
delete_credential_key <- function(id) {
# Deleting credentials that are on the system-wide key-value
# store requires the installation of the keyring package
validate_keyring_available(fn_name = "delete_credential_key")
creds_tbl <- get_keyring_creds_table()
# Get a vector of key names, otherwise known as service names in `keyring`
ids_available <- creds_tbl$id
# Stop if there are no credential keys available
if (length(ids_available) < 1) {
stop("There are no credential keys available, so there is nothing to delete.",
call. = FALSE)
}
# Stop if the provided `id` doesn't match any of those available
if (!(id %in% ids_available)) {
stop("The specified `id` doesn't correspond to a credential key:\n",
"* Use the `view_credential_keys()` function to examine which `id` values are valid",
call. = FALSE)
}
# Obtain the matching service name that corresponds to the `id` value
creds_tbl_1 <- dplyr::filter(creds_tbl, id == !!id)
# Get a length 1 vectors of key name and username
key_name <- creds_tbl_1$key_name
username <- creds_tbl_1$username
# Delete with `keyring::key_delete()`
keyring::key_delete(service = key_name, username = username)
invisible()
}
#' Delete all **blastula** credential keys
#'
#' The `delete_all_credential_keys()` function deletes all **blastula**
#' credential keys, giving you a clean slate. Should specific keys need to be
#' deleted, the [delete_credential_key()] could be used (one call per credential
#' key to delete). Before using `delete_all_credential_keys()`, it may be useful
#' to see which keys are available in the key-value store. For that, use the
#' [view_credential_keys()] function.
#'
#' Support for using the `delete_all_credential_keys()` function (and for doing
#' any credential key management) is provided through the **keyring** package.
#' This function cannot be used without that package being available on the
#' system. We can use `install.packages("keyring")` to install **keyring**.
#'
#' @examples
#' # Delete all blastula credential keys
#' # in the system's key-value store
#'
#' # delete_all_credential_keys()
#'
#' @export
delete_all_credential_keys <- function() {
# Deleting credentials that are on the system-wide key-value
# store requires the installation of the keyring package
validate_keyring_available(fn_name = "delete_all_credential_keys")
creds_tbl <- get_keyring_creds_table()
# Get equal-length vectors of key names (otherwise known as
# service names in `keyring`) and usernames
key_names <- creds_tbl$key_name
usernames <- creds_tbl$username
# Stop if there are no keys to delete
if (length(key_names) < 1) {
stop("There are no blastula keys available for deletion.", call. = FALSE)
}
# For every key, delete with `keyring::key_delete()`
for (i in seq_along(key_names)) {
keyring::key_delete(service = key_names[i], username = usernames[i])
}
invisible()
}
# nocov end
#' Retrieve metadata and authentication values from an on-disk credentials file
#'
#' @noRd
get_smtp_file_creds <- function(file_name = NULL) {
# For the given `file_name`, read in the JSON
# data and convert it into a list object
readLines(file_name, encoding = "UTF-8") %>%
jsonlite::unserializeJSON()
}
# nocov start
#' Retrieve metadata and authentication values from keyring data
#'
#' @noRd
get_smtp_keyring_creds <- function(id) {
id_name <- id
# Get a filtered table of key and values that
# are only those keys generated by the
# `create_smtp_creds_key()` function
blastula_keys_tbl <-
get_keyring_creds_table() %>%
dplyr::filter(id == id_name)
# If the given `id` doesn't correspond to an entry in
# `blastula_keys_tbl`, stop the function with an explanatory message
if (nrow(blastula_keys_tbl) == 0) {
stop("There is no blastula key that corresponds to the `id` of \"",
id, "\".",
call. = FALSE)
}
# Get the `key_name`
key_name <- (blastula_keys_tbl %>% dplyr::pull(key_name))[1]
# Get the `username`
username <- (blastula_keys_tbl %>% dplyr::pull(username))[1]
# For the given `key_name` get the key's stored value and
# transform the JSON data to a list object
keyring::key_get(service = key_name, username = username) %>%
jsonlite::unserializeJSON()
}
#' Utility function for obtaining keyring entries related to blastula creds
#'
#' @noRd
get_keyring_creds_table <- function() {
creds_tbl <-
keyring::key_list() %>%
dplyr::as_tibble() %>%
dplyr::filter(grepl(paste0("blastula-v", schema_version), service))
if (nrow(creds_tbl) == 0) {
empty_creds_tbl <-
dplyr::tibble(
id = NA_character_,
key_name = NA_character_,
username = NA_character_
)[-1, ]
return(empty_creds_tbl)
} else {
creds_tbl <-
creds_tbl %>%
dplyr::mutate(id = sapply(strsplit(service,"-"), `[`, 3)) %>%
dplyr::select(id, key_name = service, username)
}
creds_tbl
}
# nocov end