-
Notifications
You must be signed in to change notification settings - Fork 3
/
conn.R
367 lines (353 loc) · 15.8 KB
/
conn.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
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
#' @title Connect to/authenticate with a neuPrint server and its Neo4j database,
#' returning a neuPrint connection object
#'
#' @description \code{neuprint_login} allows you to login to a neuPrint server
#' specified by a \code{neuprint_connection} object. If such an object is not
#' specified, then the last successful connection in this R session is reused
#' if possible otherwise a new connection object is created using
#' \code{environment variables} of the form "neuprint_*" (see details).
#'
#' If your server has more than one dataset available, it is also a good idea
#' to set the default neuPrint dataset you want to work with, either by
#' passing an explicit \code{dataset} argument (to \code{neuprint_login} or
#' \code{neuprint_connection}) when first making the connection or by setting
#' a \code{neuprint_dataset} environment variable.
#'
#' The connection object returned by \code{neuprint_login} (or cached when
#' \code{Cache=TRUE}, the default) can then be used for future requests to the
#' neuPrint server by get/query/fetch functions.
#'
#' @details After successful login, the \code{neuprint_connection} object will
#' contain a \code{cookie} field that includes a sessionid that is required
#' for subsequent GET/POST operations using the package \code{httr}. When
#' \code{Cache=TRUE} (the default) the open connection object is cached and
#' will be used when EITHER \code{neuprint_login} is called with enough
#' information to indicate that the same server is desired OR (when no
#' information about the server is passed to \code{neuprint_login}) the last
#' opened connection will be used. A new connection can be made using
#' \code{Force = TRUE}, which is advisable as a first call for debugging if
#' you are having issues querying the server.
#'
#' @section Token based authentication: neuPrint requires Bearer token based
#' authentication. You can get your token by going to your neuPrint server's
#' webpage and right clicking on the icon showing your Google account on the
#' top right corner, and selecting \bold{AUTH_TOKEN}, or often at your
#' server's address \code{/token}, once you have signed in via your approved
#' Google account. Contact the server's administrators if you do not have
#' access, but think that you should. You can then set the
#' \code{catmaid.token} package option, but no
#'
#' Note that you must \bold{NOT} reveal this token e.g. by checking it into a
#' version controlled script as it gives complete access to your neuPrint
#' account.
#' @param server the neuprint server
#' @param token your personal Bearer token
#' @param dataset A default dataset to use with this connection (you can still
#' override this using the \code{dataset} argument of other \code{neuprintr}
#' functions.)
#' @param conn a neuprintr connection object
#' @param config an \code{httr::\link[httr]{config}} object that can be used to
#' set advanced curl options (e.g. additional authentication, proxy settings
#' etc). See \bold{Curl options} section and \bold{Examples}.
#' @param Cache Whether to cache open connections at login so that they can be
#' reused automatically.
#' @param Force Whether to force a new login to the CATMAID server (default
#' \code{FALSE})
#' @param ... methods passed to \code{neuprint_connection}
#' @return a \code{neuprint_connection} object that can be used to make
#' authenticated https requests to a neuPrint server, specifically by making
#' use of its \code{$config} field.
#'
#' @section Environment variables:
#'
#' You will very likely want to set the following environment variables in
#' your \code{.Renviron} file (see \code{\link{Startup}} for details). This
#' file is read by R on startup. In this way the neuprintr package will
#' automatically login to your preferred neuPrint server. Note that
#' environment variables will also be inherited by child R sessions. This
#' means for example that they will be available when running knitr reports,
#' tests or R CMD Check from RStudio. In order to edit your R.profile or
#' R.environ files easily and directly, try using
#' \code{usethis::edit_r_environ()} and \code{usethis::edit_r_profile()}
#'
#' \itemize{
#'
#' \item{\code{neuprint_server}}
#'
#' \item{\code{neuprint_token}}
#'
#' \item{\code{neuprint_dataset}}
#'
#' } An example \code{.Renviron} file might look like:
#'
#' \preformatted{neuprint_server = "https://neuprint.janelia.org"
#' neuprint_token =
#' "asBatEsiOIJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJlbWFpbCI6ImFsZXhhbmRlci5zaGFrZWVsLmJhdGVzQGdtYWlsLmNvbSIsImxldmVsIjoicmVhZHdyaXRlIiwiaW1hZ2UtdXJsIjoiaHR0cHM7Ly9saDQuZ29vZ2xldXNlcmNvbnRlbnQuY29tLy1QeFVrTFZtbHdmcy9BQUFBQUFBQUFBDD9BQUFBQUFBQUFBQS9BQ0hpM3JleFZMeEI4Nl9FT1asb0dyMnV0QjJBcFJSZlBRL21vL3Bob3RvLapwZz9zej01MCIsImV4cCI6MTczMjc1MjU2HH0.jhh1nMDBPl5A1HYKcszXM518NZeAhZG9jKy3hzVOWEU"}
#'
#' and \bold{must} finish with a return at the end of the last line. Your
#' \code{neuprint_token} is unique to you and must be obtained from a neuPrint
#' web page once you have logged in with an approved Google account.
#'
#' The use of the \code{neuprint_dataset} environment variable is optional and
#' only recommended when your default neuprint server has more than one
#' dataset. This default will \emph{not} apply to connections that refer to a
#' server other than the one specified by the \code{neuprint_server}
#' environment variable.
#'
#' \preformatted{neuprint_dataset = "hemibrain:v1.0"}
#'
#' @section Options: Although setting environment variables is the recommended
#' approach, you can also set R startup options e.g. in your \code{.Rprofile}
#' to specify default neuPrint login options including your personal access
#' token. The startup options have the same names as the environment variables
#' listed above, so you can place code along the lines of:
#'
#' \code{options(neuprint_server = 'https://neuprint.janelia.org',
#' neuprint_token =
#' "asBatEsiOIJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJlbWFpbCI6ImFsZXhhbmRlci5zaGFrZWVsLmJhdGVzQGdtYWlsLmNvbSIsImxldmVsIjoicmVhZHdyaXRlIiwiaW1hZ2UtdXJsIjoiaHR0cHM7Ly9saDQuZ29vZ2xldXNlcmNvbnRlbnQuY29tLy1QeFVrTFZtbHdmcy9BQUFBQUFBQUFBDD9BQUFBQUFBQUFBQS9BQ0hpM3JleFZMeEI4Nl9FT1asb0dyMnV0QjJBcFJSZlBRL21vL3Bob3RvLapwZz9zej01MCIsImV4cCI6MTczMjc1MjU2HH0.jhh1nMDBPl5A1HYKcszXM518NZeAhZG9jKy3hzVOWEU")}
#'
#' in your \code{.Rprofile} (see \code{\link{Startup}} for details). Note that
#' it is important to have a final return at the end of your \code{.Rprofile}
#' file.
#' @section Curl options: \bold{neuprintr} uses the curl library provided by the
#' \code{httr} and \code{curl} packages to carry out remote requests. You can
#' set curl options by passing an \code{httr::\link[httr]{config}} object that
#' can be used to set advanced curl options (e.g. additional authentication,
#' proxy settings etc). See \code{\link[curl]{handle}} and
#' \code{\link[curl]{curl_options}} for a full list of possible options.
#'
#' You can also set default curl options using environment variables with
#' names of the form \code{neuprint_curl_<curloption>}. For example the
#' following entry in you \code{\link{Renviron}} file will set the curl
#' \code{ssl_verifyhost} option:
#'
#' \verb{neuprint_curl_ssl_verifyhost=0}
#' @seealso \code{\link{options}}, \code{\link{Startup}},
#' \code{\link{neuprint_datasets}}
#' @examples
#' \dontrun{
#' ## example explicitly specifying connection options
#' conn = neuprint_login(server= "neuprint.janelia.org",
#' token= "asBatEsiOIJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJlbWFpbCI6ImFsZXhhbmRlci5za
#' GFrZWVsLmJhdGVzQGdtYWlsLmNvbSIsImxldmVsIjoicmVhZHdyaXRlIiwiaW1hZ2UtdXJsIj
#' oiaHR0cHM7Ly9saDQuZ35vZ2xldXNlcmNvbnRlbnQuY29tLy1QeFVrTFZtbHdmcy9BQUFBQUF
#' BQUFBDD9BQUFBQUFBQUFBQS9BQ0hpM3JleFZMeEI4Nl9FT1asb0dyMnV0QjJBcFJSZlBRL21v
#' L3Bob3RvLapwZz9zej01MCIsImV4cCI6MTczMjc1MjM2HH0.jhh1nMDBPl5A1HYKcszXM518NZ
#' eAhZG9jKy3hzVOWEU")
#'
#'
#' ## examples assuming that neuprint_* environment variables/options are set
#' conn = neuprint_login()
#'
#' ## using env vars + config to set advanced curl options
#' neuprint_login(config=httr::config(ssl_verifyhost=0))
#'
#' ## now do stuff with the connection like
#' available.datasets = neuprint_datasets(conn=conn)
#'
#' ## which, if you have edited your R.profile / R.environ, should produce the same results as
#' available.datasets = neuprint_datasets(conn=NULL)
#'
#' # make connection to second server
#' conn2=neuprint_login(server="https://server2.org",
#' token=Sys.getenv('NPSERVER2'))
#'
#' # specify a default dataset (only required when >1 dataset available)
#' conn2=neuprint_login(server="https://server2.org",
#' token=Sys.getenv('NPSERVER2'), dataset="hemibrain")
#'
#' # make a connection to the same server but using a different dataset
#' # this may be more convenient than specifying the dataset argument
#' conn3=neuprint_login(conn2, dataset="vnc")
#' }
#' @export
#' @rdname neuprint_login
neuprint_connection <- function(server=NULL, token=NULL, dataset=NULL,
conn=NULL, config=httr::config()) {
if (!is.null(conn))
return(conn)
# Set a default server if none specified
neuprint_server <-
if(is.null(server)) unlist(getenvoroption("server")) else server
# we will always add one in our calls
neuprint_server <- remove_trailing_slash(neuprint_server)
# Set a default token if none specified
neuprint_token <- if(is.null(token)) unlist(getenvoroption("token")) else token
# collect any curl options defined as environment variables
config=neuprint_curl_options(config)
conn=list(server = neuprint_server, token = neuprint_token, config=config,
dataset=dataset)
class(conn)='neuprint_connection'
conn
}
#' @export
print.neuprint_connection <- function(x, ...) {
cat("Connection to neuPrint server:\n ",
x$server, sep="", "\n")
if(!is.null(x$dataset))
cat("with default dataset:\n ", x$dataset, "\n")
if(!is.null(x$authresponse)) {
cat("Login active since:", httr::headers(x$authresponse)$date)
} else {
cat("No active login")
}
invisible(x)
}
remove_trailing_slash <- function(x) {
if(isTRUE(nzchar(x))) sub("/$", "", x) else x
}
# Hidden
neuprint_last_connection <- function(){
conns = .neuprintr_statevars$connections
num_conns = length(conns)
if (num_conns)
conns[[num_conns]]
else NULL
}
# Hidden
neuprint_cached_connection <- function(conn=NULL){
if (is.null(conn))
return(NULL)
open_connections = names(.neuprintr_statevars$connections)
if (!length(open_connections))
return(NULL)
for (thisconn in open_connections) {
thisconn = .neuprintr_statevars$connections[[thisconn]]
checkfields = c("server", "username", "authname", "authtype")
checkfields = checkfields[!sapply(conn[checkfields],
is.null)]
if (isTRUE(all.equal(thisconn[checkfields], conn[checkfields])))
return(thisconn)
}
return(NULL)
}
# Hidden
neuprint_cache_connection <- function(conn){
.neuprintr_statevars$connections[[neuprint_connection_fingerprint(conn)]] = conn
}
# Hidden
neuprint_connection_fingerprint <- function(conn){
paste(c(conn$server, httr::cookies(conn$authresponse)),
collapse = "")
}
#' @export
#' @name neuprint_login
neuprint_login <- function(conn = NULL, Cache = TRUE, Force = FALSE, ...){
if (is.character(conn) && grepl("^http", conn)) {
stop("To connect to : ", conn, ", you must name the server argument i.e.\n",
sprintf(" neuprint_login(server=\"%s\")", conn))
}
dots=pairlist(...)
# local function to update/check the dataset of the returned connection
check_dataset_nl <- function(conn) {
if(length(dots)==0 || is.null(dots$dataset)) return(conn)
conn$dataset=check_dataset(conn = conn, dataset = dots$dataset)
conn
}
if (is.null(conn)) {
if (length(dots)==0) {
conn = neuprint_last_connection()
}
if (is.null(conn))
conn = neuprint_connection(...)
} else if(!is.null(dots$dataset))
conn$dataset=dots$dataset
if (!Force) {
if (!is.null(conn$authresponse))
return(invisible(check_dataset_nl(conn)))
cached_conn = neuprint_cached_connection(conn)
if (!is.null(cached_conn))
return(invisible(check_dataset_nl(cached_conn)))
}
if(is.null(conn$server))
stop("Sorry you must specify a neuprint server! See ?neuprint_login for details!")
if(is.null(conn$token) && isTRUE(grepl("neuprint.janelia.org", conn$server)))
stop("You must supply an authorisation token for neuprint.janelia.org",
"\nSee http://natverse.org/neuprintr or ?neuprint_login for details!")
if (isTRUE(conn$nologin)) {
conn$authresponse = httr::GET(url = conn$server)
httr::stop_for_status(conn$authresponse)
res_cookies = httr::cookies(conn$authresponse)
GAPS_row = grepl("GAPS", res_cookies$name)
if (any(GAPS_row)) {
token_value = res_cookies$value[GAPS_row][1]
conn$config = httr::add_headers(Authorization = token_value,
referer = conn$server)
}
else warning("I can't seem to find a GAPS token.", "You will not be able to POST to this site!")
} else {
if(is.null(conn$config)) conn$config=httr::config()
conn$config = c(
conn$config,
httr::add_headers(
Authorization = paste0("Bearer ", conn$token),
referer = conn$server,
`Content-Type` = "application/json"
)
)
conn$authresponse = httr::GET(url = conn$server, con=conn$config)
httr::stop_for_status(conn$authresponse)
canonurl=remove_trailing_slash(conn$authresponse$url)
if(!isTRUE(conn$server==canonurl)) {
warning("The URL reported by neuprint server differs from what you specified:\n\n",
paste(" The server URL that you provided : ", conn$server, "\n"),
paste(" Canonical URL according to server: ", canonurl, "\n\n"),
"I will update the URL in this neuprint connection to the canonical URL\n",
"and recommend that you change your configuration to match.\n",
"See ?neuprint_login for more details."
)
conn$server=canonurl
}
}
conn$cookies = unlist(httr::cookies(conn$authresponse))
conn$config = c(conn$config, httr::set_cookies(conn$cookies))
# set a default dataset if none exists / check one specified in connection
conn$dataset=check_dataset(conn = conn)
if (Cache)
neuprint_cache_connection(conn)
invisible(conn)
}
# Hidden
getenvoroption <- function(vars, prefix="neuprint_", ignore.case=TRUE){
fullvars=paste0(prefix, vars)
res <- if(isTRUE(ignore.case)) {
fullvars=tolower(fullvars)
envs=Sys.getenv(names=T)
envsc=envs
names(envsc)=tolower(names(envs))
c(envsc[fullvars])
} else if(isTRUE(.Platform$OS.type=="windows")) {
# getting env vars is not case sensitive on windows
ee=Sys.getenv(names=T, unset=NA)
ee[fullvars]
} else {
Sys.getenv(fullvars, names = T, unset = NA)
}
if(all(is.na(res))){
# no env variables are set, let's try options
res=do.call(options, as.list(fullvars))
} else {
# convert environment variables into options style list
res=as.list(res)
# replace missing values with NULL
res=sapply(res, function(x) if(is.na(x)) NULL else x, simplify = F)
}
# give result the original variable names
names(res)=vars
res
}
# for curl options defined as environment variables
neuprint_curl_options <- function(extra_opts=httr::config()) {
envs=Sys.getenv()
curlopts=envs[grepl("^neuprint_curl_", names(envs))]
if (length(curlopts)) {
names(curlopts) = sub("neuprint_curl_", "", names(curlopts))
} else {
curlopts = list()
}
keep=setdiff(names(curlopts), names(extra_opts$options))
curlopts=as.list(curlopts[keep])
# environment variables come in as strings, but sometimes we want numbers
curlopts <- sapply(curlopts, function(x) switch(x, `0`=0L, `1`=1L, x), simplify = F)
c(extra_opts, do.call(httr::config, curlopts))
}