fix: add form encode

[clemens-tolboom]

REF T#9849

KeyCloak

For fetching device token from a KeyCloak server we need to use form encoding.

Initial idea

• encode is a new argument and depending on the OIDC server (KeyCloak) must be set to form
  • defaults to json
• We must add this to Armadillo client and tell our users
  • Can we fix the above by identifying the OIDC encode preference
• Add example using encode

Better alternative

Use the tryCatch from comment below. From first approach nesting is bad and bailing out still not understood

• make function ...ByEncoding for the first POST
• try json first as that's the default for calling ...ByEncoding
• when unsuccessful use form and retry calling ...ByEncoding
• when success use encoding for the second POST
• when failed all encoding types bail out

How to test

• Checkout the PR and run this from RStudio
• Select SurfConext
• Select UMCG

library(MolgenisArmadillo)
#library(MolgenisAuth)
source("R/auth.R")

url <- "https://auth1.molgenis.net/realms/Molgenis"

client_id <- "Dev-Armadillo-Test"

endpoint <- discover(url)
endpoint

encode <- "form"

credentials <- device_flow_auth(endpoint, client_id, encode=encode)
credentials$id_token

Checking server capabilities

This does not reveil choosing between json or form

curl https://auth1.molgenis.net/realms/Molgenis/.well-known/openid-configuration

form in json section ".response_modes_supported" and there is no request related field

Affects

• molgenis-r-datashield https://github.com/molgenis/molgenis-r-datashield/blob/master/R/ArmadilloOAuth.R#L12-L20
• molgenis-r-armadillo https://github.com/molgenis/molgenis-r-armadillo/blob/master/R/auth.R#L63-L71

[timcadman]

I've tested this and it worked fine. I first got directed to a webpage that informed me that they would send me an email to confirm I am who I say I am. This took a few mins, but once I confimed the process completed and I received the token.

[timcadman]

To be consistent, we could all use the 'styler' R package to style our R code based on the same guidelines.

[clemens-tolboom]

I dirty changed my testscript into tryCatch probing both json and form ... which seems to work fine.

Not sure how to move that into the response <- httr::POST(endpoint$device, call yet but then we can keep the solution into this repo which would be great.

tryCatch test script

# Manual test

library(MolgenisArmadillo)

#library(MolgenisAuth)
source("R/auth.R")

url <- "https://auth.molgenis.org"
url <- "https://auth1.molgenis.net/realms/Molgenis"

client_id <- "Dev-Armadillo-Test"
#browser()
endpoint <- discover(url)
endpoint

encode <- "json"
credentials <- NULL
#credentials <- device_flow_auth(endpoint, client_id, encode=encode)


tryCatch(credentials <- device_flow_auth(endpoint, client_id, encode='json'),
         finally = tryCatch(credentials <- device_flow_auth(endpoint, client_id, encode='form'),
                            finally = credentials <- NULL)
)
credentials$id_token

[clemens-tolboom]

Trying to fix in auth.R using nested tryCatch POST using json first then on error POST form request is:

• bad code
• fails swapping the order of the tryCatch-es
• nesting makes adding other protocols difficult
  • http::POST values `encode = c("multipart", "form", "json", "raw")
  • OIDC fragment, url-encoded`
• tryCatch should we use error

    encode <- NULL
    tryCatch({
      encode = "json"
      response <- httr::POST(endpoint$device,
        encode = encode,
        body = list(
          client_id = client_id,
          scope = paste(scopes, collapse = " ")
        )
      )
    }, error = tryCatch({
        encode <- "form"
        response <- httr::POST(endpoint$device,
          encode = encode,
          body = list(
            client_id = client_id,
            scope = paste(scopes, collapse = " ")
          )
        )
      })
    )

[timcadman]

How about something like this:

    all_encoding_options <- c("json", "form", "multipart", "raw")
    encoding_ordered <-  c(encode, all_encoding_options[all_encoding_options != encode])
    response = list(status_code = 415)
    attempt <- 0

    while(response$status_code != 200 & attempt < length(options)) {
      attempt <- attempt + 1
      encoding <- encoding_ordered[attempt]
      try(
        response <- httr::POST(
          endpoint$device,
          encode = encoding,
          body = list(
            client_id = client_id,
            scope = paste(scopes, collapse = " ")
          )
        )
      )
    }

    if(response$status_code != 200){
      stop("No encoding methods worked")
      }

Possible advantages

• Robust to swapping order of encoding protocol
• Scalable to other protocols
• Attempts user-defined protocol first and proceeds to others if failure

Disadvantages

• Still bad code?
• Doesn't return specific error messages.