-
Notifications
You must be signed in to change notification settings - Fork 0
/
auth.r
218 lines (195 loc) · 6.79 KB
/
auth.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
#' Authenticate for the API
#'
#' @description Run authentication for a network using the AT protocol (e.g.,
#' ['Blue Sky'](https://bsky.app/)) and save the token permanently.
#'
#' @param user Your user handle (e.g, benguinaudeau.bsky.social).
#' @param password Your app password (usually created on
#' <https://bsky.app/settings/app-passwords>).
#' @param domain For now https://bsky.app/, but could change in the future.
#' @param overwrite If TRUE, overwrites old token without asking for
#' confirmation.
#' @param token (Stale) token object. Usually you don't need to use this. But if
#' you manage your own tokens and they get stale, you can use this parameter
#' and request a fresh token.
#'
#' @inheritParams search_user
#' @returns An authentication token (invisible)
#'
#' @details After requesting the token, it is saved in the location returned by
#' `file.path(tools::R_user_dir("atrrr", "cache"), Sys.getenv("BSKY_TOKEN",
#' unset = "token.rds"))`. If you have multiple tokens, you can use
#' `Sys.setenv(BSKY_TOKEN = "filename.rds")` to save/load the token with a
#' different name.
#'
#' @examples
#' \dontrun{
#' # request a token
#' auth() # this will guide you through all steps
#'
#' # the token is stored in the location returned by this command
#' file.path(tools::R_user_dir("atrrr", "cache"),
#' Sys.getenv("BSKY_TOKEN", unset = "token.rds"))
#'
#' # to use a different than the default file name for the token, set BSKY_TOKEN
#' Sys.setenv(BSKY_TOKEN = "identity-2.rds")
#'
#' # now either rename your token file or request a new token
#' auth()
#'
#' # the cache now contains two tokens
#' list.files(tools::R_user_dir("atrrr", "cache"))
#'
#' # functions that interact with the API also take a .token argument with the
#' # path. For example:
#' tok_path <- file.path(tools::R_user_dir("atrrr", "cache"), "identity-2.rds")
#' get_skeets_authored_by(actor = "benguinaudeau.bsky.social", parse = TRUE,
#' .token = tok_path)
#' }
#'
#' @export
auth <- function(user,
password,
domain = "https://bsky.app/",
verbose = TRUE,
overwrite = FALSE,
token = NULL) {
if (is.null(token)) {
url <- list(
scheme = "https",
hostname = httr2::url_parse(domain)$hostname,
path = "/settings/app-passwords"
) |>
httr2::url_build()
if (missing(user)) {
rlang::check_installed("askpass")
user <- askpass::askpass(
"Please enter your username (e.g., \"jbgruber.bsky.social\")"
)
}
if(missing(password) || is.null(password)) {
if (interactive()) {
if (verbosity(verbose)) cli::cli_alert_info("Navigate to {.url {url}} and create a new app password")
utils::browseURL(url)
password <- askpass::askpass("Please enter your app password")
} else {
cli::cli_abort("You need to run {.fn auth} in an interactive session")
}
}
if (!is.null(user) && !is.null(password)) {
token <- req_token(user, password)
} else {
cli::cli_abort("You need to supply username and password.")
}
} else {
if (!methods::is(token, "bsky_token")) {
cli::cli_abort("token needs to be an object of class {.emph bsky_token}")
}
token <- refresh_token(token)
}
token$domain <- domain
token$accessJwt <- token$accessJwt
token$refreshJwt <- token$refreshJwt
# it's not clear how long a token is valid. The docs say 'couple minutes'
token$valid_until <- Sys.time() + 3 * 60
# TODO: should not be necessary, but refresh seems broken
token$password <- password
class(token) <- "bsky_token"
f <- Sys.getenv("BSKY_TOKEN", unset = "token.rds")
p <- tools::R_user_dir("atrrr", "cache")
dir.create(p, showWarnings = FALSE, recursive = TRUE)
# store in cache
rlang::env_poke(env = the, nm = "bsky_token", value = token, create = TRUE)
sel <- TRUE
if (file.exists(file.path(p, f)) && !overwrite) {
sel <- utils::askYesNo(
"A token already exists on disk. Do you want to overwrite it?",
default = FALSE
)
}
if (isTRUE(sel)) {
httr2::secret_write_rds(
x = token, path = file.path(p, f),
key = I(rlang::hash("musksucks"))
)
if (verbosity(verbose)) cli::cli_alert_success("Succesfully authenticated!")
invisible(token)
}
}
req_token <- function(user, password) {
# https://atproto.com/specs/xrpc#authentication
httr2::request("https://bsky.social/xrpc/com.atproto.server.createSession") |>
httr2::req_method("POST") |>
httr2::req_body_json(list(
identifier = user,
password = password
)) |>
httr2::req_error(body = error_parse) |>
httr2::req_perform() |>
httr2::resp_body_json()
}
get_token <- function(f = NULL) {
f <- file.path(
tools::R_user_dir("atrrr", "cache"),
Sys.getenv("BSKY_TOKEN", unset = "token.rds")
)
if (rlang::env_has(the, nms = "bsky_token")) {
token <- rlang::env_get(the, nm = "bsky_token", I(rlang::hash("musksucks")))
} else if (file.exists(f)) {
token <- read_token(f)
} else if (!is.null(getOption("httr2_mock", NULL))) {
token <- list(
valid_until = Sys.time() + 10 ^ 7,
accessJwt = "testing",
handle = "testing",
password = "testing"
)
} else {
token <- auth()
}
if (token$valid_until < Sys.time()) {
token <- auth(password = token$password, token = token, verbose = FALSE, overwrite = TRUE)
}
invisible(token)
}
refresh_token <- function(token) {
# TODO: no clue why this doesn't work
# https://github.com/bluesky-social/atproto/blob/main/lexicons/com/atproto/server/refreshSession.json
# httr2::request("https://bsky.social/xrpc/com.atproto.server.refreshSession") |>
# httr2::req_method("POST") |>
# httr2::req_auth_bearer_token(token = token$accessJwt) |>
# httr2::req_body_json(list(
# accessJwt = token$accessJwt,
# refreshJwt = token$refreshJwt,
# handle = token$handle,
# did = token$did
# )) |>
# httr2::req_error(body = error_parse) |>
# httr2::req_perform() |>
# httr2::resp_body_json()
req_token(token$handle, token$password)
}
#' @title Print token
#'
#' @description Print a AT token
#'
#' @param x An object of class \code{bsky_token}
#' @param ... not used.
#'
#' @return No return value, called to print the token to screen
#' @export
print.bsky_token <- function(x, ...) {
cli::cli_h1("Blue Sky token")
cli::cat_bullet(glue::glue("User: {x$handle}"),
background_col = "#0560FF", col = "#F3F9FF"
)
cli::cat_bullet(glue::glue("Domain: {x$domain}"),
background_col = "#0560FF", col = "#F3F9FF"
)
cli::cat_bullet(glue::glue("Valid until: {x$valid_until}"),
background_col = "#0560FF", col = "#F3F9FF"
)
}
read_token <- function(f) {
httr2::secret_read_rds(f, I(rlang::hash("musksucks")))
}