├── .Rbuildignore ├── .github ├── .gitignore ├── CODE_OF_CONDUCT.md └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ ├── pr-commands.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── aaa.R ├── formatters.R ├── import-standalone-obj-type.R ├── import-standalone-types-check.R ├── parsers.R ├── problems.R ├── reqres-package.R ├── request.R ├── response.R ├── sysdata.rda └── zzz.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── data-raw └── internal.R ├── man ├── Request.Rd ├── Response.Rd ├── abort_http_problem.Rd ├── default_formatters.Rd ├── default_parsers.Rd ├── figures │ ├── lifecycle-deprecated.svg │ ├── lifecycle-experimental.svg │ ├── lifecycle-stable.svg │ ├── lifecycle-superseded.svg │ └── logo.png ├── formatters.Rd ├── http_date.Rd ├── mime_type_from_file.Rd ├── parsers.Rd ├── query_parser.Rd ├── random_key.Rd ├── reqres-package.Rd └── session_cookie.Rd ├── pkgdown └── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico ├── revdep ├── README.md ├── cran.md ├── failures.md └── problems.md ├── src └── reqres.c └── tests ├── testthat.R └── testthat ├── _snaps ├── problems.md ├── request.md ├── response.md └── session-cookie.md ├── test-aaa.R ├── test-formatters.R ├── test-parsers.R ├── test-problems.R ├── test-request.R ├── test-response.R └── test-session-cookie.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README-.*\.png$ 5 | ^\.travis\.yml$ 6 | ^appveyor\.yml$ 7 | ^codecov\.yml$ 8 | ^CODE_OF_CONDUCT\.md$ 9 | ^_pkgdown\.yml$ 10 | ^docs$ 11 | ^pkgdown$ 12 | ^cran-comments\.md$ 13 | ^revdep$ 14 | ^CRAN-RELEASE$ 15 | ^\.github$ 16 | ^CRAN-SUBMISSION$ 17 | ^data-raw$ 18 | ^compile_commands\.json$ 19 | ^\.cache$ 20 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at codeofconduct@posit.co. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | 12 | name: R-CMD-check.yaml 13 | 14 | permissions: read-all 15 | 16 | jobs: 17 | R-CMD-check: 18 | runs-on: ${{ matrix.config.os }} 19 | 20 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 21 | 22 | strategy: 23 | fail-fast: false 24 | matrix: 25 | config: 26 | - {os: macos-latest, r: 'release'} 27 | 28 | - {os: windows-latest, r: 'release'} 29 | # use 4.0 or 4.1 to check with rtools40's older compiler 30 | - {os: windows-latest, r: 'oldrel-4'} 31 | 32 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 33 | - {os: ubuntu-latest, r: 'release'} 34 | - {os: ubuntu-latest, r: 'oldrel-1'} 35 | - {os: ubuntu-latest, r: 'oldrel-2'} 36 | - {os: ubuntu-latest, r: 'oldrel-3'} 37 | - {os: ubuntu-latest, r: 'oldrel-4'} 38 | 39 | env: 40 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 41 | R_KEEP_PKG_SOURCE: yes 42 | 43 | steps: 44 | - uses: actions/checkout@v4 45 | 46 | - uses: r-lib/actions/setup-pandoc@v2 47 | 48 | - uses: r-lib/actions/setup-r@v2 49 | with: 50 | r-version: ${{ matrix.config.r }} 51 | http-user-agent: ${{ matrix.config.http-user-agent }} 52 | use-public-rspm: true 53 | 54 | - uses: r-lib/actions/setup-r-dependencies@v2 55 | with: 56 | extra-packages: any::rcmdcheck 57 | needs: check 58 | 59 | - uses: r-lib/actions/check-r-package@v2 60 | with: 61 | upload-snapshots: true 62 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 63 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - name: Build site 40 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 41 | shell: Rscript {0} 42 | 43 | - name: Deploy to GitHub pages 🚀 44 | if: github.event_name != 'pull_request' 45 | uses: JamesIves/github-pages-deploy-action@v4.5.0 46 | with: 47 | clean: false 48 | branch: gh-pages 49 | folder: docs 50 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | issue_comment: 5 | types: [created] 6 | 7 | name: pr-commands.yaml 8 | 9 | permissions: read-all 10 | 11 | jobs: 12 | document: 13 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 14 | name: document 15 | runs-on: ubuntu-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | permissions: 19 | contents: write 20 | steps: 21 | - uses: actions/checkout@v4 22 | 23 | - uses: r-lib/actions/pr-fetch@v2 24 | with: 25 | repo-token: ${{ secrets.GITHUB_TOKEN }} 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::roxygen2 34 | needs: pr-document 35 | 36 | - name: Document 37 | run: roxygen2::roxygenise() 38 | shell: Rscript {0} 39 | 40 | - name: commit 41 | run: | 42 | git config --local user.name "$GITHUB_ACTOR" 43 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 44 | git add man/\* NAMESPACE 45 | git commit -m 'Document' 46 | 47 | - uses: r-lib/actions/pr-push@v2 48 | with: 49 | repo-token: ${{ secrets.GITHUB_TOKEN }} 50 | 51 | style: 52 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 53 | name: style 54 | runs-on: ubuntu-latest 55 | env: 56 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 57 | permissions: 58 | contents: write 59 | steps: 60 | - uses: actions/checkout@v4 61 | 62 | - uses: r-lib/actions/pr-fetch@v2 63 | with: 64 | repo-token: ${{ secrets.GITHUB_TOKEN }} 65 | 66 | - uses: r-lib/actions/setup-r@v2 67 | 68 | - name: Install dependencies 69 | run: install.packages("styler") 70 | shell: Rscript {0} 71 | 72 | - name: Style 73 | run: styler::style_pkg() 74 | shell: Rscript {0} 75 | 76 | - name: commit 77 | run: | 78 | git config --local user.name "$GITHUB_ACTOR" 79 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 80 | git add \*.R 81 | git commit -m 'Style' 82 | 83 | - uses: r-lib/actions/pr-push@v2 84 | with: 85 | repo-token: ${{ secrets.GITHUB_TOKEN }} 86 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | covr::to_cobertura(cov) 38 | shell: Rscript {0} 39 | 40 | - uses: codecov/codecov-action@v4 41 | with: 42 | # Fail if error if not on PR, or if on PR and token is given 43 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 44 | file: ./cobertura.xml 45 | plugin: noop 46 | disable_search: true 47 | token: ${{ secrets.CODECOV_TOKEN }} 48 | 49 | - name: Show testthat output 50 | if: always() 51 | run: | 52 | ## -------------------------------------------------------------------- 53 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 54 | shell: bash 55 | 56 | - name: Upload test results 57 | if: failure() 58 | uses: actions/upload-artifact@v4 59 | with: 60 | name: coverage-test-failures 61 | path: ${{ runner.temp }}/package 62 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | reqres.Rproj 6 | docs/ 7 | compile_commands.json 8 | .cache 9 | src/*.o 10 | src/*.so 11 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: reqres 2 | Type: Package 3 | Title: Powerful Classes for HTTP Requests and Responses 4 | Version: 1.0.0.9000 5 | Authors@R: 6 | c(person(given = "Thomas Lin", 7 | family = "Pedersen", 8 | role = c("cre", "aut"), 9 | email = "thomasp85@gmail.com", 10 | comment = c(ORCID = "0000-0002-5147-4711"))) 11 | Maintainer: Thomas Lin Pedersen 12 | Description: In order to facilitate parsing of http requests and creating 13 | appropriate responses this package provides two classes to handle a lot of 14 | the housekeeping involved in working with http exchanges. The infrastructure 15 | builds upon the 'rook' specification and is thus well suited to be combined 16 | with 'httpuv' based web servers. 17 | License: MIT + file LICENSE 18 | Encoding: UTF-8 19 | Depends: 20 | R (>= 3.5) 21 | Imports: 22 | R6, 23 | stringi, 24 | urltools, 25 | tools, 26 | brotli, 27 | jsonlite, 28 | xml2, 29 | webutils, 30 | utils, 31 | cli, 32 | rlang, 33 | lifecycle, 34 | base64enc, 35 | sodium, 36 | promises, 37 | mirai 38 | RoxygenNote: 7.3.2 39 | Roxygen: list(markdown = TRUE) 40 | Suggests: 41 | fiery, 42 | testthat (>= 3.0.0), 43 | covr, 44 | keyring, 45 | shiny 46 | URL: https://reqres.data-imaginist.com, https://github.com/thomasp85/reqres 47 | BugReports: https://github.com/thomasp85/reqres/issues 48 | Config/testthat/edition: 3 49 | Config/build/compilation-database: true 50 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2017 2 | COPYRIGHT HOLDER: Thomas Lin Pedersen 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.Request,Request) 4 | S3method(as.Request,environment) 5 | S3method(as.list,Response) 6 | S3method(print,session_cookie_settings) 7 | export(Request) 8 | export(Response) 9 | export(abort_bad_request) 10 | export(abort_conflict) 11 | export(abort_forbidden) 12 | export(abort_gone) 13 | export(abort_http_problem) 14 | export(abort_internal_error) 15 | export(abort_method_not_allowed) 16 | export(abort_not_acceptable) 17 | export(abort_not_found) 18 | export(abort_status) 19 | export(abort_unauthorized) 20 | export(as.Request) 21 | export(default_formatters) 22 | export(default_parsers) 23 | export(format_html) 24 | export(format_json) 25 | export(format_plain) 26 | export(format_table) 27 | export(format_xml) 28 | export(from_http_date) 29 | export(handle_problem) 30 | export(is.Request) 31 | export(is.Response) 32 | export(is_reqres_problem) 33 | export(is_session_cookie_settings) 34 | export(mime_type_from_file) 35 | export(mime_type_info) 36 | export(parse_html) 37 | export(parse_json) 38 | export(parse_multiform) 39 | export(parse_plain) 40 | export(parse_queryform) 41 | export(parse_table) 42 | export(parse_xml) 43 | export(query_parser) 44 | export(random_key) 45 | export(session_cookie) 46 | export(to_http_date) 47 | import(rlang) 48 | importFrom(R6,R6Class) 49 | importFrom(base64enc,base64decode) 50 | importFrom(base64enc,base64encode) 51 | importFrom(brotli,brotli_compress) 52 | importFrom(brotli,brotli_decompress) 53 | importFrom(jsonlite,fromJSON) 54 | importFrom(jsonlite,toJSON) 55 | importFrom(lifecycle,deprecated) 56 | importFrom(mirai,mirai) 57 | importFrom(promises,then) 58 | importFrom(stringi,stri_extract_first_regex) 59 | importFrom(stringi,stri_match_first_regex) 60 | importFrom(stringi,stri_split_fixed) 61 | importFrom(stringi,stri_split_regex) 62 | importFrom(stringi,stri_trim_both) 63 | importFrom(tools,file_ext) 64 | importFrom(tools,file_path_as_absolute) 65 | importFrom(urltools,url_decode) 66 | importFrom(urltools,url_encode) 67 | importFrom(utils,capture.output) 68 | importFrom(utils,modifyList) 69 | importFrom(utils,read.table) 70 | importFrom(utils,write.table) 71 | importFrom(webutils,parse_multipart) 72 | importFrom(xml2,as_xml_document) 73 | importFrom(xml2,read_xml) 74 | useDynLib(reqres, .registration = TRUE) 75 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # reqres (development version) 2 | 3 | # reqres 1.0.0 4 | 5 | * Use rlang native type checking instead of assertthat 6 | * Avoid request parsing until needed (if ever) 7 | * Fix bug that resulted in unintentional splitting of headers containing 8 | date-times (#11) 9 | * Improved query parsing that properly handles various forms of array notation 10 | (exploded and non-exploded with different delimiters). 11 | * BREAKING: query values are no longer automatically type converted during 12 | parsing as this could lead to loss of information. 13 | * DEPRECATED: `Request$parse()`, `Response$set_links()`, and `Response$format()` 14 | has soft deprecated passing in a list of values as the first element. Instead 15 | use `!!!` splicing 16 | * `Response$status_with_text()` now has a `clear_headers` argument 17 | * Added `Response$set_formatter()` method and `Response$formatter` and 18 | `Response$is_formatted` fields to allow delaying formatting until the 19 | response is sent off 20 | * The `Date` header is now always added if missing 21 | * `Request$is()` is now vectorised and provides the prefered choice as an 22 | attribute in the return 23 | * New condition signalling based on the HTTP Problems Spec. Request and response 24 | objects will now throw classed errors where they are encounters so that server 25 | implementations can catch these and handle them sensibly. This is in 26 | opposition to the prior setup where reqres would handle any errors internally 27 | leaving the server implementation in the blank 28 | * Added `Response$clear_cookie()` for requesting the client to remove the cookie 29 | * `Response$set_cookie()` now also accepts `same_site = "None"` if 30 | `secure = TRUE` is also given 31 | * Added `Request$encode_string()` and `Request$decode_string()` with the 32 | possibility of encrypting a string as well with a `key` given during 33 | initialisation 34 | * Added facilities for maintaining a session data store through an encrypted 35 | session cookie. The data store is made available through the `session` field 36 | in both `Request` and `Response` and the content will automatically be send 37 | along with the response as an encrypted cookie. 38 | * Added `random_key()` and `session_cookie()` helper functions to support the 39 | above 40 | * Added `Response$data_store` field to suppleant `Response$get_data()` and 41 | friends. It provides direct acces to the response data store 42 | * Fixed bug in `format_xml()` and `format_html()` that prevented standard lists 43 | to be converted 44 | * Responses now correctly sets the `Vary` header when performing content 45 | negotiation 46 | * Add `compression_limit` setting to control when compression is tried 47 | * `Request` and `Response` objects are no longer locked, as it decreases 48 | construction time. For debugging purpose you can still change this in the 49 | constructor class in your debug session 50 | * `to_http_date()` is now written in C as formatting POSIX values had an 51 | unacceptable overhead 52 | * Added some interface functions to the Mime database 53 | * Add functionality for resetting and reusing objects to avoid construction 54 | overhead 55 | * Added `Request$forward()` to asynchronously forward a request to another url 56 | and populate the `Response` object with the response 57 | * `Request$new()` now takes a `response_headers` argument that can be set to a 58 | list of headers the response should be prepopulated with 59 | 60 | # reqres 0.2.5 61 | 62 | * General upkeep 63 | * Fix bug whith unnamed cookies (#12) 64 | 65 | # reqres 0.2.3 66 | 67 | * Fixed bug in Cookie parsing when cookie strings would include `=` 68 | * Added pkgdown site at https://reqres.data-imaginist.com 69 | 70 | # reqres 0.2.2 71 | 72 | * Fixed bug in querystring parsing where the first key would retain the `?` 73 | 74 | # reqres 0.2.1 75 | 76 | * Added `querystring` field to `Request`. 77 | * Added `calculate_length()` method to `Response`. 78 | * Added `as_message()` method to `Request` and `Response`. 79 | 80 | # reqres 0.2.0 81 | 82 | * Moved to a shallow dependency of Rook, making it easier to substitute or 83 | expand to other request formats 84 | * Added content negotiation and body parsing and formatting 85 | 86 | # reqres 0.1.0 87 | 88 | * Migrated Request and Response classes from 89 | [`routr`](https://github.com/thomasp85/routr) 90 | -------------------------------------------------------------------------------- /R/aaa.R: -------------------------------------------------------------------------------- 1 | #' Format timestamps to match the HTTP specs 2 | #' 3 | #' Dates/times in HTTP headers needs a specific format to be valid, and is 4 | #' furthermore always given in GMT time. These two functions aids in converting 5 | #' back and forth between the required format. 6 | #' 7 | #' @param time A string or an object coercible to POSIXct 8 | #' @param format In case `time` is not a POSIXct object a specification how the 9 | #' string should be interpreted. 10 | #' 11 | #' @return `to_http_date()` returns a properly formatted string, while 12 | #' `from_http_date()` returns a POSIXct object 13 | #' 14 | #' @rdname http_date 15 | #' @export 16 | #' 17 | #' @examples 18 | #' time <- to_http_date(Sys.time()) 19 | #' time 20 | #' from_http_date(time) 21 | to_http_date <- function(time, format = NULL) { 22 | time <- as.POSIXct(time, format = format) 23 | .Call(fmt_http_time_c, as.integer(time), PACKAGE = "reqres") 24 | } 25 | current_time <- function() { 26 | .Call(fmt_http_time_c, NULL, PACKAGE = "reqres") 27 | } 28 | #' @rdname http_date 29 | #' @export 30 | from_http_date <- function(time) { 31 | as.POSIXct(time, format = '%a, %d %b %Y %H:%M:%S', tz = 'GMT') 32 | } 33 | 34 | #' Parse a query string 35 | #' 36 | #' This function facilitates the parsing of querystrings, either from the URL or 37 | #' a POST or PUT body with `Content-Type` set to 38 | #' `application/x-www-form-urlencoded`. 39 | #' 40 | #' @param query The query as a single string 41 | #' @param delim Optional delimiter of array values. If omitted it is expected 42 | #' that arrays are provided in exploded form (e.g. `arg1=3&arg1=7`) 43 | #' 44 | #' @return A named list giving the keys and values of the query. Values fron the 45 | #' same key are combined if given multiple times 46 | #' 47 | #' @export 48 | #' 49 | #' @examples 50 | #' # Using delimiter to provide array 51 | #' query_parser("?name=Thomas+Lin+Pedersen&numbers=1%202%203", delim = " ") 52 | #' 53 | #' # No delimiter (exploded form) 54 | #' query_parser("?name=Thomas%20Lin%20Pedersen&numbers=1&numbers=2&numbers=3") 55 | #' 56 | query_parser <- function(query = NULL, delim = NULL) { 57 | if (is.null(query) || query == '') return(list()) 58 | if (isTRUE(delim == " ")) delim <- "%20" 59 | check_string(query, allow_null = TRUE) 60 | query <- stringi::stri_replace_first_regex(query, '^\\?', '') 61 | query <- stringi::stri_split_fixed(query, '&')[[1]] 62 | query <- stringi::stri_split_fixed(query, '=') 63 | id <- rep(seq_along(query), lengths(query)) 64 | query <- unlist(query) 65 | if (!is.null(delim)) { 66 | query <- stringi::stri_split_fixed(query, delim) 67 | id <- rep(id, lengths(query)) 68 | query <- unlist(query) 69 | } 70 | query <- stringi::stri_replace_all_fixed(query, '+', ' ') 71 | query <- url_decode(query) 72 | key_ind <- which(!duplicated(id)) 73 | key <- query[key_ind] 74 | final_keys <- unique(key) 75 | final <- structure(vector("list", length(final_keys)), names = final_keys) 76 | value_loc <- match(key, final_keys)[id[-key_ind]] 77 | final[unique(value_loc)] <- split(query[-key_ind], value_loc) 78 | final 79 | } 80 | 81 | #' Get the mime type associated with a file based on its file extension 82 | #' 83 | #' While file extensions are not universally guaranteed to be tied to the 84 | #' content of a file, they are often indicative of the content to the degree 85 | #' that they can be used if the content type is missing. `mime_type_from_file` 86 | #' gives access to the huge database of mime types and their file extensions 87 | #' that reqres contains. `mime_type_info()` provides the same information but 88 | #' rather than basing the search on a file, you provide the known mime type 89 | #' directly 90 | #' 91 | #' @param filename The name of the file to query 92 | #' @param type The mime type to get additional information on 93 | #' 94 | #' @return A data.frame with a row for each match and the columns: 95 | #' * *name* The mime type 96 | #' * *extensions* The extensions commonly associated with the mime type 97 | #' * *charset* The character set used for the type, if any 98 | #' * *compressible* Is the type known to be compressible 99 | #' * *source* The source of the mime type information 100 | #' 101 | #' @export 102 | #' @keywords internal 103 | mime_type_from_file <- function(filename) { 104 | ext <- tolower(stringi::stri_match_first_regex( 105 | filename, 106 | "\\.([^\\.]+)$", 107 | cg_missing = "" 108 | )[,2]) 109 | mimes[mimes_ext$index[match(ext, mimes_ext$ext)], ] 110 | } 111 | #' @rdname mime_type_from_file 112 | #' @export 113 | mime_type_info <- function(type) { 114 | mimes[match(type, mimes$name), ] 115 | } 116 | 117 | req_headers <- c( 118 | 'Accept', 119 | 'Accept_Charset', 120 | 'Accept_Encoding', 121 | 'Accept_Language', 122 | 'Authorization', 123 | 'Expect', 124 | 'From', 125 | 'Host', 126 | 'If_Match', 127 | 'If_Modified_Since', 128 | 'If_None_Match', 129 | 'If_Range', 130 | 'If_Unmodified_Since', 131 | 'Max_Forwards', 132 | 'Proxy_Authorization', 133 | 'Range', 134 | 'Referer', 135 | 'TE', 136 | 'User_Agent', 137 | 'Cache-Control', 138 | 'Connection', 139 | 'Date', 140 | 'Pragma', 141 | 'Trailer', 142 | 'Transfer_Encoding', 143 | 'Upgrade', 144 | 'Via', 145 | 'Warning' 146 | ) 147 | res_headers <- c( 148 | 'Accept_Ranges', 149 | 'Age', 150 | 'ETag', 151 | 'Location', 152 | 'Proxy_Authenticate', 153 | 'Retry_After', 154 | 'Server', 155 | 'Vary', 156 | 'WWW_Authenticate', 157 | 'Cache-Control', 158 | 'Connection', 159 | 'Date', 160 | 'Pragma', 161 | 'Trailer', 162 | 'Transfer_Encoding', 163 | 'Upgrade', 164 | 'Via', 165 | 'Warning' 166 | ) 167 | split_headers <- function(headers) { 168 | request <- names(headers) %in% tolower(req_headers) 169 | response <- names(headers) %in% tolower(res_headers) 170 | entity <- !request & !response 171 | list( 172 | request = headers[request], 173 | response = headers[response], 174 | entity = headers[entity] 175 | ) 176 | } 177 | cat_headers <- function(headers) { 178 | if (length(headers) == 0) return(invisible()) 179 | names(headers) <- gsub("(^|-)([[:alpha:]])", "\\1\\U\\2", 180 | gsub('_', '-', names(headers)), 181 | perl = TRUE) 182 | headers <- lapply(headers, paste, collapse = ', ') 183 | for(i in names(headers)) { 184 | cat(i, ': ', headers[[i]], '\n', sep = '') 185 | } 186 | invisible() 187 | } 188 | 189 | tri <- function(expr) try_fetch(expr, error = function(e, ...) e) 190 | 191 | #' Generate a random key compatible with encryption and decryption in requests and responses 192 | #' 193 | #' The encryption/decryption used in reqres is based on the [sodium](https://github.com/r-lib/sodium) 194 | #' package and requires a 32-bit encryption key encoded as hexadecimal values. 195 | #' While you can craft your own, this function will take care of creating a 196 | #' compliant key using a cryptographically secure pseudorandom number generator 197 | #' from `sodium::helpers()`. 198 | #' 199 | #' 200 | #' Keep your encryption keys safe! Anyone with the key will be able to eavesdrop 201 | #' on your communication and tamper with the information stored in encrypted 202 | #' cookies through man-in-the-middle attacks. The best approach is to use the 203 | #' keyring package to manage your keys, but as an alternative you can store it 204 | #' as environment variables. 205 | #' 206 | #' **NEVER STORE THE KEY IN PLAIN TEXT.** 207 | #' 208 | #' **NEVER PUT THE KEY SOMEWHERE WHERE IT CAN ACCIDENTALLY BE COMMITTED TO GIT OR 209 | #' OTHER VERSION CONTROL SOFTWARE** 210 | #' 211 | #' @return A 32-bit key as a hex-encoded string 212 | #' 213 | #' @export 214 | #' 215 | #' @examplesIf FALSE 216 | #' # Store a key with keyring and use it 217 | #' keyring::key_set_with_value("reqres_key", random_key()) 218 | #' 219 | #' rook <- fiery::fake_request("http://example.com") 220 | #' 221 | #' Request$new(rook, key = keyring::key_get("reqres_key")) 222 | #' 223 | random_key <- function() { 224 | sodium::bin2hex( 225 | sodium::random(32) 226 | ) 227 | } 228 | 229 | #' Collect settings for a session cookie 230 | #' 231 | #' A session cookie is just like any other cookie, but reqres treats this one 232 | #' different, parsing it's value and making it available in the `$session` 233 | #' field. However, the same settings as any other cookies applies and can be 234 | #' given during request initialisation using this function. 235 | #' 236 | #' @note As opposed to regular cookies the session cookie is forced to be HTTP 237 | #' only which is why this argument is missing. 238 | #' 239 | #' @param name The name of the cookie 240 | #' @param expires A POSIXct object given the expiration time of the cookie 241 | #' @param max_age The number of seconds to elapse before the cookie expires 242 | #' @param path The URL path this cookie is related to 243 | #' @param secure Should the cookie only be send over https 244 | #' @param same_site Either `"Lax"`, `"Strict"`, or `"None"` indicating 245 | #' how the cookie can be send during cross-site requests. If this is set to 246 | #' `"None"` then `secure` *must* also be set to `TRUE` 247 | #' 248 | #' @return A `session_cookie_settings` object that can be used during request 249 | #' initialisation. Can be cached and reused for all requests in a server 250 | #' 251 | #' @export 252 | #' 253 | #' @examples 254 | #' session_cookie <- session_cookie() 255 | #' 256 | #' rook <- fiery::fake_request("http://example.com") 257 | #' 258 | #' # A key must be provided for session_cookie to be used 259 | #' Request$new(rook, key = random_key(), session_cookie = session_cookie) 260 | #' 261 | session_cookie <- function(name = "reqres", expires = NULL, max_age = NULL, 262 | path = NULL, secure = NULL, same_site = NULL) { 263 | check_string(name) 264 | opts <- cookie("", expires = expires, http_only = TRUE, max_age = max_age, path = path, secure = secure, same_site = same_site) 265 | structure(list( 266 | name = name, 267 | options = sub("^=", "", opts) 268 | ), class = "session_cookie_settings") 269 | } 270 | #' @rdname session_cookie 271 | #' @param x An object to test 272 | #' @export 273 | is_session_cookie_settings <- function(x) inherits(x, "session_cookie_settings") 274 | #' @export 275 | print.session_cookie_settings <- function(x, ...) { 276 | cli::cli_text("Settings for a session cookie named {.field {x$name}}") 277 | cli::cli_text("{.emph Attributes: {sub('; ', '', x$options)}}") 278 | } 279 | 280 | status_phrase <- function(code) { 281 | status$message[match(code, status$code)] 282 | } 283 | status_link <- function(code) { 284 | status$link[match(code, status$code)] 285 | } 286 | -------------------------------------------------------------------------------- /R/formatters.R: -------------------------------------------------------------------------------- 1 | #' Pre-supplied formatting generators 2 | #' 3 | #' This set of functions can be used to construct formatting functions adhering 4 | #' to the Response$format() requirements. 5 | #' 6 | #' @return A function accepting an R object 7 | #' 8 | #' @rdname formatters 9 | #' @name formatters 10 | #' 11 | #' @seealso [parsers] for converting `Request` bodies into R objects 12 | #' @seealso [default_formatters] for a list that maps the most common mime types 13 | #' to their respective formatters 14 | #' 15 | #' @examples 16 | #' fake_rook <- fiery::fake_request( 17 | #' 'http://example.com/test', 18 | #' content = '', 19 | #' headers = list( 20 | #' Content_Type = 'text/plain', 21 | #' Accept = 'application/json, text/csv' 22 | #' ) 23 | #' ) 24 | #' 25 | #' req <- Request$new(fake_rook) 26 | #' res <- req$respond() 27 | #' res$body <- mtcars 28 | #' res$format(json = format_json(), csv = format_table(sep=',')) 29 | #' res$body 30 | #' 31 | #' # Cleaning up connections 32 | #' rm(fake_rook, req, res) 33 | #' gc() 34 | #' 35 | NULL 36 | 37 | #' @rdname formatters 38 | #' 39 | #' @inheritParams jsonlite::toJSON 40 | #' 41 | #' @importFrom jsonlite toJSON 42 | #' @export 43 | format_json <- function(dataframe = 'rows', matrix = 'rowmajor', Date = 'ISO8601', 44 | POSIXt = 'string', factor = 'string', complex = 'string', 45 | raw = 'base64', null = 'list', na = 'null', 46 | auto_unbox = FALSE, digits = 4, pretty = FALSE, force = FALSE) { 47 | function(x) { 48 | toJSON(x,dataframe = dataframe, matrix = matrix, Date = Date, 49 | POSIXt = POSIXt, factor = factor, complex = complex, 50 | raw = raw, null = null, na = na, auto_unbox = auto_unbox, 51 | digits = digits, pretty = pretty, force = force) 52 | } 53 | } 54 | #' @rdname formatters 55 | #' 56 | #' @param sep The line separator. Plain text will be split into multiple strings 57 | #' based on this. 58 | #' 59 | #' @export 60 | format_plain <- function(sep = '\n') { 61 | function(x) { 62 | paste(as.character(unlist(x)), collapse = sep) 63 | } 64 | } 65 | #' @rdname formatters 66 | #' 67 | #' @inheritParams xml2::write_xml 68 | #' @param root_name The name of the root element of the created xml 69 | #' 70 | #' @importFrom xml2 as_xml_document 71 | #' @export 72 | format_xml <- function(root_name = "document", encoding = 'UTF-8', options = 'as_xml') { 73 | options <- union('as_xml', options) 74 | function(x) { 75 | if (is_bare_string(x)) return(x) 76 | x <- listify(x) 77 | if (!isTRUE(names(x) == root_name)) { 78 | x <- list2(!!root_name := x) 79 | } 80 | as.character(as_xml_document(x), encoding = encoding, options = options) 81 | } 82 | } 83 | #' @rdname formatters 84 | #' 85 | #' @importFrom xml2 as_xml_document 86 | #' @export 87 | format_html <- function(encoding = 'UTF-8', options = 'as_html') { 88 | options <- union('as_html', options) 89 | function(x) { 90 | if (is_bare_string(x)) return(x) 91 | if (inherits(x, "shiny.tag")) return(as.character(x)) 92 | x <- listify(x) 93 | if (!isTRUE(names(x) == "html")) { 94 | x <- list(html = x) 95 | } 96 | as.character(as_xml_document(x), encoding = encoding, options = options) 97 | } 98 | } 99 | #' @rdname formatters 100 | #' 101 | #' @param ... parameters passed on to [write.table()] 102 | #' 103 | #' @importFrom utils write.table capture.output 104 | #' @export 105 | format_table <- function(...) { 106 | function(x) { 107 | paste(capture.output(write.table(x, file = '', ...)), collapse = '\n') 108 | } 109 | } 110 | #' A list of default formatter mappings 111 | #' 112 | #' This list matches the most normal mime types with their respective formatters 113 | #' using default arguments. For a no-frills request parsing this can be supplied 114 | #' directly to `Response$format()`. To add or modify to this list simply supply 115 | #' the additional parsers as second, third, etc, argument and they will 116 | #' overwrite or add depending on whether it specifies a mime type already 117 | #' present. 118 | #' 119 | #' @format NULL 120 | #' @export 121 | #' 122 | #' @seealso [formatters] for an overview of the build in formatters in `reqres` 123 | #' 124 | #' @examples 125 | #' \dontrun{ 126 | #' res$format(default_formatters, 'text/plain' = format_plain(sep = ' ')) 127 | #' } 128 | #' 129 | default_formatters <- list( 130 | `application/json` = format_json(), 131 | `text/plain` = format_plain(), 132 | `application/xml` = format_xml(), 133 | `text/xml` = format_xml(), 134 | `application/html` = format_html(), 135 | `text/html` = format_html(), 136 | `text/csv` = format_table(sep = ','), 137 | `text/tab-separated-values` = format_table(sep = '\t') 138 | ) 139 | 140 | # Format R objects to xml2 compliant lists 141 | listify <- function(x) { 142 | if (length(x) == 1L && !is_list(x)) { 143 | return(list(as.character(x))) 144 | } 145 | if (!is.list(x)) x <- as.list(x) 146 | if (is.null(attr(x, 'names', exact = TRUE))) names(x) <- vapply(x, function(x) class(x)[1], character(1)) 147 | lapply(x, listify) 148 | } 149 | -------------------------------------------------------------------------------- /R/import-standalone-obj-type.R: -------------------------------------------------------------------------------- 1 | # Standalone file: do not edit by hand 2 | # Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-obj-type.R 3 | # Generated by: usethis::use_standalone("r-lib/rlang", "obj-type") 4 | # ---------------------------------------------------------------------- 5 | # 6 | # --- 7 | # repo: r-lib/rlang 8 | # file: standalone-obj-type.R 9 | # last-updated: 2024-02-14 10 | # license: https://unlicense.org 11 | # imports: rlang (>= 1.1.0) 12 | # --- 13 | # 14 | # ## Changelog 15 | # 16 | # 2024-02-14: 17 | # - `obj_type_friendly()` now works for S7 objects. 18 | # 19 | # 2023-05-01: 20 | # - `obj_type_friendly()` now only displays the first class of S3 objects. 21 | # 22 | # 2023-03-30: 23 | # - `stop_input_type()` now handles `I()` input literally in `arg`. 24 | # 25 | # 2022-10-04: 26 | # - `obj_type_friendly(value = TRUE)` now shows numeric scalars 27 | # literally. 28 | # - `stop_friendly_type()` now takes `show_value`, passed to 29 | # `obj_type_friendly()` as the `value` argument. 30 | # 31 | # 2022-10-03: 32 | # - Added `allow_na` and `allow_null` arguments. 33 | # - `NULL` is now backticked. 34 | # - Better friendly type for infinities and `NaN`. 35 | # 36 | # 2022-09-16: 37 | # - Unprefixed usage of rlang functions with `rlang::` to 38 | # avoid onLoad issues when called from rlang (#1482). 39 | # 40 | # 2022-08-11: 41 | # - Prefixed usage of rlang functions with `rlang::`. 42 | # 43 | # 2022-06-22: 44 | # - `friendly_type_of()` is now `obj_type_friendly()`. 45 | # - Added `obj_type_oo()`. 46 | # 47 | # 2021-12-20: 48 | # - Added support for scalar values and empty vectors. 49 | # - Added `stop_input_type()` 50 | # 51 | # 2021-06-30: 52 | # - Added support for missing arguments. 53 | # 54 | # 2021-04-19: 55 | # - Added support for matrices and arrays (#141). 56 | # - Added documentation. 57 | # - Added changelog. 58 | # 59 | # nocov start 60 | 61 | #' Return English-friendly type 62 | #' @param x Any R object. 63 | #' @param value Whether to describe the value of `x`. Special values 64 | #' like `NA` or `""` are always described. 65 | #' @param length Whether to mention the length of vectors and lists. 66 | #' @return A string describing the type. Starts with an indefinite 67 | #' article, e.g. "an integer vector". 68 | #' @noRd 69 | obj_type_friendly <- function(x, value = TRUE) { 70 | if (is_missing(x)) { 71 | return("absent") 72 | } 73 | 74 | if (is.object(x)) { 75 | if (inherits(x, "quosure")) { 76 | type <- "quosure" 77 | } else { 78 | type <- class(x)[[1L]] 79 | } 80 | return(sprintf("a <%s> object", type)) 81 | } 82 | 83 | if (!is_vector(x)) { 84 | return(.rlang_as_friendly_type(typeof(x))) 85 | } 86 | 87 | n_dim <- length(dim(x)) 88 | 89 | if (!n_dim) { 90 | if (!is_list(x) && length(x) == 1) { 91 | if (is_na(x)) { 92 | return(switch( 93 | typeof(x), 94 | logical = "`NA`", 95 | integer = "an integer `NA`", 96 | double = 97 | if (is.nan(x)) { 98 | "`NaN`" 99 | } else { 100 | "a numeric `NA`" 101 | }, 102 | complex = "a complex `NA`", 103 | character = "a character `NA`", 104 | .rlang_stop_unexpected_typeof(x) 105 | )) 106 | } 107 | 108 | show_infinites <- function(x) { 109 | if (x > 0) { 110 | "`Inf`" 111 | } else { 112 | "`-Inf`" 113 | } 114 | } 115 | str_encode <- function(x, width = 30, ...) { 116 | if (nchar(x) > width) { 117 | x <- substr(x, 1, width - 3) 118 | x <- paste0(x, "...") 119 | } 120 | encodeString(x, ...) 121 | } 122 | 123 | if (value) { 124 | if (is.numeric(x) && is.infinite(x)) { 125 | return(show_infinites(x)) 126 | } 127 | 128 | if (is.numeric(x) || is.complex(x)) { 129 | number <- as.character(round(x, 2)) 130 | what <- if (is.complex(x)) "the complex number" else "the number" 131 | return(paste(what, number)) 132 | } 133 | 134 | return(switch( 135 | typeof(x), 136 | logical = if (x) "`TRUE`" else "`FALSE`", 137 | character = { 138 | what <- if (nzchar(x)) "the string" else "the empty string" 139 | paste(what, str_encode(x, quote = "\"")) 140 | }, 141 | raw = paste("the raw value", as.character(x)), 142 | .rlang_stop_unexpected_typeof(x) 143 | )) 144 | } 145 | 146 | return(switch( 147 | typeof(x), 148 | logical = "a logical value", 149 | integer = "an integer", 150 | double = if (is.infinite(x)) show_infinites(x) else "a number", 151 | complex = "a complex number", 152 | character = if (nzchar(x)) "a string" else "\"\"", 153 | raw = "a raw value", 154 | .rlang_stop_unexpected_typeof(x) 155 | )) 156 | } 157 | 158 | if (length(x) == 0) { 159 | return(switch( 160 | typeof(x), 161 | logical = "an empty logical vector", 162 | integer = "an empty integer vector", 163 | double = "an empty numeric vector", 164 | complex = "an empty complex vector", 165 | character = "an empty character vector", 166 | raw = "an empty raw vector", 167 | list = "an empty list", 168 | .rlang_stop_unexpected_typeof(x) 169 | )) 170 | } 171 | } 172 | 173 | vec_type_friendly(x) 174 | } 175 | 176 | vec_type_friendly <- function(x, length = FALSE) { 177 | if (!is_vector(x)) { 178 | abort("`x` must be a vector.") 179 | } 180 | type <- typeof(x) 181 | n_dim <- length(dim(x)) 182 | 183 | add_length <- function(type) { 184 | if (length && !n_dim) { 185 | paste0(type, sprintf(" of length %s", length(x))) 186 | } else { 187 | type 188 | } 189 | } 190 | 191 | if (type == "list") { 192 | if (n_dim < 2) { 193 | return(add_length("a list")) 194 | } else if (is.data.frame(x)) { 195 | return("a data frame") 196 | } else if (n_dim == 2) { 197 | return("a list matrix") 198 | } else { 199 | return("a list array") 200 | } 201 | } 202 | 203 | type <- switch( 204 | type, 205 | logical = "a logical %s", 206 | integer = "an integer %s", 207 | numeric = , 208 | double = "a double %s", 209 | complex = "a complex %s", 210 | character = "a character %s", 211 | raw = "a raw %s", 212 | type = paste0("a ", type, " %s") 213 | ) 214 | 215 | if (n_dim < 2) { 216 | kind <- "vector" 217 | } else if (n_dim == 2) { 218 | kind <- "matrix" 219 | } else { 220 | kind <- "array" 221 | } 222 | out <- sprintf(type, kind) 223 | 224 | if (n_dim >= 2) { 225 | out 226 | } else { 227 | add_length(out) 228 | } 229 | } 230 | 231 | .rlang_as_friendly_type <- function(type) { 232 | switch( 233 | type, 234 | 235 | list = "a list", 236 | 237 | NULL = "`NULL`", 238 | environment = "an environment", 239 | externalptr = "a pointer", 240 | weakref = "a weak reference", 241 | S4 = "an S4 object", 242 | 243 | name = , 244 | symbol = "a symbol", 245 | language = "a call", 246 | pairlist = "a pairlist node", 247 | expression = "an expression vector", 248 | 249 | char = "an internal string", 250 | promise = "an internal promise", 251 | ... = "an internal dots object", 252 | any = "an internal `any` object", 253 | bytecode = "an internal bytecode object", 254 | 255 | primitive = , 256 | builtin = , 257 | special = "a primitive function", 258 | closure = "a function", 259 | 260 | type 261 | ) 262 | } 263 | 264 | .rlang_stop_unexpected_typeof <- function(x, call = caller_env()) { 265 | abort( 266 | sprintf("Unexpected type <%s>.", typeof(x)), 267 | call = call 268 | ) 269 | } 270 | 271 | #' Return OO type 272 | #' @param x Any R object. 273 | #' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, 274 | #' `"R6"`, or `"S7"`. 275 | #' @noRd 276 | obj_type_oo <- function(x) { 277 | if (!is.object(x)) { 278 | return("bare") 279 | } 280 | 281 | class <- inherits(x, c("R6", "S7_object"), which = TRUE) 282 | 283 | if (class[[1]]) { 284 | "R6" 285 | } else if (class[[2]]) { 286 | "S7" 287 | } else if (isS4(x)) { 288 | "S4" 289 | } else { 290 | "S3" 291 | } 292 | } 293 | 294 | #' @param x The object type which does not conform to `what`. Its 295 | #' `obj_type_friendly()` is taken and mentioned in the error message. 296 | #' @param what The friendly expected type as a string. Can be a 297 | #' character vector of expected types, in which case the error 298 | #' message mentions all of them in an "or" enumeration. 299 | #' @param show_value Passed to `value` argument of `obj_type_friendly()`. 300 | #' @param ... Arguments passed to [abort()]. 301 | #' @inheritParams args_error_context 302 | #' @noRd 303 | stop_input_type <- function(x, 304 | what, 305 | ..., 306 | allow_na = FALSE, 307 | allow_null = FALSE, 308 | show_value = TRUE, 309 | arg = caller_arg(x), 310 | call = caller_env()) { 311 | # From standalone-cli.R 312 | cli <- env_get_list( 313 | nms = c("format_arg", "format_code"), 314 | last = topenv(), 315 | default = function(x) sprintf("`%s`", x), 316 | inherit = TRUE 317 | ) 318 | 319 | if (allow_na) { 320 | what <- c(what, cli$format_code("NA")) 321 | } 322 | if (allow_null) { 323 | what <- c(what, cli$format_code("NULL")) 324 | } 325 | if (length(what)) { 326 | what <- oxford_comma(what) 327 | } 328 | if (inherits(arg, "AsIs")) { 329 | format_arg <- identity 330 | } else { 331 | format_arg <- cli$format_arg 332 | } 333 | 334 | message <- sprintf( 335 | "%s must be %s, not %s.", 336 | format_arg(arg), 337 | what, 338 | obj_type_friendly(x, value = show_value) 339 | ) 340 | 341 | abort(message, ..., call = call, arg = arg) 342 | } 343 | 344 | oxford_comma <- function(chr, sep = ", ", final = "or") { 345 | n <- length(chr) 346 | 347 | if (n < 2) { 348 | return(chr) 349 | } 350 | 351 | head <- chr[seq_len(n - 1)] 352 | last <- chr[n] 353 | 354 | head <- paste(head, collapse = sep) 355 | 356 | # Write a or b. But a, b, or c. 357 | if (n > 2) { 358 | paste0(head, sep, final, " ", last) 359 | } else { 360 | paste0(head, " ", final, " ", last) 361 | } 362 | } 363 | 364 | # nocov end 365 | -------------------------------------------------------------------------------- /R/import-standalone-types-check.R: -------------------------------------------------------------------------------- 1 | # Standalone file: do not edit by hand 2 | # Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-types-check.R 3 | # Generated by: usethis::use_standalone("r-lib/rlang", "types-check") 4 | # ---------------------------------------------------------------------- 5 | # 6 | # --- 7 | # repo: r-lib/rlang 8 | # file: standalone-types-check.R 9 | # last-updated: 2023-03-13 10 | # license: https://unlicense.org 11 | # dependencies: standalone-obj-type.R 12 | # imports: rlang (>= 1.1.0) 13 | # --- 14 | # 15 | # ## Changelog 16 | # 17 | # 2024-08-15: 18 | # - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724) 19 | # 20 | # 2023-03-13: 21 | # - Improved error messages of number checkers (@teunbrand) 22 | # - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). 23 | # - Added `check_data_frame()` (@mgirlich). 24 | # 25 | # 2023-03-07: 26 | # - Added dependency on rlang (>= 1.1.0). 27 | # 28 | # 2023-02-15: 29 | # - Added `check_logical()`. 30 | # 31 | # - `check_bool()`, `check_number_whole()`, and 32 | # `check_number_decimal()` are now implemented in C. 33 | # 34 | # - For efficiency, `check_number_whole()` and 35 | # `check_number_decimal()` now take a `NULL` default for `min` and 36 | # `max`. This makes it possible to bypass unnecessary type-checking 37 | # and comparisons in the default case of no bounds checks. 38 | # 39 | # 2022-10-07: 40 | # - `check_number_whole()` and `_decimal()` no longer treat 41 | # non-numeric types such as factors or dates as numbers. Numeric 42 | # types are detected with `is.numeric()`. 43 | # 44 | # 2022-10-04: 45 | # - Added `check_name()` that forbids the empty string. 46 | # `check_string()` allows the empty string by default. 47 | # 48 | # 2022-09-28: 49 | # - Removed `what` arguments. 50 | # - Added `allow_na` and `allow_null` arguments. 51 | # - Added `allow_decimal` and `allow_infinite` arguments. 52 | # - Improved errors with absent arguments. 53 | # 54 | # 55 | # 2022-09-16: 56 | # - Unprefixed usage of rlang functions with `rlang::` to 57 | # avoid onLoad issues when called from rlang (#1482). 58 | # 59 | # 2022-08-11: 60 | # - Added changelog. 61 | # 62 | # nocov start 63 | 64 | # Scalars ----------------------------------------------------------------- 65 | 66 | .standalone_types_check_dot_call <- .Call 67 | 68 | check_bool <- function(x, 69 | ..., 70 | allow_na = FALSE, 71 | allow_null = FALSE, 72 | arg = caller_arg(x), 73 | call = caller_env()) { 74 | if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) { 75 | return(invisible(NULL)) 76 | } 77 | 78 | stop_input_type( 79 | x, 80 | c("`TRUE`", "`FALSE`"), 81 | ..., 82 | allow_na = allow_na, 83 | allow_null = allow_null, 84 | arg = arg, 85 | call = call 86 | ) 87 | } 88 | 89 | check_string <- function(x, 90 | ..., 91 | allow_empty = TRUE, 92 | allow_na = FALSE, 93 | allow_null = FALSE, 94 | arg = caller_arg(x), 95 | call = caller_env()) { 96 | if (!missing(x)) { 97 | is_string <- .rlang_check_is_string( 98 | x, 99 | allow_empty = allow_empty, 100 | allow_na = allow_na, 101 | allow_null = allow_null 102 | ) 103 | if (is_string) { 104 | return(invisible(NULL)) 105 | } 106 | } 107 | 108 | stop_input_type( 109 | x, 110 | "a single string", 111 | ..., 112 | allow_na = allow_na, 113 | allow_null = allow_null, 114 | arg = arg, 115 | call = call 116 | ) 117 | } 118 | 119 | .rlang_check_is_string <- function(x, 120 | allow_empty, 121 | allow_na, 122 | allow_null) { 123 | if (is_string(x)) { 124 | if (allow_empty || !is_string(x, "")) { 125 | return(TRUE) 126 | } 127 | } 128 | 129 | if (allow_null && is_null(x)) { 130 | return(TRUE) 131 | } 132 | 133 | if (allow_na && (identical(x, NA) || identical(x, na_chr))) { 134 | return(TRUE) 135 | } 136 | 137 | FALSE 138 | } 139 | 140 | check_name <- function(x, 141 | ..., 142 | allow_null = FALSE, 143 | arg = caller_arg(x), 144 | call = caller_env()) { 145 | if (!missing(x)) { 146 | is_string <- .rlang_check_is_string( 147 | x, 148 | allow_empty = FALSE, 149 | allow_na = FALSE, 150 | allow_null = allow_null 151 | ) 152 | if (is_string) { 153 | return(invisible(NULL)) 154 | } 155 | } 156 | 157 | stop_input_type( 158 | x, 159 | "a valid name", 160 | ..., 161 | allow_na = FALSE, 162 | allow_null = allow_null, 163 | arg = arg, 164 | call = call 165 | ) 166 | } 167 | 168 | IS_NUMBER_true <- 0 169 | IS_NUMBER_false <- 1 170 | IS_NUMBER_oob <- 2 171 | 172 | check_number_decimal <- function(x, 173 | ..., 174 | min = NULL, 175 | max = NULL, 176 | allow_infinite = TRUE, 177 | allow_na = FALSE, 178 | allow_null = FALSE, 179 | arg = caller_arg(x), 180 | call = caller_env()) { 181 | if (missing(x)) { 182 | exit_code <- IS_NUMBER_false 183 | } else if (0 == (exit_code <- .standalone_types_check_dot_call( 184 | ffi_standalone_check_number_1.0.7, 185 | x, 186 | allow_decimal = TRUE, 187 | min, 188 | max, 189 | allow_infinite, 190 | allow_na, 191 | allow_null 192 | ))) { 193 | return(invisible(NULL)) 194 | } 195 | 196 | .stop_not_number( 197 | x, 198 | ..., 199 | exit_code = exit_code, 200 | allow_decimal = TRUE, 201 | min = min, 202 | max = max, 203 | allow_na = allow_na, 204 | allow_null = allow_null, 205 | arg = arg, 206 | call = call 207 | ) 208 | } 209 | 210 | check_number_whole <- function(x, 211 | ..., 212 | min = NULL, 213 | max = NULL, 214 | allow_infinite = FALSE, 215 | allow_na = FALSE, 216 | allow_null = FALSE, 217 | arg = caller_arg(x), 218 | call = caller_env()) { 219 | if (missing(x)) { 220 | exit_code <- IS_NUMBER_false 221 | } else if (0 == (exit_code <- .standalone_types_check_dot_call( 222 | ffi_standalone_check_number_1.0.7, 223 | x, 224 | allow_decimal = FALSE, 225 | min, 226 | max, 227 | allow_infinite, 228 | allow_na, 229 | allow_null 230 | ))) { 231 | return(invisible(NULL)) 232 | } 233 | 234 | .stop_not_number( 235 | x, 236 | ..., 237 | exit_code = exit_code, 238 | allow_decimal = FALSE, 239 | min = min, 240 | max = max, 241 | allow_na = allow_na, 242 | allow_null = allow_null, 243 | arg = arg, 244 | call = call 245 | ) 246 | } 247 | 248 | .stop_not_number <- function(x, 249 | ..., 250 | exit_code, 251 | allow_decimal, 252 | min, 253 | max, 254 | allow_na, 255 | allow_null, 256 | arg, 257 | call) { 258 | if (allow_decimal) { 259 | what <- "a number" 260 | } else { 261 | what <- "a whole number" 262 | } 263 | 264 | if (exit_code == IS_NUMBER_oob) { 265 | min <- min %||% -Inf 266 | max <- max %||% Inf 267 | 268 | if (min > -Inf && max < Inf) { 269 | what <- sprintf("%s between %s and %s", what, min, max) 270 | } else if (x < min) { 271 | what <- sprintf("%s larger than or equal to %s", what, min) 272 | } else if (x > max) { 273 | what <- sprintf("%s smaller than or equal to %s", what, max) 274 | } else { 275 | abort("Unexpected state in OOB check", .internal = TRUE) 276 | } 277 | } 278 | 279 | stop_input_type( 280 | x, 281 | what, 282 | ..., 283 | allow_na = allow_na, 284 | allow_null = allow_null, 285 | arg = arg, 286 | call = call 287 | ) 288 | } 289 | 290 | check_symbol <- function(x, 291 | ..., 292 | allow_null = FALSE, 293 | arg = caller_arg(x), 294 | call = caller_env()) { 295 | if (!missing(x)) { 296 | if (is_symbol(x)) { 297 | return(invisible(NULL)) 298 | } 299 | if (allow_null && is_null(x)) { 300 | return(invisible(NULL)) 301 | } 302 | } 303 | 304 | stop_input_type( 305 | x, 306 | "a symbol", 307 | ..., 308 | allow_na = FALSE, 309 | allow_null = allow_null, 310 | arg = arg, 311 | call = call 312 | ) 313 | } 314 | 315 | check_arg <- function(x, 316 | ..., 317 | allow_null = FALSE, 318 | arg = caller_arg(x), 319 | call = caller_env()) { 320 | if (!missing(x)) { 321 | if (is_symbol(x)) { 322 | return(invisible(NULL)) 323 | } 324 | if (allow_null && is_null(x)) { 325 | return(invisible(NULL)) 326 | } 327 | } 328 | 329 | stop_input_type( 330 | x, 331 | "an argument name", 332 | ..., 333 | allow_na = FALSE, 334 | allow_null = allow_null, 335 | arg = arg, 336 | call = call 337 | ) 338 | } 339 | 340 | check_call <- function(x, 341 | ..., 342 | allow_null = FALSE, 343 | arg = caller_arg(x), 344 | call = caller_env()) { 345 | if (!missing(x)) { 346 | if (is_call(x)) { 347 | return(invisible(NULL)) 348 | } 349 | if (allow_null && is_null(x)) { 350 | return(invisible(NULL)) 351 | } 352 | } 353 | 354 | stop_input_type( 355 | x, 356 | "a defused call", 357 | ..., 358 | allow_na = FALSE, 359 | allow_null = allow_null, 360 | arg = arg, 361 | call = call 362 | ) 363 | } 364 | 365 | check_environment <- function(x, 366 | ..., 367 | allow_null = FALSE, 368 | arg = caller_arg(x), 369 | call = caller_env()) { 370 | if (!missing(x)) { 371 | if (is_environment(x)) { 372 | return(invisible(NULL)) 373 | } 374 | if (allow_null && is_null(x)) { 375 | return(invisible(NULL)) 376 | } 377 | } 378 | 379 | stop_input_type( 380 | x, 381 | "an environment", 382 | ..., 383 | allow_na = FALSE, 384 | allow_null = allow_null, 385 | arg = arg, 386 | call = call 387 | ) 388 | } 389 | 390 | check_function <- function(x, 391 | ..., 392 | allow_null = FALSE, 393 | arg = caller_arg(x), 394 | call = caller_env()) { 395 | if (!missing(x)) { 396 | if (is_function(x)) { 397 | return(invisible(NULL)) 398 | } 399 | if (allow_null && is_null(x)) { 400 | return(invisible(NULL)) 401 | } 402 | } 403 | 404 | stop_input_type( 405 | x, 406 | "a function", 407 | ..., 408 | allow_na = FALSE, 409 | allow_null = allow_null, 410 | arg = arg, 411 | call = call 412 | ) 413 | } 414 | 415 | check_closure <- function(x, 416 | ..., 417 | allow_null = FALSE, 418 | arg = caller_arg(x), 419 | call = caller_env()) { 420 | if (!missing(x)) { 421 | if (is_closure(x)) { 422 | return(invisible(NULL)) 423 | } 424 | if (allow_null && is_null(x)) { 425 | return(invisible(NULL)) 426 | } 427 | } 428 | 429 | stop_input_type( 430 | x, 431 | "an R function", 432 | ..., 433 | allow_na = FALSE, 434 | allow_null = allow_null, 435 | arg = arg, 436 | call = call 437 | ) 438 | } 439 | 440 | check_formula <- function(x, 441 | ..., 442 | allow_null = FALSE, 443 | arg = caller_arg(x), 444 | call = caller_env()) { 445 | if (!missing(x)) { 446 | if (is_formula(x)) { 447 | return(invisible(NULL)) 448 | } 449 | if (allow_null && is_null(x)) { 450 | return(invisible(NULL)) 451 | } 452 | } 453 | 454 | stop_input_type( 455 | x, 456 | "a formula", 457 | ..., 458 | allow_na = FALSE, 459 | allow_null = allow_null, 460 | arg = arg, 461 | call = call 462 | ) 463 | } 464 | 465 | 466 | # Vectors ----------------------------------------------------------------- 467 | 468 | # TODO: Figure out what to do with logical `NA` and `allow_na = TRUE` 469 | 470 | check_character <- function(x, 471 | ..., 472 | allow_na = TRUE, 473 | allow_null = FALSE, 474 | arg = caller_arg(x), 475 | call = caller_env()) { 476 | 477 | if (!missing(x)) { 478 | if (is_character(x)) { 479 | if (!allow_na && any(is.na(x))) { 480 | abort( 481 | sprintf("`%s` can't contain NA values.", arg), 482 | arg = arg, 483 | call = call 484 | ) 485 | } 486 | 487 | return(invisible(NULL)) 488 | } 489 | 490 | if (allow_null && is_null(x)) { 491 | return(invisible(NULL)) 492 | } 493 | } 494 | 495 | stop_input_type( 496 | x, 497 | "a character vector", 498 | ..., 499 | allow_null = allow_null, 500 | arg = arg, 501 | call = call 502 | ) 503 | } 504 | 505 | check_logical <- function(x, 506 | ..., 507 | allow_null = FALSE, 508 | arg = caller_arg(x), 509 | call = caller_env()) { 510 | if (!missing(x)) { 511 | if (is_logical(x)) { 512 | return(invisible(NULL)) 513 | } 514 | if (allow_null && is_null(x)) { 515 | return(invisible(NULL)) 516 | } 517 | } 518 | 519 | stop_input_type( 520 | x, 521 | "a logical vector", 522 | ..., 523 | allow_na = FALSE, 524 | allow_null = allow_null, 525 | arg = arg, 526 | call = call 527 | ) 528 | } 529 | 530 | check_data_frame <- function(x, 531 | ..., 532 | allow_null = FALSE, 533 | arg = caller_arg(x), 534 | call = caller_env()) { 535 | if (!missing(x)) { 536 | if (is.data.frame(x)) { 537 | return(invisible(NULL)) 538 | } 539 | if (allow_null && is_null(x)) { 540 | return(invisible(NULL)) 541 | } 542 | } 543 | 544 | stop_input_type( 545 | x, 546 | "a data frame", 547 | ..., 548 | allow_null = allow_null, 549 | arg = arg, 550 | call = call 551 | ) 552 | } 553 | 554 | # nocov end 555 | -------------------------------------------------------------------------------- /R/parsers.R: -------------------------------------------------------------------------------- 1 | #' Pre-supplied parsing generators 2 | #' 3 | #' This set of functions can be used to construct parsing functions adhering to 4 | #' the Request$parse() requirements. 5 | #' 6 | #' @return A function accepting a raw vector and a named list of directives 7 | #' 8 | #' @rdname parsers 9 | #' @name parsers 10 | #' 11 | #' @seealso [formatters] for converting `Response` bodies into compatible types 12 | #' @seealso [default_parsers] for a list that maps the most common mime types 13 | #' to their respective parsers 14 | #' 15 | #' @examples 16 | #' fake_rook <- fiery::fake_request( 17 | #' 'http://example.com/test', 18 | #' content = '[1, 2, 3, 4]', 19 | #' headers = list( 20 | #' Content_Type = 'application/json' 21 | #' ) 22 | #' ) 23 | #' 24 | #' req <- Request$new(fake_rook) 25 | #' req$parse(json = parse_json()) 26 | #' req$body 27 | #' 28 | #' # Cleaning up connections 29 | #' rm(fake_rook, req) 30 | #' gc() 31 | #' 32 | NULL 33 | 34 | #' @rdname parsers 35 | #' 36 | #' @inheritParams jsonlite::fromJSON 37 | #' 38 | #' @importFrom jsonlite fromJSON 39 | #' @export 40 | parse_json <- function(simplifyVector = TRUE, simplifyDataFrame = simplifyVector, 41 | simplifyMatrix = simplifyVector, flatten = FALSE) { 42 | function(raw, directives) { 43 | fromJSON( 44 | rawToChar(raw), 45 | simplifyVector = simplifyVector, 46 | simplifyDataFrame = simplifyDataFrame, 47 | simplifyMatrix = simplifyMatrix, 48 | flatten = flatten 49 | ) 50 | } 51 | } 52 | #' @rdname parsers 53 | #' 54 | #' @param sep The line separator. Plain text will be split into multiple strings 55 | #' based on this. 56 | #' 57 | #' @export 58 | parse_plain <- function(sep = '\n') { 59 | function(raw, directives = list()) { 60 | strsplit(rawToChar(raw), split = sep)[[1]] 61 | } 62 | } 63 | #' @rdname parsers 64 | #' 65 | #' @inheritParams xml2::read_xml 66 | #' 67 | #' @importFrom xml2 read_xml 68 | #' @export 69 | parse_xml <- function(encoding = '', options = 'NOBLANKS', base_url = '') { 70 | function(raw, directives = list()) { 71 | xml2::as_list(read_xml(raw, encoding = encoding, options = options, base_url = base_url)) 72 | } 73 | } 74 | #' @rdname parsers 75 | #' 76 | #' @importFrom xml2 read_xml 77 | #' @export 78 | parse_html <- function(encoding = '', options = c('RECOVER', 'NOERROR', 'NOBLANKS'), base_url = '') { 79 | function(raw, directives = list()) { 80 | xml2::as_list(read_xml(raw, as_html = TRUE, encoding = encoding, options = options, base_url = base_url)) 81 | } 82 | } 83 | #' @rdname parsers 84 | #' 85 | #' @importFrom webutils parse_multipart 86 | #' @export 87 | parse_multiform <- function() { 88 | function(raw, directives) { 89 | parse_multipart(raw, directives$boundary) 90 | } 91 | } 92 | #' @rdname parsers 93 | #' 94 | #' @param delim The delimiter to use for parsing arrays in non-exploded form. 95 | #' Either `NULL` (no delimiter) or one of `","`, `"|"`, or `" "` 96 | #' 97 | #' @export 98 | parse_queryform <- function(delim = NULL) { 99 | force(delim) 100 | function(raw, directives) { 101 | query_parser(rawToChar(raw), delim) 102 | } 103 | } 104 | #' @rdname parsers 105 | #' 106 | #' @param ... parameters passed on to [read.table()] 107 | #' 108 | #' @importFrom utils read.table 109 | #' @export 110 | parse_table <- function(...) { 111 | function(raw, directives) { 112 | read.table(file = , text = rawToChar(raw), ...) 113 | } 114 | } 115 | #' A list of default parser mappings 116 | #' 117 | #' This list matches the most normal mime types with their respective parsers 118 | #' using default arguments. For a no-frills request parsing this can be supplied 119 | #' directly to `Request$parse()`. To add or modify to this list simply supply 120 | #' the additional parsers as second, third, etc, argument and they will 121 | #' overwrite or add depending on whether it specifies a mime type already 122 | #' present. 123 | #' 124 | #' @format NULL 125 | #' @export 126 | #' 127 | #' @seealso [parsers] for an overview of the build in parsers in `reqres` 128 | #' 129 | #' @examples 130 | #' \dontrun{ 131 | #' req$parse(default_parsers, 'application/json' = parse_json(flatten = TRUE)) 132 | #' } 133 | #' 134 | default_parsers <- list( 135 | `application/json` = parse_json(), 136 | `text/plain` = parse_plain(), 137 | `application/xml` = parse_xml(), 138 | `text/xml` = parse_xml(), 139 | `application/html` = parse_html(), 140 | `text/html` = parse_html(), 141 | `multipart/form-data` = parse_multiform(), 142 | `application/x-www-form-urlencoded` = parse_queryform(), 143 | `text/csv` = parse_table(sep = ',', header = TRUE, stringsAsFactors = FALSE), 144 | `text/tab-separated-values` = parse_table(sep = '\t', header = TRUE, stringsAsFactors = FALSE) 145 | ) 146 | -------------------------------------------------------------------------------- /R/problems.R: -------------------------------------------------------------------------------- 1 | problem_abort <- function(code) { 2 | force(code) 3 | function(detail, instance = NULL, ..., message = detail, call = caller_env()) { 4 | check_string(detail) 5 | if (!inherits(detail, "AsIs")) detail <- cli::format_inline(detail, .envir = call) 6 | if (!inherits(message, "AsIs")) message <- vapply(message, cli::format_inline, character(1), .envir = call, USE.NAMES = FALSE) 7 | err <- rlang::error_cnd( 8 | class = "reqres_problem", 9 | status = code, 10 | detail = detail, 11 | instance = instance, 12 | message = message, 13 | call = call, 14 | ..., 15 | use_cli_format = TRUE 16 | ) 17 | cnd_signal(err) 18 | } 19 | } 20 | 21 | #' Abort request processing with an HTTP problem response 22 | #' 23 | #' This set of functions throws a classed error indicating that the request 24 | #' should be responded to with an HTTP problem according to the spec defined in 25 | #' [RFC 9457](https://datatracker.ietf.org/doc/html/rfc9457) or a bare response 26 | #' code. These conditions should be caught and handled by the `handle_problem()` 27 | #' function. 28 | #' 29 | #' @param code The HTTP status code to use 30 | #' @param detail A string detailing the problem. Make sure the information 31 | #' given does not pose a security risk 32 | #' @param title A human-readable title of the issue. Should not vary from 33 | #' instance to instance of the specific issue. If `NULL` then the status 34 | #' code title is used 35 | #' @param type A URI that uniquely identifies this type of problem. The URI 36 | #' must resolve to an HTTP document describing the problem in human readable 37 | #' text. If `NULL`, the most recent link to the given status code definition 38 | #' is used 39 | #' @param instance A unique identifier of the specific instance of this 40 | #' problem that can be used for further debugging. Can be omitted. 41 | #' @inheritParams rlang::error_cnd 42 | #' @inheritDotParams rlang::error_cnd 43 | #' 44 | #' @export 45 | #' 46 | abort_http_problem <- function(code, detail, title = NULL, type = NULL, instance = NULL, ..., message = detail, call = caller_env()) { 47 | check_string(detail) 48 | if (!inherits(detail, "AsIs")) detail <- cli::format_inline(detail, .envir = call) 49 | if (!inherits(message, "AsIs")) message <- vapply(message, cli::format_inline, character(1), .envir = call, USE.NAMES = FALSE) 50 | err <- rlang::error_cnd( 51 | class = "reqres_problem", 52 | status = code, 53 | detail = detail, 54 | instance = instance, 55 | title = title, 56 | type = type, 57 | message = message, 58 | call = call, 59 | ..., 60 | use_cli_format = TRUE 61 | ) 62 | cnd_signal(err) 63 | } 64 | #' @rdname abort_http_problem 65 | #' @export 66 | #' 67 | abort_status <- function(code, message = status_phrase(code), ..., call = caller_env()) { 68 | err <- rlang::error_cnd( 69 | class = "reqres_problem", 70 | status = code, 71 | call = call, 72 | message = vapply(message, cli::format_inline, character(1), .envir = call, USE.NAMES = FALSE), 73 | ..., 74 | use_cli_format = TRUE 75 | ) 76 | cnd_signal(err) 77 | } 78 | #' @rdname abort_http_problem 79 | #' @export 80 | #' 81 | abort_bad_request <- problem_abort(400L) 82 | #' @rdname abort_http_problem 83 | #' @export 84 | #' 85 | abort_unauthorized <- problem_abort(401L) 86 | #' @rdname abort_http_problem 87 | #' @export 88 | #' 89 | abort_forbidden <- problem_abort(403L) 90 | #' @rdname abort_http_problem 91 | #' @export 92 | #' 93 | abort_not_found <- problem_abort(404L) 94 | #' @rdname abort_http_problem 95 | #' @export 96 | #' 97 | abort_method_not_allowed <- problem_abort(405L) 98 | #' @rdname abort_http_problem 99 | #' @export 100 | #' 101 | abort_not_acceptable <- problem_abort(406L) 102 | #' @rdname abort_http_problem 103 | #' @export 104 | #' 105 | abort_conflict <- problem_abort(409L) 106 | #' @rdname abort_http_problem 107 | #' @export 108 | #' 109 | abort_gone <- problem_abort(410L) 110 | #' @rdname abort_http_problem 111 | #' @export 112 | #' 113 | abort_internal_error <- problem_abort(500L) 114 | 115 | #' @rdname abort_http_problem 116 | #' 117 | #' @param response The Response object associated with the request that created 118 | #' the condition 119 | #' @param cnd The thrown condition 120 | #' 121 | #' @export 122 | #' 123 | handle_problem <- function(response, cnd) { 124 | if (is.null(cnd$detail)) { 125 | response$status_with_text(cnd$status) 126 | } else { 127 | response$problem( 128 | code = cnd$status, 129 | detail = cli::ansi_strip(cnd$detail), 130 | title = cnd$title, 131 | type = cnd$type, 132 | instance = cnd$instance 133 | ) 134 | } 135 | } 136 | 137 | #' @rdname abort_http_problem 138 | #' @export 139 | #' 140 | is_reqres_problem <- function(cnd) inherits(cnd, "reqres_problem") 141 | -------------------------------------------------------------------------------- /R/reqres-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | #' @import rlang 6 | #' @importFrom lifecycle deprecated 7 | #' @useDynLib reqres, .registration = TRUE 8 | ## usethis namespace: end 9 | NULL 10 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/R/sysdata.rda -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onLoad <- function(...) { 2 | run_on_load() 3 | } 4 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "README-" 12 | ) 13 | ``` 14 | 15 | # reqres 16 | 17 | 18 | [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 19 | [![R-CMD-check](https://github.com/thomasp85/reqres/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/reqres/actions/workflows/R-CMD-check.yaml) 20 | [![CRAN status](https://www.r-pkg.org/badges/version/reqres)](https://CRAN.R-project.org/package=reqres) 21 | [![Codecov test coverage](https://codecov.io/gh/thomasp85/reqres/graph/badge.svg)](https://app.codecov.io/gh/thomasp85/reqres) 22 | 23 | 24 | While the http protocol is rather basic in essence, it can be a pain to work 25 | with. `reqres` is here to soothe the pain somewhat by providing two powerful 26 | classes for handling all parts of request and response handling during a http 27 | exchange. *This is not a web server*, instead it focuses on making life easier 28 | for developers of web servers by extracting the complexity of cookies, headers, 29 | content negotiation, and the likes into neat little classes. `reqres` builds 30 | upon the [`rook`](https://github.com/jeffreyhorner/Rook/blob/a5e45f751/README.md) 31 | specifications and is thus well suited for 32 | [`httpuv`-based](https://github.com/rstudio/httpuv) webservers. 33 | 34 | ## Features 35 | `reqres` draws a lot of inspiration from [express.js](https://expressjs.com) and 36 | the `Request` and `Response` classes is aiming for feature parity with those 37 | from express. The `Request` class provides automatic parsing of the query string 38 | along with parsing of the body based on the `Content-Type` header (with 39 | decompression if `Content-Encoding` is provided). Further, it provides content 40 | negotiation based on the `Accept(-*)` headers. The `Response` class allows you 41 | to set headers and cookies easily, assign arbitrary data for later use, and 42 | automatically format the body based on content negotiation with the `Request` 43 | object that it is responding to (again, it will compress automatically if the 44 | `Accept-Encoding` header allows it). If any part of the content negotiation 45 | fails the correct response status code will be set, making the response ready to 46 | send. 47 | 48 | `reqres` comes with a range of parsers and formatters making it work out of the 49 | box with json, xml, html, csv, tab, multipart, and www-form-urlencoded payloads. 50 | It is easy to either modify these or provide your own parsers and formatters if 51 | needed - `reqres` will take care of the content negotiation and simply call your 52 | custom parser/formatter if chosen. 53 | 54 | ## Installation 55 | reqrescan be installed from CRAN with `install.packages('reqres')` or the 56 | development version can be installed from github: 57 | 58 | ```{r, eval=FALSE} 59 | # install.packages('devtools') 60 | devtools::install_github('thomasp85/reqres') 61 | ``` 62 | 63 | ## Demo 64 | Below is a quick demo of some of the features in `reqres`. It uses the 65 | `fake_request()` in `fiery` to mock a rook request so it can be used without 66 | setting up a webserver: 67 | 68 | ```{r} 69 | library(reqres) 70 | 71 | # We start by mocking our request 72 | rook <- fiery::fake_request( 73 | url = 'http://www.example.com/summary?id=2347&user=Thomas+Lin+Pedersen', 74 | content = '{"name":["Thomas Lin Pedersen"],"age":[31],"homepage":["www.data-imaginist.com","www.github.com/thomasp85"]}', 75 | headers = list( 76 | Content_Type = 'application/json', 77 | Accept = 'application/json, application/xml; q=0.5, text/*; q=0.3', 78 | Accept_Encoding = 'gzip, br' 79 | ) 80 | ) 81 | 82 | # A Request object can now be created 83 | req <- Request$new(rook) 84 | req 85 | 86 | # ... along with a response 87 | res <- req$respond() 88 | res 89 | ``` 90 | 91 | ### Request 92 | A lot of information is already available, such as the query and other parts of 93 | the url, but the body is not filled in automatically. 94 | 95 | ```{r} 96 | req$host 97 | req$query 98 | req$body 99 | ``` 100 | 101 | The body can easily be parsed though, as long as a parser exists for the 102 | provided content type. 103 | 104 | ```{r} 105 | req$is('json') 106 | req$parse(json = parse_json()) 107 | req$body 108 | ``` 109 | 110 | Instead of inspecting it manually you can simply provide a range of parsers and 111 | let the object choose the correct one itself 112 | 113 | ```{r} 114 | req$set_body(NULL) 115 | req$parse( 116 | txt = parse_plain(), 117 | html = parse_html(), 118 | json = parse_json() 119 | ) 120 | req$body 121 | ``` 122 | 123 | In the case that none of the provided parsers fits the content type, the 124 | response will automatically throw an exception that can be converted into the 125 | right response 126 | 127 | ```{r, error=TRUE} 128 | req$set_body(NULL) 129 | req$parse(txt = parse_plain()) 130 | res 131 | ``` 132 | 133 | To facilitate all this `reqres` comes with a mapping of standard mime types to 134 | the provided parsers. This can simply be supplied to the parse method 135 | 136 | ```{r} 137 | req$set_body(NULL) 138 | req$parse(default_parsers) 139 | req$body 140 | ``` 141 | 142 | ### Response 143 | While the request is mainly intended to be read from, the response should be 144 | written to. The `Response` class contains a slew of methods to easily set 145 | headers, cookies, etc. 146 | 147 | ```{r} 148 | res$set_header('Date', to_http_date(Sys.time())) 149 | res$get_header('Date') 150 | res$set_cookie('user', req$query$id, max_age = 9000L) 151 | res$has_cookie('user') 152 | ``` 153 | 154 | Furthermore, it contains its own data store where arbitrary information can be 155 | stored so as to pass it between middleware etc. This data will never be part of 156 | the actual response. 157 | 158 | ```{r} 159 | res$set_data('alphabet', letters) 160 | res$get_data('alphabet') 161 | ``` 162 | 163 | Files can be attached and marked for download, setting the relevant headers 164 | automatically 165 | 166 | ```{r} 167 | res$attach(system.file('NEWS.md', package = 'reqres')) 168 | res$get_header('Content-Type') 169 | res$get_header('Content-Disposition') 170 | ``` 171 | 172 | Often we need to provide a payload in the form of a body. This can be any type 173 | of R object until the response is handed off to the server, where it should be 174 | either a string or a raw vector. 175 | 176 | ```{r} 177 | res$remove_header('Content-Disposition') 178 | res$body <- head(mtcars) 179 | res$body 180 | ``` 181 | 182 | Based on the `Accept` header in the request it can be formatted correctly thus 183 | making it ready to send back to the client. As this request contains an 184 | `Accept-Encoding` header it will be compressed as well. 185 | 186 | ```{r} 187 | res$format(json = format_json()) 188 | res$body 189 | res$get_header('Content-Type') 190 | res$get_header('Content-Encoding') 191 | ``` 192 | 193 | The content negotiation understands wildcards as well 194 | 195 | ```{r} 196 | res$body <- head(mtcars) 197 | req$get_header('Accept') 198 | res$format(csv = format_table(sep = ','), compress = FALSE) 199 | res$body 200 | res$get_header('Content-Type') 201 | ``` 202 | 203 | A default formatter mapping exists in parallel to `default_parsers` for the 204 | `Request$format()` method. 205 | 206 | ```{r} 207 | res$body <- head(mtcars) 208 | res$format(default_formatters, compress = FALSE) 209 | res$body 210 | ``` 211 | 212 | It is easy to define your own formatters and add them along the defaults 213 | 214 | ```{r} 215 | res$body <- head(mtcars) 216 | res$format('text/yaml' = yaml::as.yaml, compress = FALSE) 217 | res$body 218 | ``` 219 | 220 | ## Code of Conduct 221 | Please note that the 'reqres' project is released with a 222 | [Contributor Code of Conduct](https://reqres.data-imaginist.com/CODE_OF_CONDUCT.html). 223 | By contributing to this project, you agree to abide by its terms. 224 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # reqres 5 | 6 | 7 | 8 | [![Lifecycle: 9 | stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 10 | [![R-CMD-check](https://github.com/thomasp85/reqres/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/reqres/actions/workflows/R-CMD-check.yaml) 11 | [![CRAN 12 | status](https://www.r-pkg.org/badges/version/reqres)](https://CRAN.R-project.org/package=reqres) 13 | [![Codecov test 14 | coverage](https://codecov.io/gh/thomasp85/reqres/graph/badge.svg)](https://app.codecov.io/gh/thomasp85/reqres) 15 | 16 | 17 | While the http protocol is rather basic in essence, it can be a pain to 18 | work with. `reqres` is here to soothe the pain somewhat by providing two 19 | powerful classes for handling all parts of request and response handling 20 | during a http exchange. *This is not a web server*, instead it focuses 21 | on making life easier for developers of web servers by extracting the 22 | complexity of cookies, headers, content negotiation, and the likes into 23 | neat little classes. `reqres` builds upon the 24 | [`rook`](https://github.com/jeffreyhorner/Rook/blob/a5e45f751/README.md) 25 | specifications and is thus well suited for 26 | [`httpuv`-based](https://github.com/rstudio/httpuv) webservers. 27 | 28 | ## Features 29 | 30 | `reqres` draws a lot of inspiration from 31 | [express.js](https://expressjs.com) and the `Request` and `Response` 32 | classes is aiming for feature parity with those from express. The 33 | `Request` class provides automatic parsing of the query string along 34 | with parsing of the body based on the `Content-Type` header (with 35 | decompression if `Content-Encoding` is provided). Further, it provides 36 | content negotiation based on the `Accept(-*)` headers. The `Response` 37 | class allows you to set headers and cookies easily, assign arbitrary 38 | data for later use, and automatically format the body based on content 39 | negotiation with the `Request` object that it is responding to (again, 40 | it will compress automatically if the `Accept-Encoding` header allows 41 | it). If any part of the content negotiation fails the correct response 42 | status code will be set, making the response ready to send. 43 | 44 | `reqres` comes with a range of parsers and formatters making it work out 45 | of the box with json, xml, html, csv, tab, multipart, and 46 | www-form-urlencoded payloads. It is easy to either modify these or 47 | provide your own parsers and formatters if needed - `reqres` will take 48 | care of the content negotiation and simply call your custom 49 | parser/formatter if chosen. 50 | 51 | ## Installation 52 | 53 | reqrescan be installed from CRAN with `install.packages('reqres')` or 54 | the development version can be installed from github: 55 | 56 | ``` r 57 | # install.packages('devtools') 58 | devtools::install_github('thomasp85/reqres') 59 | ``` 60 | 61 | ## Demo 62 | 63 | Below is a quick demo of some of the features in `reqres`. It uses the 64 | `fake_request()` in `fiery` to mock a rook request so it can be used 65 | without setting up a webserver: 66 | 67 | ``` r 68 | library(reqres) 69 | 70 | # We start by mocking our request 71 | rook <- fiery::fake_request( 72 | url = 'http://www.example.com/summary?id=2347&user=Thomas+Lin+Pedersen', 73 | content = '{"name":["Thomas Lin Pedersen"],"age":[31],"homepage":["www.data-imaginist.com","www.github.com/thomasp85"]}', 74 | headers = list( 75 | Content_Type = 'application/json', 76 | Accept = 'application/json, application/xml; q=0.5, text/*; q=0.3', 77 | Accept_Encoding = 'gzip, br' 78 | ) 79 | ) 80 | 81 | # A Request object can now be created 82 | req <- Request$new(rook) 83 | req 84 | #> ── An HTTP request ───────────────────────────────────────────────────────────── 85 | #> Trusted: No 86 | #> Method: get 87 | #> URL: http://www.example.com:80/summary?id=2347&user=Thomas+Lin+Pedersen 88 | 89 | # ... along with a response 90 | res <- req$respond() 91 | res 92 | #> ── An HTTP response ──────────────────────────────────────────────────────────── 93 | #> Status: 404 - Not Found 94 | #> Content type: text/plain 95 | #> → Responding to: 96 | #> http://www.example.com:80/summary?id=2347&user=Thomas+Lin+Pedersen 97 | ``` 98 | 99 | ### Request 100 | 101 | A lot of information is already available, such as the query and other 102 | parts of the url, but the body is not filled in automatically. 103 | 104 | ``` r 105 | req$host 106 | #> [1] "www.example.com:80" 107 | req$query 108 | #> $id 109 | #> [1] "2347" 110 | #> 111 | #> $user 112 | #> [1] "Thomas Lin Pedersen" 113 | req$body 114 | #> NULL 115 | ``` 116 | 117 | The body can easily be parsed though, as long as a parser exists for the 118 | provided content type. 119 | 120 | ``` r 121 | req$is('json') 122 | #> [1] TRUE 123 | #> attr(,"pick") 124 | #> [1] 1 125 | req$parse(json = parse_json()) 126 | #> [1] TRUE 127 | req$body 128 | #> $name 129 | #> [1] "Thomas Lin Pedersen" 130 | #> 131 | #> $age 132 | #> [1] 31 133 | #> 134 | #> $homepage 135 | #> [1] "www.data-imaginist.com" "www.github.com/thomasp85" 136 | ``` 137 | 138 | Instead of inspecting it manually you can simply provide a range of 139 | parsers and let the object choose the correct one itself 140 | 141 | ``` r 142 | req$set_body(NULL) 143 | req$parse( 144 | txt = parse_plain(), 145 | html = parse_html(), 146 | json = parse_json() 147 | ) 148 | #> [1] TRUE 149 | req$body 150 | #> $name 151 | #> [1] "Thomas Lin Pedersen" 152 | #> 153 | #> $age 154 | #> [1] 31 155 | #> 156 | #> $homepage 157 | #> [1] "www.data-imaginist.com" "www.github.com/thomasp85" 158 | ``` 159 | 160 | In the case that none of the provided parsers fits the content type, the 161 | response will automatically throw an exception that can be converted 162 | into the right response 163 | 164 | ``` r 165 | req$set_body(NULL) 166 | req$parse(txt = parse_plain()) 167 | #> Error in `req$parse()`: 168 | #> ! Unsupported Media Type 169 | res 170 | #> ── An HTTP response ──────────────────────────────────────────────────────────── 171 | #> Status: 404 - Not Found 172 | #> Content type: text/plain 173 | #> → Responding to: 174 | #> http://www.example.com:80/summary?id=2347&user=Thomas+Lin+Pedersen 175 | ``` 176 | 177 | To facilitate all this `reqres` comes with a mapping of standard mime 178 | types to the provided parsers. This can simply be supplied to the parse 179 | method 180 | 181 | ``` r 182 | req$set_body(NULL) 183 | req$parse(default_parsers) 184 | #> Warning: Request$parse(list(...)) was deprecated in reqres 0.3. 185 | #> ℹ Please use Request$parse(!!!list(...)) instead. 186 | #> This warning is displayed once every 8 hours. 187 | #> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was 188 | #> generated. 189 | #> [1] TRUE 190 | req$body 191 | #> $name 192 | #> [1] "Thomas Lin Pedersen" 193 | #> 194 | #> $age 195 | #> [1] 31 196 | #> 197 | #> $homepage 198 | #> [1] "www.data-imaginist.com" "www.github.com/thomasp85" 199 | ``` 200 | 201 | ### Response 202 | 203 | While the request is mainly intended to be read from, the response 204 | should be written to. The `Response` class contains a slew of methods to 205 | easily set headers, cookies, etc. 206 | 207 | ``` r 208 | res$set_header('Date', to_http_date(Sys.time())) 209 | res$get_header('Date') 210 | #> [1] "Tue, 19 Aug 2025 07:39:38 GMT" 211 | res$set_cookie('user', req$query$id, max_age = 9000L) 212 | res$has_cookie('user') 213 | #> [1] TRUE 214 | ``` 215 | 216 | Furthermore, it contains its own data store where arbitrary information 217 | can be stored so as to pass it between middleware etc. This data will 218 | never be part of the actual response. 219 | 220 | ``` r 221 | res$set_data('alphabet', letters) 222 | res$get_data('alphabet') 223 | #> [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" 224 | #> [20] "t" "u" "v" "w" "x" "y" "z" 225 | ``` 226 | 227 | Files can be attached and marked for download, setting the relevant 228 | headers automatically 229 | 230 | ``` r 231 | res$attach(system.file('NEWS.md', package = 'reqres')) 232 | res$get_header('Content-Type') 233 | #> [1] "text/markdown" 234 | res$get_header('Content-Disposition') 235 | #> [1] "attachment; filename=\"NEWS.md\"" 236 | ``` 237 | 238 | Often we need to provide a payload in the form of a body. This can be 239 | any type of R object until the response is handed off to the server, 240 | where it should be either a string or a raw vector. 241 | 242 | ``` r 243 | res$remove_header('Content-Disposition') 244 | res$body <- head(mtcars) 245 | res$body 246 | #> mpg cyl disp hp drat wt qsec vs am gear carb 247 | #> Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 248 | #> Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 249 | #> Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 250 | #> Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 251 | #> Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 252 | #> Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 253 | ``` 254 | 255 | Based on the `Accept` header in the request it can be formatted 256 | correctly thus making it ready to send back to the client. As this 257 | request contains an `Accept-Encoding` header it will be compressed as 258 | well. 259 | 260 | ``` r 261 | res$format(json = format_json()) 262 | #> [1] TRUE 263 | res$body 264 | #> [1] 1f 8b 08 00 00 00 00 00 00 03 9d d2 41 4f 83 30 14 07 f0 af 42 de b9 69 da 265 | #> [26] 47 29 a5 e7 1d bc 78 d1 44 4d 8c 31 dd 20 48 b2 01 16 36 a2 c6 ef 6e d9 a0 266 | #> [51] 6c 63 4b d4 db 4b d3 f6 fd de bf 7d fe 82 4d 9d 83 46 4e 60 f5 b1 06 2d 09 267 | #> [76] a4 45 53 83 e6 92 11 78 eb 0b ee 8a d4 9a 16 74 48 13 02 9d 2b 90 4a 24 f0 268 | #> [101] de 64 ab 7e 23 15 ee d4 ae 01 ed 36 9a 8d 5b 21 90 67 c6 82 16 ee 52 63 97 269 | #> [126] fb e2 d5 56 1d 68 b8 35 9f a9 09 ee 9e 04 7c 93 ff f6 56 71 e4 9b c7 94 e1 270 | #> [151] df 9b 07 8f 26 3f 02 b8 2b 07 82 f0 04 a6 0e 84 24 9c 04 2a 1a 09 e1 34 be 271 | #> [176] a2 92 1f 04 fc 9a 80 7b c1 c2 b4 cd b6 0c 62 ce 8e e7 a7 e2 3c 01 8c d4 85 272 | #> [201] 04 7a 53 b7 af 90 4f 11 24 54 88 13 00 1b 01 e1 1c 70 53 d9 32 6b 03 11 2c 273 | #> [226] 6c b1 cb 26 84 1b 23 1e 10 6a 44 84 fe 19 fa c0 47 04 8f 46 44 df f6 da 33 274 | #> [251] cc 0d 78 6e b8 af 2b db 9a 65 b5 6d 4f 18 b3 df 80 18 0d 0c e6 19 48 63 e9 275 | #> [276] 19 72 64 20 a3 88 bf 8e e2 c1 ac 0b 53 ba e6 2f 3f 40 6a d7 44 06 03 00 00 276 | res$get_header('Content-Type') 277 | #> [1] "application/json" 278 | res$get_header('Content-Encoding') 279 | #> [1] "gzip" 280 | ``` 281 | 282 | The content negotiation understands wildcards as well 283 | 284 | ``` r 285 | res$body <- head(mtcars) 286 | req$get_header('Accept') 287 | #> [1] "application/json" "application/xml; q=0.5" "text/*; q=0.3" 288 | res$format(csv = format_table(sep = ','), compress = FALSE) 289 | #> [1] TRUE 290 | res$body 291 | #> [1] "\"mpg\",\"cyl\",\"disp\",\"hp\",\"drat\",\"wt\",\"qsec\",\"vs\",\"am\",\"gear\",\"carb\"\n\"Mazda RX4\",21,6,160,110,3.9,2.62,16.46,0,1,4,4\n\"Mazda RX4 Wag\",21,6,160,110,3.9,2.875,17.02,0,1,4,4\n\"Datsun 710\",22.8,4,108,93,3.85,2.32,18.61,1,1,4,1\n\"Hornet 4 Drive\",21.4,6,258,110,3.08,3.215,19.44,1,0,3,1\n\"Hornet Sportabout\",18.7,8,360,175,3.15,3.44,17.02,0,0,3,2\n\"Valiant\",18.1,6,225,105,2.76,3.46,20.22,1,0,3,1" 292 | res$get_header('Content-Type') 293 | #> [1] "text/csv" 294 | ``` 295 | 296 | A default formatter mapping exists in parallel to `default_parsers` for 297 | the `Request$format()` method. 298 | 299 | ``` r 300 | res$body <- head(mtcars) 301 | res$format(default_formatters, compress = FALSE) 302 | #> Warning: Response$format(list(...)) was deprecated in reqres 0.3. 303 | #> ℹ Please use Response$format(!!!list(...)) instead. 304 | #> This warning is displayed once every 8 hours. 305 | #> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was 306 | #> generated. 307 | #> [1] TRUE 308 | res$body 309 | #> [{"mpg":21,"cyl":6,"disp":160,"hp":110,"drat":3.9,"wt":2.62,"qsec":16.46,"vs":0,"am":1,"gear":4,"carb":4,"_row":"Mazda RX4"},{"mpg":21,"cyl":6,"disp":160,"hp":110,"drat":3.9,"wt":2.875,"qsec":17.02,"vs":0,"am":1,"gear":4,"carb":4,"_row":"Mazda RX4 Wag"},{"mpg":22.8,"cyl":4,"disp":108,"hp":93,"drat":3.85,"wt":2.32,"qsec":18.61,"vs":1,"am":1,"gear":4,"carb":1,"_row":"Datsun 710"},{"mpg":21.4,"cyl":6,"disp":258,"hp":110,"drat":3.08,"wt":3.215,"qsec":19.44,"vs":1,"am":0,"gear":3,"carb":1,"_row":"Hornet 4 Drive"},{"mpg":18.7,"cyl":8,"disp":360,"hp":175,"drat":3.15,"wt":3.44,"qsec":17.02,"vs":0,"am":0,"gear":3,"carb":2,"_row":"Hornet Sportabout"},{"mpg":18.1,"cyl":6,"disp":225,"hp":105,"drat":2.76,"wt":3.46,"qsec":20.22,"vs":1,"am":0,"gear":3,"carb":1,"_row":"Valiant"}] 310 | ``` 311 | 312 | It is easy to define your own formatters and add them along the defaults 313 | 314 | ``` r 315 | res$body <- head(mtcars) 316 | res$format('text/yaml' = yaml::as.yaml, compress = FALSE) 317 | #> [1] TRUE 318 | res$body 319 | #> [1] "mpg:\n- 21.0\n- 21.0\n- 22.8\n- 21.4\n- 18.7\n- 18.1\ncyl:\n- 6.0\n- 6.0\n- 4.0\n- 6.0\n- 8.0\n- 6.0\ndisp:\n- 160.0\n- 160.0\n- 108.0\n- 258.0\n- 360.0\n- 225.0\nhp:\n- 110.0\n- 110.0\n- 93.0\n- 110.0\n- 175.0\n- 105.0\ndrat:\n- 3.9\n- 3.9\n- 3.85\n- 3.08\n- 3.15\n- 2.76\nwt:\n- 2.62\n- 2.875\n- 2.32\n- 3.215\n- 3.44\n- 3.46\nqsec:\n- 16.46\n- 17.02\n- 18.61\n- 19.44\n- 17.02\n- 20.22\nvs:\n- 0.0\n- 0.0\n- 1.0\n- 1.0\n- 0.0\n- 1.0\nam:\n- 1.0\n- 1.0\n- 1.0\n- 0.0\n- 0.0\n- 0.0\ngear:\n- 4.0\n- 4.0\n- 4.0\n- 3.0\n- 3.0\n- 3.0\ncarb:\n- 4.0\n- 4.0\n- 1.0\n- 1.0\n- 2.0\n- 1.0\n" 320 | ``` 321 | 322 | ## Code of Conduct 323 | 324 | Please note that the ‘reqres’ project is released with a [Contributor 325 | Code of 326 | Conduct](https://reqres.data-imaginist.com/CODE_OF_CONDUCT.html). By 327 | contributing to this project, you agree to abide by its terms. 328 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | url: https://reqres.data-imaginist.com 3 | 4 | authors: 5 | Thomas Lin Pedersen: 6 | href: https://data-imaginist.com 7 | 8 | template: 9 | bootstrap: 5 10 | bootswatch: simplex 11 | 12 | navbar: 13 | left: 14 | - icon: fa-home fa-lg 15 | href: index.html 16 | - text: Reference 17 | href: reference/index.html 18 | - text: News 19 | menu: 20 | - text: "Release notes" 21 | - text: "Version 0.2.0" 22 | href: https://www.data-imaginist.com/2017/introducing-reqres/ 23 | - text: "------------------" 24 | - text: "Change log" 25 | href: news/index.html 26 | right: 27 | - text: fiery 28 | href: https://fiery.data-imaginist.com 29 | - text: routr 30 | href: https://routr.data-imaginist.com 31 | - icon: fa-github fa-lg 32 | href: https://github.com/thomasp85/reqres 33 | 34 | reference: 35 | - title: "Request and response classes" 36 | desc: > 37 | The main raison d'être for reqres is to provide classes handling http 38 | requests and responses. As both are coded as R6 classes with reference 39 | semantics all functionality of the object are documented together with the 40 | class. 41 | contents: 42 | - Request 43 | - Response 44 | - title: "Content parsing and formatting" 45 | desc: > 46 | A main part of working with http requests and responses is related to 47 | getting the content of a request and setting the content of a response. 48 | While the Request and Response classes handle content negotiation it is 49 | up to the developer to tell how data of a certain type should be parsed or 50 | formattet. reqres provides a range of parsers and formatters for common 51 | exchange formats in order to ease the pain of this part. 52 | contents: 53 | - parsers 54 | - default_parsers 55 | - formatters 56 | - default_formatters 57 | - title: "Error handling" 58 | desc: > 59 | reqres provides a suite of helper functions to make it easy to report 60 | problems to the client in a standard way. These are all based on the HTTP 61 | Problems spec defined in 62 | [RFC 9457](https://datatracker.ietf.org/doc/html/rfc9457) 63 | contents: 64 | - abort_http_problem 65 | - title: "Utilities" 66 | desc: > 67 | reqres includes a small selection of utilities beyond the ones mentioned 68 | above, which are listed here. 69 | contents: 70 | - to_http_date 71 | - query_parser 72 | - session_cookie 73 | - random_key 74 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | This is a major release of reqres marking a stabilisation of the API. It 2 | contains plentitude of tweaks, many of which have been done in unison with the 3 | fiery package which is the main consumer of reqres. This release breaks fiery 4 | but a new version is ready to be submitted once reqres has been accepted 5 | 6 | ## revdepcheck results 7 | 8 | We checked 2 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 9 | 10 | * We saw 1 new problems 11 | * We failed to check 0 packages 12 | 13 | Issues with CRAN packages are summarised below. 14 | 15 | ### New problems 16 | (This reports the first line of each new failure) 17 | 18 | * fiery 19 | checking tests ... ERROR 20 | 21 | -------------------------------------------------------------------------------- /data-raw/internal.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `mimes` dataset goes here 2 | 3 | db <- jsonlite::read_json("https://cdn.jsdelivr.net/gh/jshttp/mime-db@master/db.json") 4 | mimes <- data.frame( 5 | name = names(db), 6 | extensions = I(unname(lapply(db, function(x) x$extensions))), 7 | charset = unname(vapply(db, function(x) x$charset %||% NA_character_, character(1))), 8 | compressible = unname(vapply(db, function(x) x$compressible %||% NA, logical(1))), 9 | source = unname(vapply(db, function(x) x$source %||% NA_character_, character(1))) 10 | ) 11 | 12 | # Additional processing 13 | geojson <- which(mimes$name == "application/vnd.geo+json") 14 | mimes$extensions[[geojson]] <- unique(append(mimes$extensions[[geojson]], "geojson")) 15 | 16 | gpkg <- which(mimes$name == "application/geopackage+sqlite3") 17 | mimes$extensions[[gpkg]] <- unique(append(mimes$extensions[[gpkg]], "gpkg")) 18 | 19 | jsonp <- which(mimes$name == "application/javascript") 20 | mimes$extensions[[jsonp]] <- unique(append(mimes$extensions[[jsonp]], "jsonp")) 21 | 22 | plain <- which(mimes$name == "text/plain") 23 | mimes$extensions[[plain]] <- unique(append(mimes$extensions[[plain]], c("r", "rd"))) 24 | 25 | md <- which(mimes$name == "text/x-markdown") 26 | mimes$extensions[[md]] <- unique(append(mimes$extensions[[md]], c("md", "rmd", "qmd"))) 27 | 28 | md <- which(mimes$name == "text/markdown") 29 | mimes$extensions[[md]] <- unique(append(mimes$extensions[[md]], c("md", "rmd", "qmd"))) 30 | 31 | mimes <- rbind(mimes, 32 | data.frame(name = "text/x-sweave", extensions = I(list("rnw")), charset = NA_character_, compressible = TRUE, source = "reqres") 33 | ) 34 | 35 | scss <- which(mimes$name == "text/css") 36 | mimes$extensions[[scss]] <- unique(append(mimes$extensions[[scss]], "scss")) 37 | 38 | mimes <- rbind(mimes, 39 | data.frame(name = "application/rds", extensions = I(list("rds")), charset = NA_character_, compressible = FALSE, source = "reqres") 40 | ) 41 | 42 | feather <- which(mimes$name == "application/vnd.apache.arrow.file") 43 | mimes$extensions[[feather]] <- unique(append(mimes$extensions[[feather]], "feather")) 44 | 45 | parquet <- which(mimes$name == "application/vnd.apache.parquet") 46 | mimes$extensions[[parquet]] <- unique(append(mimes$extensions[[parquet]], "parquet")) 47 | 48 | # Fast Extension lookup 49 | mimes_ext <- data.frame( 50 | ext = unlist(mimes$extensions), 51 | index = rep(seq_along(mimes$extensions), lengths(mimes$extensions)) 52 | ) 53 | 54 | # Status code names 55 | 56 | ## Main RFC 57 | doc <- "https://datatracker.ietf.org/doc/html/rfc9110" 58 | codes <- rvest::read_html(doc) |> 59 | rvest::html_element("#status\\.codes") |> 60 | rvest::html_elements('div[id^="status"]>section>h4') 61 | 62 | links <- codes |> 63 | rvest::html_element('.section-number') |> 64 | rvest::html_attr("href") 65 | links <- paste0(doc, links) 66 | codes <- codes |> 67 | rvest::html_element('.section-name') |> 68 | rvest::html_text() 69 | 70 | status <- data.frame( 71 | code = as.integer(substr(codes, 1, 3)), 72 | message = sub("^\\d\\d\\d ", "", codes), 73 | link = links 74 | ) 75 | 76 | ## A Few additionals 77 | doc <- "https://datatracker.ietf.org/doc/html/rfc6585" 78 | codes <- rvest::read_html(doc) |> 79 | rvest::html_elements('span.h2') 80 | 81 | links <- codes |> 82 | rvest::html_element('.selflink') |> 83 | rvest::html_attr("href") 84 | links <- paste0(doc, links) 85 | 86 | codes <- codes |> 87 | rvest::html_text() 88 | 89 | is_code <- grepl("\\d\\d\\d", codes) 90 | links <- links[is_code] 91 | codes <- codes[is_code] 92 | 93 | status <- rbind(status, data.frame( 94 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 95 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 96 | link = links 97 | )) 98 | 99 | ## Legal reasons 100 | doc <- "https://datatracker.ietf.org/doc/html/rfc7725" 101 | codes <- rvest::read_html(doc) |> 102 | rvest::html_elements('span.h2') 103 | 104 | links <- codes |> 105 | rvest::html_element('.selflink') |> 106 | rvest::html_attr("href") 107 | links <- paste0(doc, links) 108 | 109 | codes <- codes |> 110 | rvest::html_text() 111 | 112 | is_code <- grepl("\\d\\d\\d", codes) 113 | links <- links[is_code] 114 | codes <- codes[is_code] 115 | 116 | status <- rbind(status, data.frame( 117 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 118 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 119 | link = links 120 | )) 121 | 122 | ## Early hints 123 | doc <- "https://datatracker.ietf.org/doc/html/rfc8297" 124 | codes <- rvest::read_html(doc) |> 125 | rvest::html_elements('span.h2') 126 | 127 | links <- codes |> 128 | rvest::html_element('.selflink') |> 129 | rvest::html_attr("href") 130 | links <- paste0(doc, links) 131 | 132 | codes <- codes |> 133 | rvest::html_text() 134 | 135 | is_code <- grepl("\\d\\d\\d", codes) 136 | links <- links[is_code] 137 | codes <- codes[is_code] 138 | 139 | status <- rbind(status, data.frame( 140 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 141 | message = sub("^.*\\d\\d\\d:", "", codes), 142 | link = links 143 | )) 144 | 145 | ## WebDAV 146 | doc <- "https://datatracker.ietf.org/doc/html/rfc4918" 147 | codes <- rvest::read_html(doc) |> 148 | rvest::html_elements('span.h3') 149 | 150 | links <- codes |> 151 | rvest::html_element('.selflink') |> 152 | rvest::html_attr("href") 153 | links <- paste0(doc, links) 154 | 155 | codes <- codes |> 156 | rvest::html_text() 157 | 158 | is_code <- grepl("\\d\\d\\d", codes) 159 | links <- links[is_code] 160 | codes <- codes[is_code] 161 | 162 | status <- rbind(status, data.frame( 163 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 164 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 165 | link = links 166 | )) 167 | 168 | ## WebDAV++ 169 | doc <- "https://datatracker.ietf.org/doc/html/rfc5842" 170 | codes <- rvest::read_html(doc) |> 171 | rvest::html_elements('span.h3') 172 | 173 | links <- codes |> 174 | rvest::html_element('.selflink') |> 175 | rvest::html_attr("href") 176 | links <- paste0(doc, links) 177 | 178 | codes <- codes |> 179 | rvest::html_text() 180 | 181 | is_code <- grepl("\\d\\d\\d", codes) 182 | links <- links[is_code] 183 | codes <- codes[is_code] 184 | 185 | status <- rbind(status, data.frame( 186 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 187 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 188 | link = links 189 | )) 190 | 191 | ## IM Used 192 | doc <- "https://datatracker.ietf.org/doc/html/rfc3229" 193 | codes <- rvest::read_html(doc) |> 194 | rvest::html_elements('span.h4') 195 | 196 | links <- codes |> 197 | rvest::html_element('.selflink') |> 198 | rvest::html_attr("href") 199 | links <- paste0(doc, links) 200 | 201 | codes <- codes |> 202 | rvest::html_text() 203 | 204 | is_code <- grepl("\\d\\d\\d", codes) 205 | links <- links[is_code] 206 | codes <- codes[is_code] 207 | 208 | status <- rbind(status, data.frame( 209 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 210 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 211 | link = links 212 | )) 213 | 214 | ## Too Early 215 | doc <- "https://datatracker.ietf.org/doc/html/rfc8470" 216 | codes <- rvest::read_html(doc) |> 217 | rvest::html_elements('span.h3') 218 | 219 | links <- codes |> 220 | rvest::html_element('.selflink') |> 221 | rvest::html_attr("href") 222 | links <- paste0(doc, links) 223 | 224 | codes <- codes |> 225 | rvest::html_text() 226 | 227 | is_code <- grepl("\\d\\d\\d", codes) 228 | links <- links[is_code] 229 | codes <- codes[is_code] 230 | 231 | status <- rbind(status, data.frame( 232 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 233 | message = sub("^.*\\((.+)\\).*$", "\\1", codes), 234 | link = links 235 | )) 236 | 237 | ## Variant also negotiates 238 | doc <- "https://datatracker.ietf.org/doc/html/rfc2295" 239 | codes <- rvest::read_html(doc) |> 240 | rvest::html_elements('span.h3') 241 | 242 | links <- codes |> 243 | rvest::html_element('.selflink') |> 244 | rvest::html_attr("href") 245 | links <- paste0(doc, links) 246 | 247 | codes <- codes |> 248 | rvest::html_text() 249 | 250 | is_code <- grepl("\\d\\d\\d", codes) 251 | links <- links[is_code] 252 | codes <- codes[is_code] 253 | 254 | status <- rbind(status, data.frame( 255 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 256 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 257 | link = links 258 | )) 259 | 260 | ## Not Extended 261 | doc <- "https://datatracker.ietf.org/doc/html/rfc2774" 262 | codes <- rvest::read_html(doc) |> 263 | rvest::html_elements('span.h2') 264 | 265 | links <- codes |> 266 | rvest::html_element('.selflink') |> 267 | rvest::html_attr("href") 268 | links <- paste0(doc, links) 269 | 270 | codes <- codes |> 271 | rvest::html_text() 272 | 273 | is_code <- grepl("\\d\\d\\d", codes) 274 | links <- links[is_code] 275 | codes <- codes[is_code] 276 | 277 | status <- rbind(status, data.frame( 278 | code = as.integer(sub("^.*(\\d\\d\\d).*$", "\\1", codes)), 279 | message = sub("^.*\\d\\d\\d\\s+", "", codes), 280 | link = links 281 | )) 282 | 283 | status <- status[!duplicated(status$code), ] 284 | status <- status[order(status$code), ] 285 | attr(status, "row.names") <- .set_row_names(nrow(status)) 286 | 287 | usethis::use_data(mimes, mimes_ext, status, overwrite = TRUE, internal = TRUE) 288 | -------------------------------------------------------------------------------- /man/abort_http_problem.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/problems.R 3 | \name{abort_http_problem} 4 | \alias{abort_http_problem} 5 | \alias{abort_status} 6 | \alias{abort_bad_request} 7 | \alias{abort_unauthorized} 8 | \alias{abort_forbidden} 9 | \alias{abort_not_found} 10 | \alias{abort_method_not_allowed} 11 | \alias{abort_not_acceptable} 12 | \alias{abort_conflict} 13 | \alias{abort_gone} 14 | \alias{abort_internal_error} 15 | \alias{handle_problem} 16 | \alias{is_reqres_problem} 17 | \title{Abort request processing with an HTTP problem response} 18 | \usage{ 19 | abort_http_problem( 20 | code, 21 | detail, 22 | title = NULL, 23 | type = NULL, 24 | instance = NULL, 25 | ..., 26 | message = detail, 27 | call = caller_env() 28 | ) 29 | 30 | abort_status(code, message = status_phrase(code), ..., call = caller_env()) 31 | 32 | abort_bad_request( 33 | detail, 34 | instance = NULL, 35 | ..., 36 | message = detail, 37 | call = caller_env() 38 | ) 39 | 40 | abort_unauthorized( 41 | detail, 42 | instance = NULL, 43 | ..., 44 | message = detail, 45 | call = caller_env() 46 | ) 47 | 48 | abort_forbidden( 49 | detail, 50 | instance = NULL, 51 | ..., 52 | message = detail, 53 | call = caller_env() 54 | ) 55 | 56 | abort_not_found( 57 | detail, 58 | instance = NULL, 59 | ..., 60 | message = detail, 61 | call = caller_env() 62 | ) 63 | 64 | abort_method_not_allowed( 65 | detail, 66 | instance = NULL, 67 | ..., 68 | message = detail, 69 | call = caller_env() 70 | ) 71 | 72 | abort_not_acceptable( 73 | detail, 74 | instance = NULL, 75 | ..., 76 | message = detail, 77 | call = caller_env() 78 | ) 79 | 80 | abort_conflict( 81 | detail, 82 | instance = NULL, 83 | ..., 84 | message = detail, 85 | call = caller_env() 86 | ) 87 | 88 | abort_gone(detail, instance = NULL, ..., message = detail, call = caller_env()) 89 | 90 | abort_internal_error( 91 | detail, 92 | instance = NULL, 93 | ..., 94 | message = detail, 95 | call = caller_env() 96 | ) 97 | 98 | handle_problem(response, cnd) 99 | 100 | is_reqres_problem(cnd) 101 | } 102 | \arguments{ 103 | \item{code}{The HTTP status code to use} 104 | 105 | \item{detail}{A string detailing the problem. Make sure the information 106 | given does not pose a security risk} 107 | 108 | \item{title}{A human-readable title of the issue. Should not vary from 109 | instance to instance of the specific issue. If \code{NULL} then the status 110 | code title is used} 111 | 112 | \item{type}{A URI that uniquely identifies this type of problem. The URI 113 | must resolve to an HTTP document describing the problem in human readable 114 | text. If \code{NULL}, the most recent link to the given status code definition 115 | is used} 116 | 117 | \item{instance}{A unique identifier of the specific instance of this 118 | problem that can be used for further debugging. Can be omitted.} 119 | 120 | \item{...}{ 121 | Arguments passed on to \code{\link[rlang:cnd]{rlang::error_cnd}} 122 | \describe{ 123 | \item{\code{class}}{The condition subclass.} 124 | \item{\code{use_cli_format}}{Whether to use the cli package to format 125 | \code{message}. See \code{\link[rlang:local_use_cli]{local_use_cli()}}.} 126 | \item{\code{trace}}{A \code{trace} object created by \code{\link[rlang:trace_back]{trace_back()}}.} 127 | \item{\code{parent}}{A parent condition object.} 128 | }} 129 | 130 | \item{message}{A default message to inform the user about the 131 | condition when it is signalled.} 132 | 133 | \item{call}{A function call to be included in the error message. 134 | If an execution environment of a running function, the 135 | corresponding function call is retrieved.} 136 | 137 | \item{response}{The Response object associated with the request that created 138 | the condition} 139 | 140 | \item{cnd}{The thrown condition} 141 | } 142 | \description{ 143 | This set of functions throws a classed error indicating that the request 144 | should be responded to with an HTTP problem according to the spec defined in 145 | \href{https://datatracker.ietf.org/doc/html/rfc9457}{RFC 9457} or a bare response 146 | code. These conditions should be caught and handled by the \code{handle_problem()} 147 | function. 148 | } 149 | -------------------------------------------------------------------------------- /man/default_formatters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \docType{data} 4 | \name{default_formatters} 5 | \alias{default_formatters} 6 | \title{A list of default formatter mappings} 7 | \usage{ 8 | default_formatters 9 | } 10 | \description{ 11 | This list matches the most normal mime types with their respective formatters 12 | using default arguments. For a no-frills request parsing this can be supplied 13 | directly to \code{Response$format()}. To add or modify to this list simply supply 14 | the additional parsers as second, third, etc, argument and they will 15 | overwrite or add depending on whether it specifies a mime type already 16 | present. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | res$format(default_formatters, 'text/plain' = format_plain(sep = ' ')) 21 | } 22 | 23 | } 24 | \seealso{ 25 | \link{formatters} for an overview of the build in formatters in \code{reqres} 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/default_parsers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/parsers.R 3 | \docType{data} 4 | \name{default_parsers} 5 | \alias{default_parsers} 6 | \title{A list of default parser mappings} 7 | \usage{ 8 | default_parsers 9 | } 10 | \description{ 11 | This list matches the most normal mime types with their respective parsers 12 | using default arguments. For a no-frills request parsing this can be supplied 13 | directly to \code{Request$parse()}. To add or modify to this list simply supply 14 | the additional parsers as second, third, etc, argument and they will 15 | overwrite or add depending on whether it specifies a mime type already 16 | present. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | req$parse(default_parsers, 'application/json' = parse_json(flatten = TRUE)) 21 | } 22 | 23 | } 24 | \seealso{ 25 | \link{parsers} for an overview of the build in parsers in \code{reqres} 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/figures/lifecycle-deprecated.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: deprecated 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | lifecycle 18 | 19 | deprecated 20 | 21 | 22 | -------------------------------------------------------------------------------- /man/figures/lifecycle-experimental.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: experimental 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | lifecycle 18 | 19 | experimental 20 | 21 | 22 | -------------------------------------------------------------------------------- /man/figures/lifecycle-stable.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: stable 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 19 | 20 | lifecycle 21 | 22 | 25 | 26 | stable 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /man/figures/lifecycle-superseded.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: superseded 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | lifecycle 18 | 19 | superseded 20 | 21 | 22 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/man/figures/logo.png -------------------------------------------------------------------------------- /man/formatters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{formatters} 4 | \alias{formatters} 5 | \alias{format_json} 6 | \alias{format_plain} 7 | \alias{format_xml} 8 | \alias{format_html} 9 | \alias{format_table} 10 | \title{Pre-supplied formatting generators} 11 | \usage{ 12 | format_json( 13 | dataframe = "rows", 14 | matrix = "rowmajor", 15 | Date = "ISO8601", 16 | POSIXt = "string", 17 | factor = "string", 18 | complex = "string", 19 | raw = "base64", 20 | null = "list", 21 | na = "null", 22 | auto_unbox = FALSE, 23 | digits = 4, 24 | pretty = FALSE, 25 | force = FALSE 26 | ) 27 | 28 | format_plain(sep = "\\n") 29 | 30 | format_xml(root_name = "document", encoding = "UTF-8", options = "as_xml") 31 | 32 | format_html(encoding = "UTF-8", options = "as_html") 33 | 34 | format_table(...) 35 | } 36 | \arguments{ 37 | \item{dataframe}{how to encode data.frame objects: must be one of 'rows', 'columns' or 'values'} 38 | 39 | \item{matrix}{how to encode matrices and higher dimensional arrays: must be one of 'rowmajor' or 'columnmajor'.} 40 | 41 | \item{Date}{how to encode Date objects: must be one of 'ISO8601' or 'epoch'} 42 | 43 | \item{POSIXt}{how to encode POSIXt (datetime) objects: must be one of 'string', 'ISO8601', 'epoch' or 'mongo'} 44 | 45 | \item{factor}{how to encode factor objects: must be one of 'string' or 'integer'} 46 | 47 | \item{complex}{how to encode complex numbers: must be one of 'string' or 'list'} 48 | 49 | \item{raw}{how to encode raw objects: must be one of 'base64', 'hex' or 'mongo'} 50 | 51 | \item{null}{how to encode NULL values within a list: must be one of 'null' or 'list'} 52 | 53 | \item{na}{how to print NA values: must be one of 'null' or 'string'. Defaults are class specific} 54 | 55 | \item{auto_unbox}{automatically \code{\link[jsonlite:unbox]{unbox()}} all atomic vectors of length 1. It is usually safer to avoid this and instead use the \code{\link[jsonlite:unbox]{unbox()}} function to unbox individual elements. 56 | An exception is that objects of class \code{AsIs} (i.e. wrapped in \code{\link[=I]{I()}}) are not automatically unboxed. This is a way to mark single values as length-1 arrays.} 57 | 58 | \item{digits}{max number of decimal digits to print for numeric values. Use \code{\link[=I]{I()}} to specify significant digits. Use \code{NA} for max precision.} 59 | 60 | \item{pretty}{adds indentation whitespace to JSON output. Can be TRUE/FALSE or a number specifying the number of spaces to indent (default is 2). Use a negative number for tabs instead of spaces.} 61 | 62 | \item{force}{unclass/skip objects of classes with no defined JSON mapping} 63 | 64 | \item{sep}{The line separator. Plain text will be split into multiple strings 65 | based on this.} 66 | 67 | \item{root_name}{The name of the root element of the created xml} 68 | 69 | \item{encoding}{The character encoding to use in the document. The default 70 | encoding is \sQuote{UTF-8}. Available encodings are specified at 71 | \url{http://xmlsoft.org/html/libxml-encoding.html#xmlCharEncoding}.} 72 | 73 | \item{options}{default: \sQuote{format}. Zero or more of 74 | \describe{ 75 | \item{format}{Format output} 76 | \item{no_declaration}{Drop the XML declaration} 77 | \item{no_empty_tags}{Remove empty tags} 78 | \item{no_xhtml}{Disable XHTML1 rules} 79 | \item{require_xhtml}{Force XHTML rules} 80 | \item{as_xml}{Force XML output} 81 | \item{as_html}{Force HTML output} 82 | \item{format_whitespace}{Format with non-significant whitespace} 83 | }} 84 | 85 | \item{...}{parameters passed on to \code{\link[=write.table]{write.table()}}} 86 | } 87 | \value{ 88 | A function accepting an R object 89 | } 90 | \description{ 91 | This set of functions can be used to construct formatting functions adhering 92 | to the Response$format() requirements. 93 | } 94 | \examples{ 95 | fake_rook <- fiery::fake_request( 96 | 'http://example.com/test', 97 | content = '', 98 | headers = list( 99 | Content_Type = 'text/plain', 100 | Accept = 'application/json, text/csv' 101 | ) 102 | ) 103 | 104 | req <- Request$new(fake_rook) 105 | res <- req$respond() 106 | res$body <- mtcars 107 | res$format(json = format_json(), csv = format_table(sep=',')) 108 | res$body 109 | 110 | # Cleaning up connections 111 | rm(fake_rook, req, res) 112 | gc() 113 | 114 | } 115 | \seealso{ 116 | \link{parsers} for converting \code{Request} bodies into R objects 117 | 118 | \link{default_formatters} for a list that maps the most common mime types 119 | to their respective formatters 120 | } 121 | -------------------------------------------------------------------------------- /man/http_date.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \name{to_http_date} 4 | \alias{to_http_date} 5 | \alias{from_http_date} 6 | \title{Format timestamps to match the HTTP specs} 7 | \usage{ 8 | to_http_date(time, format = NULL) 9 | 10 | from_http_date(time) 11 | } 12 | \arguments{ 13 | \item{time}{A string or an object coercible to POSIXct} 14 | 15 | \item{format}{In case \code{time} is not a POSIXct object a specification how the 16 | string should be interpreted.} 17 | } 18 | \value{ 19 | \code{to_http_date()} returns a properly formatted string, while 20 | \code{from_http_date()} returns a POSIXct object 21 | } 22 | \description{ 23 | Dates/times in HTTP headers needs a specific format to be valid, and is 24 | furthermore always given in GMT time. These two functions aids in converting 25 | back and forth between the required format. 26 | } 27 | \examples{ 28 | time <- to_http_date(Sys.time()) 29 | time 30 | from_http_date(time) 31 | } 32 | -------------------------------------------------------------------------------- /man/mime_type_from_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \name{mime_type_from_file} 4 | \alias{mime_type_from_file} 5 | \alias{mime_type_info} 6 | \title{Get the mime type associated with a file based on its file extension} 7 | \usage{ 8 | mime_type_from_file(filename) 9 | 10 | mime_type_info(type) 11 | } 12 | \arguments{ 13 | \item{filename}{The name of the file to query} 14 | 15 | \item{type}{The mime type to get additional information on} 16 | } 17 | \value{ 18 | A data.frame with a row for each match and the columns: 19 | \itemize{ 20 | \item \emph{name} The mime type 21 | \item \emph{extensions} The extensions commonly associated with the mime type 22 | \item \emph{charset} The character set used for the type, if any 23 | \item \emph{compressible} Is the type known to be compressible 24 | \item \emph{source} The source of the mime type information 25 | } 26 | } 27 | \description{ 28 | While file extensions are not universally guaranteed to be tied to the 29 | content of a file, they are often indicative of the content to the degree 30 | that they can be used if the content type is missing. \code{mime_type_from_file} 31 | gives access to the huge database of mime types and their file extensions 32 | that reqres contains. \code{mime_type_info()} provides the same information but 33 | rather than basing the search on a file, you provide the known mime type 34 | directly 35 | } 36 | \keyword{internal} 37 | -------------------------------------------------------------------------------- /man/parsers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/parsers.R 3 | \name{parsers} 4 | \alias{parsers} 5 | \alias{parse_json} 6 | \alias{parse_plain} 7 | \alias{parse_xml} 8 | \alias{parse_html} 9 | \alias{parse_multiform} 10 | \alias{parse_queryform} 11 | \alias{parse_table} 12 | \title{Pre-supplied parsing generators} 13 | \usage{ 14 | parse_json( 15 | simplifyVector = TRUE, 16 | simplifyDataFrame = simplifyVector, 17 | simplifyMatrix = simplifyVector, 18 | flatten = FALSE 19 | ) 20 | 21 | parse_plain(sep = "\\n") 22 | 23 | parse_xml(encoding = "", options = "NOBLANKS", base_url = "") 24 | 25 | parse_html( 26 | encoding = "", 27 | options = c("RECOVER", "NOERROR", "NOBLANKS"), 28 | base_url = "" 29 | ) 30 | 31 | parse_multiform() 32 | 33 | parse_queryform(delim = NULL) 34 | 35 | parse_table(...) 36 | } 37 | \arguments{ 38 | \item{simplifyVector}{coerce JSON arrays containing only primitives into an atomic vector} 39 | 40 | \item{simplifyDataFrame}{coerce JSON arrays containing only records (JSON objects) into a data frame} 41 | 42 | \item{simplifyMatrix}{coerce JSON arrays containing vectors of equal mode and dimension into matrix or array} 43 | 44 | \item{flatten}{automatically \code{\link[jsonlite:flatten]{flatten()}} nested data frames into a single non-nested data frame} 45 | 46 | \item{sep}{The line separator. Plain text will be split into multiple strings 47 | based on this.} 48 | 49 | \item{encoding}{Specify a default encoding for the document. Unless 50 | otherwise specified XML documents are assumed to be in UTF-8 or 51 | UTF-16. If the document is not UTF-8/16, and lacks an explicit 52 | encoding directive, this allows you to supply a default.} 53 | 54 | \item{options}{Set parsing options for the libxml2 parser. Zero or more of 55 | \describe{ 56 | \item{RECOVER}{recover on errors} 57 | \item{NOENT}{substitute entities} 58 | \item{DTDLOAD}{load the external subset} 59 | \item{DTDATTR}{default DTD attributes} 60 | \item{DTDVALID}{validate with the DTD} 61 | \item{NOERROR}{suppress error reports} 62 | \item{NOWARNING}{suppress warning reports} 63 | \item{PEDANTIC}{pedantic error reporting} 64 | \item{NOBLANKS}{remove blank nodes} 65 | \item{SAX1}{use the SAX1 interface internally} 66 | \item{XINCLUDE}{Implement XInclude substitution} 67 | \item{NONET}{Forbid network access} 68 | \item{NODICT}{Do not reuse the context dictionary} 69 | \item{NSCLEAN}{remove redundant namespaces declarations} 70 | \item{NOCDATA}{merge CDATA as text nodes} 71 | \item{NOXINCNODE}{do not generate XINCLUDE START/END nodes} 72 | \item{COMPACT}{compact small text nodes; no modification of the tree allowed afterwards (will possibly crash if you try to modify the tree)} 73 | \item{OLD10}{parse using XML-1.0 before update 5} 74 | \item{NOBASEFIX}{do not fixup XINCLUDE xml:base uris} 75 | \item{HUGE}{relax any hardcoded limit from the parser} 76 | \item{OLDSAX}{parse using SAX2 interface before 2.7.0} 77 | \item{IGNORE_ENC}{ignore internal document encoding hint} 78 | \item{BIG_LINES}{Store big lines numbers in text PSVI field} 79 | }} 80 | 81 | \item{base_url}{When loading from a connection, raw vector or literal 82 | html/xml, this allows you to specify a base url for the document. Base 83 | urls are used to turn relative urls into absolute urls.} 84 | 85 | \item{delim}{The delimiter to use for parsing arrays in non-exploded form. 86 | Either \code{NULL} (no delimiter) or one of \code{","}, \code{"|"}, or \code{" "}} 87 | 88 | \item{...}{parameters passed on to \code{\link[=read.table]{read.table()}}} 89 | } 90 | \value{ 91 | A function accepting a raw vector and a named list of directives 92 | } 93 | \description{ 94 | This set of functions can be used to construct parsing functions adhering to 95 | the Request$parse() requirements. 96 | } 97 | \examples{ 98 | fake_rook <- fiery::fake_request( 99 | 'http://example.com/test', 100 | content = '[1, 2, 3, 4]', 101 | headers = list( 102 | Content_Type = 'application/json' 103 | ) 104 | ) 105 | 106 | req <- Request$new(fake_rook) 107 | req$parse(json = parse_json()) 108 | req$body 109 | 110 | # Cleaning up connections 111 | rm(fake_rook, req) 112 | gc() 113 | 114 | } 115 | \seealso{ 116 | \link{formatters} for converting \code{Response} bodies into compatible types 117 | 118 | \link{default_parsers} for a list that maps the most common mime types 119 | to their respective parsers 120 | } 121 | -------------------------------------------------------------------------------- /man/query_parser.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \name{query_parser} 4 | \alias{query_parser} 5 | \title{Parse a query string} 6 | \usage{ 7 | query_parser(query = NULL, delim = NULL) 8 | } 9 | \arguments{ 10 | \item{query}{The query as a single string} 11 | 12 | \item{delim}{Optional delimiter of array values. If omitted it is expected 13 | that arrays are provided in exploded form (e.g. \code{arg1=3&arg1=7})} 14 | } 15 | \value{ 16 | A named list giving the keys and values of the query. Values fron the 17 | same key are combined if given multiple times 18 | } 19 | \description{ 20 | This function facilitates the parsing of querystrings, either from the URL or 21 | a POST or PUT body with \code{Content-Type} set to 22 | \code{application/x-www-form-urlencoded}. 23 | } 24 | \examples{ 25 | # Using delimiter to provide array 26 | query_parser("?name=Thomas+Lin+Pedersen&numbers=1\%202\%203", delim = " ") 27 | 28 | # No delimiter (exploded form) 29 | query_parser("?name=Thomas\%20Lin\%20Pedersen&numbers=1&numbers=2&numbers=3") 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/random_key.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \name{random_key} 4 | \alias{random_key} 5 | \title{Generate a random key compatible with encryption and decryption in requests and responses} 6 | \usage{ 7 | random_key() 8 | } 9 | \value{ 10 | A 32-bit key as a hex-encoded string 11 | } 12 | \description{ 13 | The encryption/decryption used in reqres is based on the \href{https://github.com/r-lib/sodium}{sodium} 14 | package and requires a 32-bit encryption key encoded as hexadecimal values. 15 | While you can craft your own, this function will take care of creating a 16 | compliant key using a cryptographically secure pseudorandom number generator 17 | from \code{sodium::helpers()}. 18 | } 19 | \details{ 20 | Keep your encryption keys safe! Anyone with the key will be able to eavesdrop 21 | on your communication and tamper with the information stored in encrypted 22 | cookies through man-in-the-middle attacks. The best approach is to use the 23 | keyring package to manage your keys, but as an alternative you can store it 24 | as environment variables. 25 | 26 | \strong{NEVER STORE THE KEY IN PLAIN TEXT.} 27 | 28 | \strong{NEVER PUT THE KEY SOMEWHERE WHERE IT CAN ACCIDENTALLY BE COMMITTED TO GIT OR 29 | OTHER VERSION CONTROL SOFTWARE} 30 | } 31 | \examples{ 32 | \dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 33 | # Store a key with keyring and use it 34 | keyring::key_set_with_value("reqres_key", random_key()) 35 | 36 | rook <- fiery::fake_request("http://example.com") 37 | 38 | Request$new(rook, key = keyring::key_get("reqres_key")) 39 | \dontshow{\}) # examplesIf} 40 | } 41 | -------------------------------------------------------------------------------- /man/reqres-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reqres-package.R 3 | \docType{package} 4 | \name{reqres-package} 5 | \alias{reqres} 6 | \alias{reqres-package} 7 | \title{reqres: Powerful Classes for HTTP Requests and Responses} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | In order to facilitate parsing of http requests and creating appropriate responses this package provides two classes to handle a lot of the housekeeping involved in working with http exchanges. The infrastructure builds upon the 'rook' specification and is thus well suited to be combined with 'httpuv' based web servers. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://reqres.data-imaginist.com} 17 | \item \url{https://github.com/thomasp85/reqres} 18 | \item Report bugs at \url{https://github.com/thomasp85/reqres/issues} 19 | } 20 | 21 | } 22 | \author{ 23 | \strong{Maintainer}: Thomas Lin Pedersen \email{thomasp85@gmail.com} (\href{https://orcid.org/0000-0002-5147-4711}{ORCID}) 24 | 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/session_cookie.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \name{session_cookie} 4 | \alias{session_cookie} 5 | \alias{is_session_cookie_settings} 6 | \title{Collect settings for a session cookie} 7 | \usage{ 8 | session_cookie( 9 | name = "reqres", 10 | expires = NULL, 11 | max_age = NULL, 12 | path = NULL, 13 | secure = NULL, 14 | same_site = NULL 15 | ) 16 | 17 | is_session_cookie_settings(x) 18 | } 19 | \arguments{ 20 | \item{name}{The name of the cookie} 21 | 22 | \item{expires}{A POSIXct object given the expiration time of the cookie} 23 | 24 | \item{max_age}{The number of seconds to elapse before the cookie expires} 25 | 26 | \item{path}{The URL path this cookie is related to} 27 | 28 | \item{secure}{Should the cookie only be send over https} 29 | 30 | \item{same_site}{Either \code{"Lax"}, \code{"Strict"}, or \code{"None"} indicating 31 | how the cookie can be send during cross-site requests. If this is set to 32 | \code{"None"} then \code{secure} \emph{must} also be set to \code{TRUE}} 33 | 34 | \item{x}{An object to test} 35 | } 36 | \value{ 37 | A \code{session_cookie_settings} object that can be used during request 38 | initialisation. Can be cached and reused for all requests in a server 39 | } 40 | \description{ 41 | A session cookie is just like any other cookie, but reqres treats this one 42 | different, parsing it's value and making it available in the \verb{$session} 43 | field. However, the same settings as any other cookies applies and can be 44 | given during request initialisation using this function. 45 | } 46 | \note{ 47 | As opposed to regular cookies the session cookie is forced to be HTTP 48 | only which is why this argument is missing. 49 | } 50 | \examples{ 51 | session_cookie <- session_cookie() 52 | 53 | rook <- fiery::fake_request("http://example.com") 54 | 55 | # A key must be provided for session_cookie to be used 56 | Request$new(rook, key = random_key(), session_cookie = session_cookie) 57 | 58 | } 59 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/reqres/9e4c6d19f74b303194992545163b7d2a1b23f2fb/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Revdeps 2 | 3 | ## New problems (1) 4 | 5 | |package |version |error |warning |note | 6 | |:-------|:-------|:------|:-------|:----| 7 | |[fiery](problems.md#fiery)|1.2.1 |__+1__ | | | 8 | 9 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 2 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 1 new problems 6 | * We failed to check 0 packages 7 | 8 | Issues with CRAN packages are summarised below. 9 | 10 | ### New problems 11 | (This reports the first line of each new failure) 12 | 13 | * fiery 14 | checking tests ... ERROR 15 | 16 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | # fiery 2 | 3 |
4 | 5 | * Version: 1.2.1 6 | * GitHub: https://github.com/thomasp85/fiery 7 | * Source code: https://github.com/cran/fiery 8 | * Date/Publication: 2024-02-05 22:40:11 UTC 9 | * Number of recursive dependencies: 67 10 | 11 | Run `revdepcheck::cloud_details(, "fiery")` for more info 12 | 13 |
14 | 15 | ## Newly broken 16 | 17 | * checking tests ... ERROR 18 | ``` 19 | Running ‘testthat.R’ 20 | Running the tests in ‘tests/testthat.R’ failed. 21 | Complete output: 22 | > # This file is part of the standard setup for testthat. 23 | > # It is recommended that you do not modify it. 24 | > # 25 | > # Where should you do additional test configuration? 26 | > # Learn more about the roles of various files in: 27 | > # * https://r-pkgs.org/tests.html 28 | > # * https://testthat.r-lib.org/reference/test_package.html#special-files 29 | ... 30 | 31 | `actual$Content-Type` is absent 32 | `expected$Content-Type` is a character vector ('text/plain') 33 | 34 | `actual$X-Powered-By` is absent 35 | `expected$X-Powered-By` is a character vector ('fiery') 36 | 37 | [ FAIL 2 | WARN 0 | SKIP 4 | PASS 246 ] 38 | Error: Test failures 39 | Execution halted 40 | ``` 41 | 42 | -------------------------------------------------------------------------------- /src/reqres.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #define STRICT_R_HEADERS 5 | #include 6 | #include // Included by default in R (>= 3.4). 7 | 8 | SEXP fmt_http_time(SEXP input_time) 9 | { 10 | time_t t; 11 | const char fmt[25] = "%a, %d %b %Y %H:%M:%S"; 12 | char buffer[64]; 13 | if (Rf_length(input_time) != 0) { 14 | t = INTEGER(input_time)[0]; 15 | } else { 16 | time(&t); 17 | } 18 | 19 | struct tm* tm_info; 20 | tm_info = gmtime(&t); 21 | 22 | int written = strftime(buffer, 64, fmt, tm_info); 23 | if (!written) { 24 | Rf_error("Failed to format time."); 25 | return R_NilValue; 26 | } 27 | buffer[written++] = ' '; 28 | buffer[written++] = 'G'; 29 | buffer[written++] = 'M'; 30 | buffer[written++] = 'T'; 31 | 32 | return Rf_ScalarString(Rf_mkCharLen(buffer, written)); 33 | } 34 | 35 | static const R_CallMethodDef CallEntries[] = { 36 | {"fmt_http_time_c", (DL_FUNC) &fmt_http_time, 1}, 37 | {NULL, NULL, 0} 38 | }; 39 | 40 | void R_init_reqres(DllInfo *dll) { 41 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 42 | R_useDynamicSymbols(dll, TRUE); 43 | } 44 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(reqres) 11 | 12 | test_check("reqres") 13 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/problems.md: -------------------------------------------------------------------------------- 1 | # problem_abort creates properly formed error condition 2 | 3 | Code 4 | bad_request_abort("Invalid request parameters") 5 | Condition 6 | Error: 7 | ! Invalid request parameters 8 | 9 | # abort_http_problem creates complete problem condition 10 | 11 | Code 12 | abort_http_problem(404L, "Resource not found") 13 | Condition 14 | Error: 15 | ! Resource not found 16 | 17 | # abort_status creates simpler status code condition 18 | 19 | Code 20 | abort_status(403L) 21 | Condition 22 | Error: 23 | ! Forbidden 24 | 25 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/request.md: -------------------------------------------------------------------------------- 1 | # request gets created correctly 2 | 3 | Code 4 | print(req) 5 | Message 6 | -- An HTTP request ------------------------------------------------------------- 7 | Trusted: No 8 | Method: get 9 | URL: http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen 10 | 11 | # trust works 12 | 13 | Code 14 | req$trust <- "test" 15 | Condition 16 | Error: 17 | ! `value` must be `TRUE` or `FALSE`, not the string "test". 18 | 19 | # response can be generated 20 | 21 | Code 22 | req$response <- res2 23 | Condition 24 | Error: 25 | ! Response can only be assigned once 26 | 27 | # body can be parsed 28 | 29 | Code 30 | req$parse(xml = parse_xml()) 31 | Condition 32 | Error in `req$parse()`: 33 | ! Unsupported Media Type 34 | 35 | # as.Request and is.Request work correctly 36 | 37 | Code 38 | as.Request(non_rook_env) 39 | Condition 40 | Error in `as.Request()`: 41 | ! `x` must be a Rook object 42 | 43 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/response.md: -------------------------------------------------------------------------------- 1 | # response are created correctly 2 | 3 | Code 4 | Response$new(req) 5 | Condition 6 | Error in `initialize()`: 7 | ! A response has already been created for this request. Access it using the response field 8 | 9 | # files are added correctly 10 | 11 | Code 12 | res$file <- "not_a_real_file" 13 | Condition 14 | Error in `file_path_as_absolute()`: 15 | ! file 'not_a_real_file' does not exist 16 | 17 | # print functino works 18 | 19 | Code 20 | res$print() 21 | Message 22 | -- An HTTP response ------------------------------------------------------------ 23 | Status: 404 - Not Found 24 | Content type: text/plain 25 | > Responding to: http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen 26 | 27 | # set_formatter works correctly 28 | 29 | Code 30 | no_match_res$set_formatter(json = format_json(), xml = format_xml(), autofail = TRUE) 31 | Condition 32 | Error in `no_match_res$set_formatter()`: 33 | ! Only application/json or application/xml content types supported. 34 | 35 | # data store functions work correctly 36 | 37 | Code 38 | res$data_store <- list() 39 | Condition 40 | Error: 41 | ! It is not allowed to replace the data store 42 | 43 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/session-cookie.md: -------------------------------------------------------------------------------- 1 | # Response knows how to handle session cookies 2 | 3 | Code 4 | res$session$test <- 4 5 | Condition 6 | Warning: 7 | Session cookie is not active 8 | i Provide `key` and `session_cookie` values to turn on this feature 9 | 10 | -------------------------------------------------------------------------------- /tests/testthat/test-aaa.R: -------------------------------------------------------------------------------- 1 | test_that("from_http_date works correctly", { 2 | # Test conversion from http date format to POSIXct 3 | http_date <- "Wed, 21 Oct 2015 07:28:00 GMT" 4 | expected_time <- as.POSIXct("2015-10-21 07:28:00", tz = "GMT") 5 | 6 | result <- from_http_date(http_date) 7 | 8 | expect_equal(result, expected_time) 9 | expect_equal(format(result, "%Y-%m-%d %H:%M:%S"), "2015-10-21 07:28:00") 10 | }) 11 | 12 | test_that("query_parser handles edge cases", { 13 | # Test empty or NULL query 14 | expect_equal(query_parser(), list()) 15 | expect_equal(query_parser(""), list()) 16 | 17 | # Test leading question mark 18 | expect_equal( 19 | query_parser("?name=John&age=30"), 20 | query_parser("name=John&age=30") 21 | ) 22 | 23 | # Test space delimiter 24 | expect_equal( 25 | query_parser("items=1%202%203", delim = " "), 26 | list(items = c("1", "2", "3")) 27 | ) 28 | 29 | # Test URL encoded values 30 | expect_equal( 31 | query_parser("name=John%20Doe&location=New%20York"), 32 | list(name = "John Doe", location = "New York") 33 | ) 34 | 35 | # Test plus sign as space 36 | expect_equal( 37 | query_parser("name=John+Doe&location=New+York"), 38 | list(name = "John Doe", location = "New York") 39 | ) 40 | 41 | # Test array values without delimiter 42 | expect_equal( 43 | query_parser("tag=red&tag=green&tag=blue"), 44 | list(tag = c("red", "green", "blue")) 45 | ) 46 | 47 | # Test array values with delimiter 48 | expect_equal( 49 | query_parser("tag=red|green|blue", delim = "|"), 50 | list(tag = c("red", "green", "blue")) 51 | ) 52 | }) 53 | 54 | test_that("mime_type_from_file returns correct mime types", { 55 | # Test common file extensions 56 | expect_equal(mime_type_from_file("test.html")$name, "text/html") 57 | expect_equal(mime_type_from_file("image.jpg")$name, "image/jpeg") 58 | expect_equal(mime_type_from_file("data.json")$name, "application/json") 59 | expect_equal(mime_type_from_file("script.js")$name, "application/javascript") 60 | expect_equal(mime_type_from_file("style.css")$name, "text/css") 61 | 62 | # Test case insensitivity 63 | expect_equal(mime_type_from_file("IMAGE.JPG")$name, mime_type_from_file("image.jpg")$name) 64 | 65 | # Test file with multiple extensions 66 | expect_equal(mime_type_from_file("archive.tar.gz")$name, "application/gzip") 67 | }) 68 | 69 | test_that("mime_type_info returns correct information", { 70 | # Test getting info for known mime types 71 | json_info <- mime_type_info("application/json") 72 | expect_equal(json_info$name, "application/json") 73 | expect_true("json" %in% unlist(json_info$extensions)) 74 | 75 | html_info <- mime_type_info("text/html") 76 | expect_equal(html_info$name, "text/html") 77 | expect_true("html" %in% unlist(html_info$extensions)) 78 | }) 79 | 80 | test_that("split_headers categorizes headers correctly", { 81 | headers <- list( 82 | accept = "text/html", 83 | content_type = "application/json", 84 | host = "example.com", 85 | location = "https://example.com/new", 86 | x_custom = "custom value" 87 | ) 88 | 89 | result <- split_headers(headers) 90 | 91 | expect_true("accept" %in% names(result$request)) 92 | expect_true("host" %in% names(result$request)) 93 | expect_true("location" %in% names(result$response)) 94 | expect_true("content_type" %in% names(result$entity)) 95 | expect_true("x_custom" %in% names(result$entity)) 96 | }) 97 | 98 | test_that("cat_headers formats and prints headers correctly", { 99 | headers <- list( 100 | content_type = "application/json", 101 | user_agent = "Test Agent", 102 | x_custom_header = "Custom Value" 103 | ) 104 | 105 | # Capture the output of cat_headers 106 | output <- capture.output(cat_headers(headers)) 107 | 108 | expect_match(output[1], "^Content-Type: application/json$", all = FALSE) 109 | expect_match(output[2], "^User-Agent: Test Agent$", all = FALSE) 110 | expect_match(output[3], "^X-Custom-Header: Custom Value$", all = FALSE) 111 | 112 | # Test empty headers list 113 | empty_output <- capture.output(cat_headers(list())) 114 | expect_equal(length(empty_output), 0) 115 | }) 116 | 117 | test_that("print.session_cookie_settings works correctly", { 118 | # Create a session cookie settings object 119 | cookie_settings <- session_cookie( 120 | name = "test_session", 121 | path = "/app", 122 | secure = TRUE 123 | ) 124 | 125 | # Capture the print output 126 | output <- capture.output(print(cookie_settings), type = "message") 127 | 128 | expect_match(output[1], "Settings for a session cookie named test_session", fixed = TRUE) 129 | expect_match(output[2], "Attributes:", fixed = TRUE) 130 | 131 | # Test with additional options 132 | cookie_settings2 <- session_cookie( 133 | name = "another_session", 134 | path = "/api", 135 | secure = TRUE, 136 | same_site = "Strict" 137 | ) 138 | 139 | output2 <- capture.output(print(cookie_settings2), type = "message") 140 | expect_match(output2[1], "Settings for a session cookie named another_session", fixed = TRUE) 141 | }) 142 | -------------------------------------------------------------------------------- /tests/testthat/test-formatters.R: -------------------------------------------------------------------------------- 1 | test_that("format_json works correctly", { 2 | # Create a formatter function 3 | json_formatter <- format_json(pretty = TRUE) 4 | 5 | # Test with different data types 6 | # Simple vector 7 | numbers <- 1:3 8 | expect_equal( 9 | json_formatter(numbers), 10 | jsonlite::toJSON(numbers, pretty = TRUE) 11 | ) 12 | 13 | # Data frame 14 | df <- data.frame(a = 1:3, b = c("x", "y", "z")) 15 | expect_equal( 16 | json_formatter(df), 17 | jsonlite::toJSON(df, pretty = TRUE) 18 | ) 19 | 20 | # List 21 | list_data <- list(name = "John", age = 30, hobbies = c("reading", "hiking")) 22 | expect_equal( 23 | json_formatter(list_data), 24 | jsonlite::toJSON(list_data, pretty = TRUE) 25 | ) 26 | 27 | # Test with auto_unbox = TRUE 28 | unbox_formatter <- format_json(auto_unbox = TRUE) 29 | expect_equal( 30 | unbox_formatter(list(single = "value")), 31 | jsonlite::toJSON(list(single = "value"), auto_unbox = TRUE) 32 | ) 33 | }) 34 | 35 | test_that("format_plain works correctly", { 36 | # Default separator (newline) 37 | plain_formatter <- format_plain() 38 | 39 | # Test with character vector 40 | chars <- c("line 1", "line 2", "line 3") 41 | expect_equal( 42 | plain_formatter(chars), 43 | "line 1\nline 2\nline 3" 44 | ) 45 | 46 | # Test with custom separator 47 | comma_formatter <- format_plain(sep = ", ") 48 | expect_equal( 49 | comma_formatter(chars), 50 | "line 1, line 2, line 3" 51 | ) 52 | 53 | # Test with numeric vector 54 | nums <- 1:5 55 | expect_equal( 56 | plain_formatter(nums), 57 | "1\n2\n3\n4\n5" 58 | ) 59 | 60 | # Test with mixed list 61 | mixed <- list("text", 123, TRUE) 62 | expect_equal( 63 | plain_formatter(mixed), 64 | "text\n123\nTRUE" 65 | ) 66 | }) 67 | 68 | test_that("format_xml works correctly", { 69 | # Create a formatter with default options 70 | xml_formatter <- format_xml() 71 | 72 | # Test with simple named list 73 | simple_list <- list(item = "value") 74 | xml_output <- xml_formatter(simple_list) 75 | expect_match(xml_output, "", fixed = TRUE) 76 | expect_match(xml_output, "value", fixed = TRUE) 77 | expect_match(xml_output, "", fixed = TRUE) 78 | 79 | # Test with custom root name 80 | custom_root_formatter <- format_xml(root_name = "root") 81 | custom_xml_output <- custom_root_formatter(simple_list) 82 | expect_match(custom_xml_output, "", fixed = TRUE) 83 | expect_match(custom_xml_output, "value", fixed = TRUE) 84 | expect_match(custom_xml_output, "", fixed = TRUE) 85 | 86 | # Test with nested structure 87 | nested_list <- list( 88 | person = list( 89 | name = "John", 90 | age = "30", 91 | hobbies = c("reading", "hiking") 92 | ) 93 | ) 94 | 95 | nested_output <- xml_formatter(nested_list) 96 | expect_match(nested_output, "", fixed = TRUE) 97 | expect_match(nested_output, "John", fixed = TRUE) 98 | expect_match(nested_output, "readinghiking", fixed = TRUE) 99 | 100 | # Test with plain string 101 | expect_equal(xml_formatter("raw text"), "raw text") 102 | }) 103 | 104 | test_that("format_html works correctly", { 105 | # Create a formatter with default options 106 | html_formatter <- format_html() 107 | 108 | # Test with simple named list 109 | simple_list <- list(body = list(h1 = "Title", p = "Paragraph")) 110 | html_output <- html_formatter(simple_list) 111 | expect_match(html_output, "", fixed = TRUE) 112 | expect_match(html_output, "", fixed = TRUE) 113 | expect_match(html_output, "

Title

", fixed = TRUE) 114 | expect_match(html_output, "

Paragraph

", fixed = TRUE) 115 | 116 | # Test with list that already has html root 117 | html_list <- list(html = list(body = list(p = "Content"))) 118 | html_root_output <- html_formatter(html_list) 119 | expect_match(html_root_output, "", fixed = TRUE) 120 | expect_match(html_root_output, "", fixed = TRUE) 121 | expect_match(html_root_output, "

Content

", fixed = TRUE) 122 | 123 | # Test with plain string 124 | expect_equal(html_formatter("raw html"), "raw html") 125 | 126 | # Test with shiny.tag object if available 127 | if (requireNamespace("shiny", quietly = TRUE)) { 128 | tag <- shiny::tags$div(shiny::tags$p("Hello")) 129 | expect_equal(html_formatter(tag), as.character(tag)) 130 | } 131 | }) 132 | 133 | test_that("format_table works correctly", { 134 | # Create a formatter with default options 135 | table_formatter <- format_table() 136 | 137 | # Test with data frame 138 | df <- data.frame( 139 | name = c("John", "Alice"), 140 | age = c(30, 25), 141 | stringsAsFactors = FALSE 142 | ) 143 | 144 | table_output <- table_formatter(df) 145 | expect_match(table_output, "name", fixed = TRUE) 146 | expect_match(table_output, "age", fixed = TRUE) 147 | expect_match(table_output, "John", fixed = TRUE) 148 | expect_match(table_output, "30", fixed = TRUE) 149 | 150 | # Test with custom options 151 | csv_formatter <- format_table(sep = ",", row.names = FALSE) 152 | csv_output <- csv_formatter(df) 153 | expect_false(grepl('"1"', csv_output)) # No row names 154 | expect_match(csv_output, '"name","age"', fixed = TRUE) 155 | expect_match(csv_output, '"John",30', fixed = TRUE) 156 | }) 157 | 158 | test_that("listify handles different object types correctly", { 159 | # Test with scalar 160 | scalar_result <- listify(42) 161 | expect_equal(scalar_result, list("42")) 162 | 163 | # Test with character vector 164 | char_vec <- c("a", "b", "c") 165 | char_result <- listify(char_vec) 166 | expect_length(char_result, 3) 167 | expect_equal(char_result, list(character = list("a"), character = list("b"), character = list("c"))) 168 | 169 | # Test with named list 170 | named_list <- list(name = "John", age = 30) 171 | list_result <- listify(named_list) 172 | expect_equal(names(list_result), c("name", "age")) 173 | expect_equal(list_result$name, list("John")) 174 | expect_equal(list_result$age, list("30")) 175 | 176 | # Test with complex nested structure 177 | nested <- list( 178 | person = list(name = "John", hobbies = c("reading", "hiking")) 179 | ) 180 | nested_result <- listify(nested) 181 | expect_equal(names(nested_result), "person") 182 | expect_equal(names(nested_result$person), c("name", "hobbies")) 183 | expect_equal(nested_result$person$name, list("John")) 184 | expect_equal( 185 | nested_result$person$hobbies, 186 | list(character = list("reading"), character = list("hiking")) 187 | ) 188 | }) 189 | -------------------------------------------------------------------------------- /tests/testthat/test-parsers.R: -------------------------------------------------------------------------------- 1 | test_that("parse_plain works correctly", { 2 | # Create a parser function with default separator 3 | plain_parser <- parse_plain() 4 | 5 | # Test with simple text 6 | text <- "Line 1\nLine 2\nLine 3" 7 | raw_text <- charToRaw(text) 8 | 9 | result <- plain_parser(raw_text) 10 | expect_equal(result, c("Line 1", "Line 2", "Line 3")) 11 | 12 | # Test with custom separator 13 | comma_parser <- parse_plain(sep = ",") 14 | csv_text <- "value1,value2,value3" 15 | raw_csv <- charToRaw(csv_text) 16 | 17 | csv_result <- comma_parser(raw_csv) 18 | expect_equal(csv_result, c("value1", "value2", "value3")) 19 | 20 | # Test with empty input 21 | empty_result <- plain_parser(charToRaw("")) 22 | expect_equal(empty_result, character(0)) 23 | }) 24 | 25 | test_that("parse_xml works correctly", { 26 | # Create a parser function 27 | xml_parser <- parse_xml() 28 | 29 | # Test with simple XML 30 | xml_text <- "value" 31 | xml_raw <- charToRaw(xml_text) 32 | 33 | result <- xml_parser(xml_raw) 34 | expect_equal(result$root$item[[1]], "value") 35 | 36 | # Test with nested XML 37 | nested_xml <- "John30" 38 | nested_raw <- charToRaw(nested_xml) 39 | 40 | nested_result <- xml_parser(nested_raw) 41 | expect_equal(nested_result$root$person$name[[1]], "John") 42 | expect_equal(nested_result$root$person$age[[1]], "30") 43 | }) 44 | 45 | test_that("parse_html works correctly", { 46 | # Create a parser function 47 | html_parser <- parse_html() 48 | 49 | # Test with simple HTML 50 | html_text <- "

Title

Paragraph

" 51 | html_raw <- charToRaw(html_text) 52 | 53 | result <- html_parser(html_raw) 54 | expect_equal(result$html$body$h1[[1]], "Title") 55 | expect_equal(result$html$body$p[[1]], "Paragraph") 56 | 57 | # Test with HTML that needs recovery (malformed HTML) 58 | malformed_html <- "

TextSpan

" 59 | malformed_raw <- charToRaw(malformed_html) 60 | 61 | # This should not error due to RECOVER and NOERROR options 62 | expect_no_error(html_parser(malformed_raw)) 63 | }) 64 | 65 | test_that("parse_multiform works correctly", { 66 | # Create a parser function 67 | multiform_parser <- parse_multiform() 68 | 69 | # Simple multipart form data with boundary 70 | boundary <- "boundary123" 71 | form_data <- paste0( 72 | "--", boundary, "\r\n", 73 | "Content-Disposition: form-data; name=\"field1\"\r\n\r\n", 74 | "value1\r\n", 75 | "--", boundary, "\r\n", 76 | "Content-Disposition: form-data; name=\"field2\"\r\n\r\n", 77 | "value2\r\n", 78 | "--", boundary, "--\r\n" 79 | ) 80 | 81 | raw_form <- charToRaw(form_data) 82 | directives <- list(boundary = boundary) 83 | 84 | # Skip the test if webutils package is not available 85 | skip_if_not_installed("webutils") 86 | 87 | # Test parsing multipart form data 88 | result <- multiform_parser(raw_form, directives) 89 | expect_equal(rawToChar(result$field1$value), "value1") 90 | expect_equal(rawToChar(result$field2$value), "value2") 91 | }) 92 | 93 | test_that("parse_queryform works correctly", { 94 | # Create a parser function with default options 95 | queryform_parser <- parse_queryform() 96 | 97 | # Test with simple query string 98 | query <- "name=John&age=30" 99 | raw_query <- charToRaw(query) 100 | 101 | result <- queryform_parser(raw_query, list()) 102 | expect_equal(result$name, "John") 103 | expect_equal(result$age, "30") 104 | 105 | # Test with URL encoded values 106 | encoded_query <- "name=John%20Doe&location=New%20York" 107 | raw_encoded <- charToRaw(encoded_query) 108 | 109 | encoded_result <- queryform_parser(raw_encoded, list()) 110 | expect_equal(encoded_result$name, "John Doe") 111 | expect_equal(encoded_result$location, "New York") 112 | 113 | # Test with array values 114 | array_query <- "tags=red&tags=green&tags=blue" 115 | raw_array <- charToRaw(array_query) 116 | 117 | array_result <- queryform_parser(raw_array, list()) 118 | expect_equal(array_result$tags, c("red", "green", "blue")) 119 | 120 | # Test with delimiter 121 | delim_parser <- parse_queryform(delim = "|") 122 | delim_query <- "colors=red|green|blue" 123 | raw_delim <- charToRaw(delim_query) 124 | 125 | delim_result <- delim_parser(raw_delim, list()) 126 | expect_equal(delim_result$colors, c("red", "green", "blue")) 127 | }) 128 | 129 | test_that("parse_table works correctly", { 130 | # Create a parser function with default options 131 | table_parser <- parse_table(header = TRUE, sep = ",") 132 | 133 | # Test with CSV data 134 | csv_data <- "name,age\nJohn,30\nAlice,25" 135 | raw_csv <- charToRaw(csv_data) 136 | 137 | result <- table_parser(raw_csv, list()) 138 | expect_equal(result$name, c("John", "Alice")) 139 | expect_equal(result$age, c(30, 25)) 140 | 141 | # Test with custom options 142 | tsv_parser <- parse_table(header = TRUE, sep = "\t") 143 | tsv_data <- "name\tage\nJohn\t30\nAlice\t25" 144 | raw_tsv <- charToRaw(tsv_data) 145 | 146 | tsv_result <- tsv_parser(raw_tsv, list()) 147 | expect_equal(tsv_result$name, c("John", "Alice")) 148 | expect_equal(tsv_result$age, c(30, 25)) 149 | }) 150 | -------------------------------------------------------------------------------- /tests/testthat/test-problems.R: -------------------------------------------------------------------------------- 1 | test_that("problem_abort creates properly formed error condition", { 2 | # Create a problem abort function for a specific code 3 | bad_request_abort <- problem_abort(400L) 4 | 5 | # Test that it creates an error with the expected class and attributes 6 | expect_snapshot({ 7 | bad_request_abort("Invalid request parameters") 8 | }, error = TRUE) 9 | 10 | # Capture the condition to examine its structure 11 | cnd <- tryCatch( 12 | bad_request_abort("Test detail"), 13 | reqres_problem = function(c) c 14 | ) 15 | 16 | expect_s3_class(cnd, "reqres_problem") 17 | expect_equal(cnd$status, 400L) 18 | expect_equal(cnd$detail, "Test detail") 19 | }) 20 | 21 | test_that("abort_http_problem creates complete problem condition", { 22 | # Test basic functionality 23 | expect_snapshot({ 24 | abort_http_problem(404L, "Resource not found") 25 | }, error = TRUE) 26 | 27 | # Capture the condition to examine its structure 28 | cnd <- tryCatch( 29 | abort_http_problem( 30 | code = 404L, 31 | detail = "Resource not found", 32 | title = "Not Found", 33 | type = "https://example.com/errors/not-found", 34 | instance = "error-12345" 35 | ), 36 | reqres_problem = function(c) c 37 | ) 38 | 39 | expect_s3_class(cnd, "reqres_problem") 40 | expect_equal(cnd$status, 404L) 41 | expect_equal(cnd$detail, "Resource not found") 42 | expect_equal(cnd$title, "Not Found") 43 | expect_equal(cnd$type, "https://example.com/errors/not-found") 44 | expect_equal(cnd$instance, "error-12345") 45 | }) 46 | 47 | test_that("abort_status creates simpler status code condition", { 48 | # Test basic functionality 49 | expect_snapshot({ 50 | abort_status(403L) 51 | }, error = TRUE) 52 | 53 | # Capture the condition to examine its structure 54 | cnd <- tryCatch( 55 | abort_status(403L), 56 | reqres_problem = function(c) c 57 | ) 58 | 59 | expect_s3_class(cnd, "reqres_problem") 60 | expect_equal(cnd$status, 403L) 61 | expect_equal(cnd$message, "Forbidden") 62 | 63 | # Test with custom message 64 | cnd_custom <- tryCatch( 65 | abort_status(403L, "Custom message"), 66 | reqres_problem = function(c) c 67 | ) 68 | 69 | expect_equal(cnd_custom$message, "Custom message") 70 | }) 71 | 72 | test_that("specific problem abort functions work correctly", { 73 | # Test a few specific abort functions 74 | 75 | # bad request (400) 76 | cnd_400 <- tryCatch( 77 | abort_bad_request("Bad input"), 78 | reqres_problem = function(c) c 79 | ) 80 | expect_equal(cnd_400$status, 400L) 81 | expect_equal(cnd_400$detail, "Bad input") 82 | 83 | # not found (404) 84 | cnd_404 <- tryCatch( 85 | abort_not_found("Resource missing"), 86 | reqres_problem = function(c) c 87 | ) 88 | expect_equal(cnd_404$status, 404L) 89 | expect_equal(cnd_404$detail, "Resource missing") 90 | 91 | # internal error (500) 92 | cnd_500 <- tryCatch( 93 | abort_internal_error("Server crashed"), 94 | reqres_problem = function(c) c 95 | ) 96 | expect_equal(cnd_500$status, 500L) 97 | expect_equal(cnd_500$detail, "Server crashed") 98 | }) 99 | 100 | test_that("handle_problem correctly formats response", { 101 | # Create a mock response object 102 | mock_response <- list( 103 | status_with_text = function(status) { 104 | return(list(type = "status", status = status)) 105 | }, 106 | problem = function(code, detail, title, type, instance) { 107 | return(list( 108 | type = "problem", 109 | status = code, 110 | detail = detail, 111 | title = title, 112 | problem_type = type, 113 | instance = instance 114 | )) 115 | } 116 | ) 117 | class(mock_response) <- "Response" 118 | 119 | # Test handling condition with no detail (simple status) 120 | simple_cnd <- list( 121 | status = 404L, 122 | detail = NULL 123 | ) 124 | class(simple_cnd) <- c("reqres_problem", "error", "condition") 125 | 126 | result_simple <- handle_problem(mock_response, simple_cnd) 127 | expect_equal(result_simple$type, "status") 128 | expect_equal(result_simple$status, 404L) 129 | 130 | # Test handling detailed problem 131 | detailed_cnd <- list( 132 | status = 400L, 133 | detail = "Invalid parameters", 134 | title = "Bad Request", 135 | type = "https://example.com/errors/bad-request", 136 | instance = "error-5678" 137 | ) 138 | class(detailed_cnd) <- c("reqres_problem", "error", "condition") 139 | 140 | result_detailed <- handle_problem(mock_response, detailed_cnd) 141 | expect_equal(result_detailed$type, "problem") 142 | expect_equal(result_detailed$status, 400L) 143 | expect_equal(result_detailed$detail, "Invalid parameters") 144 | expect_equal(result_detailed$title, "Bad Request") 145 | expect_equal(result_detailed$problem_type, "https://example.com/errors/bad-request") 146 | expect_equal(result_detailed$instance, "error-5678") 147 | }) 148 | 149 | test_that("is_reqres_problem correctly identifies problem conditions", { 150 | # Create a problem condition 151 | problem_cnd <- structure( 152 | list(message = "Not Found", status = 404L), 153 | class = c("reqres_problem", "error", "condition") 154 | ) 155 | 156 | # Create a regular error condition 157 | regular_error <- simpleError("Regular error") 158 | 159 | # Test identification 160 | expect_true(is_reqres_problem(problem_cnd)) 161 | expect_false(is_reqres_problem(regular_error)) 162 | expect_false(is_reqres_problem("not a condition")) 163 | }) -------------------------------------------------------------------------------- /tests/testthat/test-request.R: -------------------------------------------------------------------------------- 1 | headers <- list( 2 | Content_Type = 'application/json', 3 | Date = 'Wed, 21 Oct 2015 07:28:00 GMT', 4 | Accept = 'application/json, application/xml; q=0.5, text/*; q=0.3', 5 | Accept_Encoding = 'gzip, br', 6 | Cookie = 'id=Thomas; key=123', 7 | X_Forwarded_For = '500.0.0.0, 400.0.0.0', 8 | X_Forwarded_Host = 'www.example.com:80', 9 | X_Forwarded_Proto = 'https', 10 | X_Custom_Message = '"Testing string literals, with comma", no-literal' 11 | ) 12 | body <- '{"name":["Thomas Lin Pedersen"],"age":[31],"homepage":["www.data-imaginist.com","www.github.com/thomasp85"]}' 13 | rook <- fiery::fake_request( 14 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 15 | content = body, 16 | headers = headers, 17 | REMOTE_ADDR = '230.45.12.45' 18 | ) 19 | 20 | test_that('request gets created correctly', { 21 | req <- Request$new(rook) 22 | expect_null(req$body) 23 | expect_equal(req$host, "127.0.0.1:80") 24 | expect_false(req$trust) 25 | expect_equal(req$method, 'get') 26 | expect_equal(req$cookies, list(id = 'Thomas', key = '123')) 27 | expect_named(req$headers, tolower(sort(names(headers)))) 28 | expect_length(req$headers$accept, 3) 29 | expect_equal(req$headers$content_type, 'application/json') 30 | expect_equal(req$ip, '230.45.12.45') 31 | expect_equal(req$ips, character(0)) 32 | expect_equal(req$protocol, 'http') 33 | expect_equal(req$root, '') 34 | expect_equal(req$path, '/summary') 35 | expect_equal(req$url, 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen') 36 | expect_equal(req$query, list(id = "2347", user = 'Thomas Lin Pedersen')) 37 | expect_false(req$xhr) 38 | expect_false(req$secure) 39 | expect_identical(req$origin, rook) 40 | expect_null(req$response) 41 | expect_snapshot(print(req)) 42 | }) 43 | 44 | test_that('trust works', { 45 | req <- Request$new(rook) 46 | expect_false(req$trust) 47 | expect_snapshot(req$trust <- 'test', error = TRUE) 48 | req$trust <- TRUE 49 | expect_true(req$trust) 50 | expect_equal(req$host, 'www.example.com:80') 51 | expect_equal(req$protocol, 'https') 52 | expect_true(req$secure) 53 | expect_equal(req$ip, '500.0.0.0') 54 | expect_equal(req$ips, c('500.0.0.0', '400.0.0.0')) 55 | }) 56 | 57 | test_that('header parsing works', { 58 | req <- Request$new(rook) 59 | expect_equal(req$get_header('Content-Type'), headers$Content_Type) 60 | expect_equal(req$get_header('Date'), headers$Date) 61 | expect_equal(req$get_header('X-Custom-Message'), c("\"Testing string literals, with comma\"", "no-literal")) 62 | }) 63 | 64 | test_that('response can be generated', { 65 | req <- Request$new(rook) 66 | res <- req$respond() 67 | expect_identical(req$response, res) 68 | req2 <- Request$new(rook) 69 | res2 <- req2$respond() 70 | expect_snapshot(req$response <- res2, error = TRUE) 71 | }) 72 | 73 | test_that('content type can be queried', { 74 | req <- Request$new(rook) 75 | expect_true(req$is('json')) 76 | expect_true(req$is('application/json')) 77 | expect_true(req$is('application/*')) 78 | expect_true(req$is('*/json')) 79 | expect_true(req$is('*')) 80 | expect_false(req$is('application')) 81 | expect_false(req$is('text')) 82 | }) 83 | 84 | test_that('body can be parsed', { 85 | req <- Request$new(rook) 86 | expect_true(req$parse(json = parse_json())) 87 | expect_equal(req$body, jsonlite::fromJSON(body)) 88 | req <- Request$new(rook) 89 | res <- req$respond() 90 | expect_snapshot(req$parse(xml = parse_xml()), error = TRUE) 91 | req <- Request$new(rook) 92 | res <- req$respond() 93 | expect_false(req$parse(xml = parse_xml(), autofail = FALSE)) 94 | expect_equal(res$status, 404L) 95 | req <- Request$new(rook) 96 | res <- req$respond() 97 | expect_true(req$parse_raw()) 98 | expect_equal(req$body, charToRaw(paste0(body, '\n'))) 99 | 100 | rook2 <- fiery::fake_request( 101 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 102 | content = brotli::brotli_compress(charToRaw(body)), 103 | headers = c(headers, list(Content_Encoding = 'br')) 104 | ) 105 | req <- Request$new(rook2) 106 | expect_true(req$parse(json = parse_json())) 107 | expect_equal(req$body, jsonlite::fromJSON(body)) 108 | 109 | rook2 <- fiery::fake_request( 110 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 111 | content = memCompress(charToRaw(body)), 112 | headers = c(headers, list(Content_Encoding = 'deflate')) 113 | ) 114 | req <- Request$new(rook2) 115 | expect_true(req$parse(json = parse_json())) 116 | expect_equal(req$body, jsonlite::fromJSON(body)) 117 | 118 | rook2 <- fiery::fake_request( 119 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 120 | content = gzip(charToRaw(body)), 121 | headers = c(headers, list(Content_Encoding = 'gzip')) 122 | ) 123 | req <- Request$new(rook2) 124 | expect_true(req$parse(json = parse_json())) 125 | expect_equal(req$body, jsonlite::fromJSON(body)) 126 | }) 127 | 128 | test_that('accept negotiation works', { 129 | req <- Request$new(rook) 130 | expect_null(req$accepts('application/zip')) 131 | expect_equal(req$accepts(names(default_formatters)), 'application/json') 132 | expect_equal(req$accepts_encoding(c('deflate', 'zip')), 'identity') 133 | expect_equal(req$accepts_encoding(c('gzip', 'br')), 'gzip') 134 | }) 135 | 136 | test_that("encode and decode works", { 137 | test_string <- "This is a test string for testing" 138 | 139 | # No key 140 | req <- Request$new(rook) 141 | encoded <- req$encode_string(test_string) 142 | expect_equal(req$decode_string(encoded), test_string) 143 | 144 | # With key 145 | req <- Request$new(rook, key = random_key()) 146 | encoded_key <- req$encode_string(test_string) 147 | expect_equal(req$decode_string(encoded_key), test_string) 148 | 149 | expect_true(encoded != encoded_key) 150 | }) 151 | 152 | test_that("has_header works correctly", { 153 | headers <- list( 154 | Content_Type = 'application/json', 155 | Accept = 'application/json' 156 | ) 157 | rook <- fiery::fake_request( 158 | url = 'http://127.0.0.1:80/test', 159 | content = '{"name":"test"}', 160 | headers = headers 161 | ) 162 | 163 | req <- Request$new(rook) 164 | 165 | expect_true(req$has_header("Content-Type")) 166 | expect_true(req$has_header("Accept")) 167 | expect_false(req$has_header("X-Custom-Header")) 168 | }) 169 | 170 | test_that("accepts_charsets works correctly", { 171 | rook <- fiery::fake_request( 172 | url = 'http://127.0.0.1:80/test', 173 | headers = list( 174 | Accept_Charset = 'utf-8, iso-8859-1;q=0.5' 175 | ) 176 | ) 177 | 178 | req <- Request$new(rook) 179 | 180 | expect_equal(req$accepts_charsets(c("utf-8", "iso-8859-1")), "utf-8") 181 | expect_equal(req$accepts_charsets(c("iso-8859-1", "ascii")), "iso-8859-1") 182 | expect_null(req$accepts_charsets(character(0))) 183 | }) 184 | 185 | test_that("accepts_language works correctly", { 186 | 187 | rook <- fiery::fake_request( 188 | url = 'http://127.0.0.1:80/test', 189 | headers = list( 190 | Accept_Language = 'en-US, fr-FR;q=0.8, de;q=0.5' 191 | ) 192 | ) 193 | 194 | req <- Request$new(rook) 195 | 196 | expect_equal(req$accepts_language(c("en-US", "fr-FR")), "en-US") 197 | expect_equal(req$accepts_language(c("fr-FR", "de")), "fr-FR") 198 | expect_equal(req$accepts_language(c("en", "fr")), "en") # Matches main language part 199 | expect_null(req$accepts_language(c("es", "it"))) # No match 200 | }) 201 | 202 | test_that("encode_string and decode_string work correctly without key", { 203 | rook <- fiery::fake_request('http://example.com') 204 | req <- Request$new(rook) 205 | 206 | test_string <- "This is a test string" 207 | encoded <- req$encode_string(test_string) 208 | decoded <- req$decode_string(encoded) 209 | 210 | expect_equal(decoded, test_string) 211 | expect_true(nchar(encoded) > 0) 212 | expect_false(encoded == test_string) 213 | 214 | # Test empty string handling 215 | expect_equal(req$encode_string(""), "") 216 | expect_equal(req$decode_string(""), "") 217 | }) 218 | 219 | test_that("encode_string and decode_string work with key", { 220 | skip_if_not_installed("sodium") 221 | 222 | # Generate a random key for testing 223 | key <- sodium::bin2hex(sodium::random(32)) 224 | 225 | rook <- fiery::fake_request('http://example.com') 226 | req <- Request$new(rook, key = key) 227 | 228 | test_string <- "This is a test string" 229 | encoded <- req$encode_string(test_string) 230 | decoded <- req$decode_string(encoded) 231 | 232 | expect_equal(decoded, test_string) 233 | expect_true(grepl("_", encoded)) # Should contain the delimiter for nonce 234 | }) 235 | 236 | test_that("query_delim setter works correctly", { 237 | rook <- fiery::fake_request( 238 | url = 'http://example.com/test?items=1,2,3' 239 | ) 240 | 241 | req <- Request$new(rook) 242 | expect_null(req$query_delim) 243 | expect_equal(req$query$items, "1,2,3") 244 | 245 | # Set delimiter and verify query is re-parsed 246 | req$query_delim <- "," 247 | expect_equal(req$query$items, c("1", "2", "3")) 248 | 249 | # Change delimiter 250 | req$query_delim <- "|" 251 | expect_equal(req$query$items, "1,2,3") # Back to original since delimiter doesn't match 252 | }) 253 | 254 | test_that("clear works correctly", { 255 | rook <- fiery::fake_request( 256 | url = 'http://127.0.0.1:80/test?id=123', 257 | content = '{"name":"test"}', 258 | headers = list(Content_Type = "application/json") 259 | ) 260 | 261 | req <- Request$new(rook) 262 | 263 | # Modify some properties 264 | req$parse(json = parse_json()) 265 | expect_equal(req$body$name, "test") 266 | 267 | # Reset the request 268 | req$clear() 269 | 270 | # Verify the reset worked 271 | expect_null(req$body) 272 | 273 | req$initialize(rook) 274 | # Verify that we can parse again 275 | req$parse(json = parse_json()) 276 | expect_equal(req$body$name, "test") 277 | }) 278 | 279 | test_that("as.Request and is.Request work correctly", { 280 | rook <- fiery::fake_request('http://example.com') 281 | 282 | # Test coercion from rook environment 283 | req1 <- as.Request(rook) 284 | expect_true(is.Request(req1)) 285 | 286 | # Test that coercion from Request is identity 287 | req2 <- as.Request(req1) 288 | expect_identical(req1, req2) 289 | 290 | # Test non-Request object 291 | expect_false(is.Request(list())) 292 | 293 | # Test error on non-Rook environment 294 | non_rook_env <- new.env() 295 | expect_snapshot(as.Request(non_rook_env), error = TRUE) 296 | }) 297 | 298 | test_that("as_message prints request details correctly", { 299 | headers <- list( 300 | Content_Type = 'application/json', 301 | Accept = 'application/json' 302 | ) 303 | rook <- fiery::fake_request( 304 | url = 'http://127.0.0.1:80/test?id=123', 305 | content = '{"name":"test"}', 306 | headers = headers 307 | ) 308 | 309 | req <- Request$new(rook) 310 | 311 | # Capture output from as_message 312 | output <- capture.output(req$as_message()) 313 | 314 | # Check for expected elements in the output 315 | expect_match(output[1], "GET /test?id=123 HTTP/1.1", fixed = TRUE) 316 | expect_match(paste(output, collapse = "\n"), "Content-Type: application/json", fixed = TRUE) 317 | expect_match(paste(output, collapse = "\n"), "Accept: application/json", fixed = TRUE) 318 | }) 319 | 320 | test_that("parse_raw handles compressed content", { 321 | json_content <- '{"name":"test"}' 322 | 323 | # Create request with gzip compression 324 | gzip_content <- gzip(charToRaw(json_content)) 325 | rook_gzip <- fiery::fake_request( 326 | url = 'http://127.0.0.1:80/test', 327 | content = gzip_content, 328 | headers = list( 329 | Content_Type = 'application/json', 330 | Content_Encoding = 'gzip' 331 | ) 332 | ) 333 | 334 | req_gzip <- Request$new(rook_gzip) 335 | expect_true(req_gzip$parse_raw()) 336 | expect_equal(rawToChar(req_gzip$body), json_content) 337 | 338 | # Create request with deflate compression 339 | deflate_content <- memCompress(charToRaw(json_content)) 340 | rook_deflate <- fiery::fake_request( 341 | url = 'http://127.0.0.1:80/test', 342 | content = deflate_content, 343 | headers = list( 344 | Content_Type = 'application/json', 345 | Content_Encoding = 'deflate' 346 | ) 347 | ) 348 | 349 | req_deflate <- Request$new(rook_deflate) 350 | expect_true(req_deflate$parse_raw()) 351 | expect_equal(rawToChar(req_deflate$body), json_content) 352 | }) 353 | 354 | test_that("get_charset_spec works correctly", { 355 | # Create a request object 356 | rook <- fiery::fake_request('http://example.com') 357 | req <- Request$new(rook) 358 | 359 | # Access the private function using the ::: operator 360 | # Note: In a real test, you'd need to expose this function or test it indirectly 361 | # Here we're showing the test as if you had access to the private function 362 | 363 | # Create a mock accept charsets data frame 364 | accepts <- data.frame( 365 | full = c("utf-8;q=1.0", "iso-8859-1;q=0.8", "*;q=0.5"), 366 | main = c("utf-8", "iso-8859-1", "*"), 367 | q = c(1.0, 0.8, 0.5), 368 | stringsAsFactors = FALSE 369 | ) 370 | 371 | # Test exact match 372 | result <- get_charset_spec(c("utf-8", "iso-8859-1"), accepts) 373 | expect_equal(result, 1) # utf-8 should be preferred 374 | 375 | # Test wildcard match 376 | result <- get_charset_spec("utf-16", accepts) 377 | expect_equal(result, 1) # Should match * with index 1 (first in the input) 378 | 379 | # Test no match 380 | result <- get_charset_spec(character(0), accepts) 381 | expect_null(result) 382 | }) 383 | -------------------------------------------------------------------------------- /tests/testthat/test-response.R: -------------------------------------------------------------------------------- 1 | headers <- list( 2 | Content_Type = 'application/json', 3 | Accept = 'application/json, application/xml; q=0.5, text/*; q=0.3', 4 | Accept_Encoding = 'gzip, br', 5 | Cookie = 'id=Thomas; key=123', 6 | X_Forwarded_For = '500.0.0.0, 400.0.0.0', 7 | X_Forwarded_Host = 'www.example.com:80', 8 | X_Forwarded_Proto = 'https' 9 | ) 10 | body <- '{"name":["Thomas Lin Pedersen"],"age":[31],"homepage":["www.data-imaginist.com","www.github.com/thomasp85"]}' 11 | rook <- fiery::fake_request( 12 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 13 | content = body, 14 | headers = headers, 15 | REMOTE_ADDR = '230.45.12.45' 16 | ) 17 | 18 | test_that('response are created correctly', { 19 | req <- Request$new(rook) 20 | res <- Response$new(req) 21 | expect_identical(req$response, res) 22 | expect_identical(res$request, req) 23 | expect_snapshot(Response$new(req), error = TRUE) 24 | 25 | expect_equal(res$status, 404L) 26 | expect_identical(res$body, '') 27 | expect_identical(res$type, 'text/plain') 28 | }) 29 | 30 | test_that('headers can be get, set, appended, and removed', { 31 | req <- Request$new(rook) 32 | res <- Response$new(req) 33 | expect_true(res$has_header('Content-Type')) 34 | expect_false(res$has_header('Date')) 35 | expect_null(res$get_header('Date')) 36 | 37 | time <- Sys.time() 38 | res$set_header('Date', to_http_date(time)) 39 | expect_true(res$has_header('Date')) 40 | expect_equal(res$get_header('Date'), to_http_date(time)) 41 | res$remove_header('Date') 42 | expect_false(res$has_header('Date')) 43 | expect_null(res$get_header('Date')) 44 | 45 | res$append_header('Content-Encoding', 'gzip') 46 | expect_equal(res$get_header('Content-Encoding'), 'gzip') 47 | res$append_header('Content-Encoding', 'br') 48 | 49 | expect_equal(res$get_header('Content-Encoding'), c('gzip', 'br')) 50 | }) 51 | 52 | test_that('data can be get, set, and removed', { 53 | req <- Request$new(rook) 54 | res <- Response$new(req) 55 | 56 | expect_false(res$has_data('test')) 57 | expect_null(res$get_data('test')) 58 | res$set_data('test', letters) 59 | expect_true(res$has_data('test')) 60 | expect_equal(res$get_data('test'), letters) 61 | res$remove_data('test') 62 | expect_false(res$has_data('test')) 63 | expect_null(res$get_data('test')) 64 | }) 65 | 66 | test_that('cookies can be get, set, and removed', { 67 | req <- Request$new(rook) 68 | res <- Response$new(req) 69 | 70 | expect_false(res$has_cookie('test')) 71 | 72 | exp <- Sys.Date() + 1000 73 | res$set_cookie('test', 'this is a test', TRUE, expires = exp, http_only = TRUE, max_age = 1000, path = '/test', secure = TRUE, same_site = 'Lax') 74 | expect_true(res$has_cookie('test')) 75 | expect_equal(res$as_list()$headers[['set-cookie']], paste0('test=this%20is%20a%20test; Expires=', to_http_date(exp), '; HttpOnly; Max-Age=1000; Path=/test; Secure; SameSite=Lax')) 76 | res$remove_cookie('test') 77 | expect_false(res$has_cookie('test')) 78 | }) 79 | 80 | test_that('special header method works', { 81 | req <- Request$new(rook) 82 | res <- Response$new(req) 83 | 84 | time <- Sys.time() 85 | res$timestamp() 86 | res$has_header('Date') 87 | expect_equal(res$get_header('Date'), to_http_date(time)) 88 | 89 | res$set_links(alternate = '/feed') 90 | res$has_header('Link') 91 | expect_equal(res$get_header('Link'), "; rel=\"alternate\"") 92 | }) 93 | 94 | test_that('files are added correctly', { 95 | req <- Request$new(rook) 96 | res <- Response$new(req) 97 | file <- system.file('DESCRIPTION', package = 'reqres') 98 | 99 | expect_snapshot(res$file <- "not_a_real_file", error = TRUE) 100 | res$file <- file 101 | expect_equal(res$body, c(file = file)) 102 | expect_equal(res$type, 'text/plain') 103 | expect_equal(res$get_header('Last-Modified'), to_http_date(file.mtime(file))) 104 | res$attach(file) 105 | expect_equal(res$get_header('Content-Disposition'), "attachment; filename=\"DESCRIPTION\"") 106 | 107 | expect_equal(res$as_list()$body, c(file = file)) 108 | }) 109 | 110 | test_that('status text are added', { 111 | req <- Request$new(rook) 112 | res <- Response$new(req) 113 | 114 | res$status_with_text(416L) 115 | expect_equal(res$body, 'Range Not Satisfiable') 116 | }) 117 | 118 | test_that('print functino works', { 119 | req <- Request$new(rook) 120 | res <- Response$new(req) 121 | 122 | expect_snapshot(res$print()) 123 | }) 124 | 125 | test_that('body formatting works', { 126 | req <- Request$new(rook) 127 | res <- Response$new(req) 128 | body <- list(lower = letters, upper = LETTERS) 129 | res$body <- body 130 | expect_false(res$format('zip' = function(x) x, autofail = FALSE)) 131 | expect_true(res$format(!!!default_formatters, compress = FALSE)) 132 | expect_equal(res$body, jsonlite::toJSON(body)) 133 | 134 | rook2 <- fiery::fake_request( 135 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 136 | content = '', 137 | headers = modifyList(headers, list(Accept_Encoding = 'gzip')) 138 | ) 139 | req <- Request$new(rook2) 140 | res <- Response$new(req) 141 | res$body <- body 142 | expect_true(res$format(!!!default_formatters)) 143 | expect_equal(res$body, gzip(charToRaw(jsonlite::toJSON(body)))) 144 | 145 | rook2 <- fiery::fake_request( 146 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 147 | content = '', 148 | headers = modifyList(headers, list(Accept_Encoding = 'br')) 149 | ) 150 | req <- Request$new(rook2) 151 | res <- Response$new(req) 152 | res$body <- body 153 | expect_true(res$format(!!!default_formatters)) 154 | expect_equal(res$body, brotli::brotli_compress(charToRaw(jsonlite::toJSON(body)))) 155 | 156 | rook2 <- fiery::fake_request( 157 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 158 | content = '', 159 | headers = modifyList(headers, list(Accept_Encoding = 'deflate')) 160 | ) 161 | req <- Request$new(rook2) 162 | res <- Response$new(req) 163 | res$body <- body 164 | expect_true(res$format(!!!default_formatters)) 165 | expect_equal(res$body, memCompress(charToRaw(jsonlite::toJSON(body)))) 166 | }) 167 | 168 | test_that("attach works correctly", { 169 | # Create a request/response pair 170 | rook <- fiery::fake_request('http://example.com') 171 | req <- Request$new(rook) 172 | res <- req$respond() 173 | 174 | # Use attach with a temporary file 175 | temp_file <- tempfile(fileext = ".txt") 176 | writeLines("Test content", temp_file) 177 | on.exit(unlink(temp_file)) 178 | 179 | res$attach(temp_file, filename = "test-file.txt") 180 | 181 | # Check content disposition and type 182 | expect_equal(res$get_header("Content-Disposition"), 'attachment; filename="test-file.txt"') 183 | expect_equal(res$type, "text/plain") 184 | expect_equal(res$file, file_path_as_absolute(temp_file)) 185 | 186 | # Check with custom type 187 | res$attach(temp_file, filename = "test.dat", type = "application/octet-stream") 188 | expect_equal(res$type, "application/octet-stream") 189 | }) 190 | 191 | test_that("as_download works correctly", { 192 | # Create a request/response pair 193 | rook <- fiery::fake_request('http://example.com') 194 | req <- Request$new(rook) 195 | res <- req$respond() 196 | 197 | # Test without filename 198 | res$as_download() 199 | expect_equal(res$get_header("Content-Disposition"), "attachment") 200 | 201 | # Test with filename 202 | res$as_download(filename = "example.txt") 203 | expect_equal(res$get_header("Content-Disposition"), 'attachment; filename="example.txt"') 204 | }) 205 | 206 | test_that("status_with_text works correctly", { 207 | # Create a request/response pair 208 | rook <- fiery::fake_request('http://example.com') 209 | req <- Request$new(rook) 210 | res <- req$respond() 211 | 212 | # Test with common status code 213 | res$status_with_text(200L) 214 | expect_equal(res$status, 200L) 215 | expect_equal(res$body, "OK") 216 | expect_equal(res$type, "text/plain") 217 | 218 | # Test with clearing headers 219 | res$set_header("X-Custom", "Value") 220 | res$status_with_text(404L, clear_headers = TRUE) 221 | expect_equal(res$status, 404L) 222 | expect_equal(res$body, "Not Found") 223 | expect_null(res$get_header("X-Custom")) 224 | 225 | # Test with unknown status code 226 | res$status_with_text(599L) 227 | expect_equal(res$status, 599L) 228 | expect_equal(res$body, "599") # Uses code as text for unknown status 229 | }) 230 | 231 | test_that("problem creates HTTP problem response", { 232 | # Create a request/response pair 233 | rook <- fiery::fake_request( 234 | 'http://example.com', 235 | headers = list(Accept = 'application/json') 236 | ) 237 | req <- Request$new(rook) 238 | res <- req$respond() 239 | 240 | # Create a problem response 241 | res$problem( 242 | code = 400L, 243 | detail = "Invalid input parameter", 244 | title = "Bad Request", 245 | type = "https://example.com/errors/bad-request", 246 | instance = "error-12345" 247 | ) 248 | 249 | # Check response properties 250 | expect_equal(res$status, 400L) 251 | expect_equal(res$type, "application/problem+json") 252 | 253 | # Check body structure 254 | body <- fromJSON(res$body) 255 | expect_type(body, "list") 256 | expect_equal(body$status, 400L) 257 | expect_equal(body$detail, "Invalid input parameter") 258 | expect_equal(body$title, "Bad Request") 259 | expect_equal(body$type, "https://example.com/errors/bad-request") 260 | expect_equal(body$instance, "error-12345") 261 | 262 | # Test with minimal parameters (using defaults) 263 | res$reset() 264 | res$problem(404L, "Resource not found") 265 | expect_equal(res$status, 404L) 266 | body <- fromJSON(res$body) 267 | expect_equal(body$detail, "Resource not found") 268 | expect_equal(body$title, "Not Found") 269 | expect_equal(body$type, "https://datatracker.ietf.org/doc/html/rfc9110#section-15.5.5") 270 | }) 271 | 272 | test_that("set_cookie and cookie management works correctly", { 273 | # Create a request/response pair 274 | rook <- fiery::fake_request('http://example.com', headers = list(Cookies = "to_clear=value")) 275 | req <- Request$new(rook) 276 | res <- req$respond() 277 | 278 | # Set a basic cookie 279 | res$set_cookie("simple", "value") 280 | expect_true(res$has_cookie("simple")) 281 | 282 | # Set a cookie with options 283 | res$set_cookie( 284 | name = "complex", 285 | value = "test", 286 | path = "/app", 287 | secure = TRUE, 288 | http_only = TRUE, 289 | max_age = 3600 290 | ) 291 | expect_true(res$has_cookie("complex")) 292 | 293 | # Remove a cookie 294 | res$remove_cookie("simple") 295 | expect_false(res$has_cookie("simple")) 296 | 297 | # Clear a cookie (asks client to delete it) 298 | res$clear_cookie("to_clear") 299 | expect_true(res$has_cookie("to_clear")) 300 | 301 | # Test automatic secure flag for secure-prefixed cookies 302 | res$set_cookie("__Secure-auto", "value") 303 | cookies_list <- as.list(res)$headers 304 | secure_cookie_header <- cookies_list[names(cookies_list) == "set-cookie" & 305 | grepl("__Secure-auto", cookies_list)] 306 | expect_match(secure_cookie_header[[1]], "; Secure") 307 | }) 308 | 309 | test_that("set_links works correctly", { 310 | # Create a request/response pair 311 | rook <- fiery::fake_request('http://example.com') 312 | req <- Request$new(rook) 313 | res <- req$respond() 314 | 315 | # Set links 316 | res$set_links( 317 | `next` = "https://example.com/page/2", 318 | prev = "https://example.com/page/0" 319 | ) 320 | 321 | # Check link header 322 | link_header <- res$get_header("Link") 323 | expect_match(link_header, "; rel=\"next\"") 324 | expect_match(link_header, "; rel=\"prev\"") 325 | }) 326 | 327 | test_that("format works correctly with content negotiation", { 328 | # Create request with specific Accept header 329 | json_rook <- fiery::fake_request( 330 | 'http://example.com', 331 | headers = list(Accept = 'application/json') 332 | ) 333 | json_req <- Request$new(json_rook) 334 | json_res <- json_req$respond() 335 | 336 | # Test data 337 | test_data <- list(name = "John", age = 30) 338 | json_res$body <- test_data 339 | 340 | # Format using content negotiation 341 | result <- json_res$format( 342 | json = format_json(), 343 | xml = format_xml(), 344 | html = format_html() 345 | ) 346 | 347 | expect_true(result) 348 | expect_equal(json_res$type, "application/json") 349 | expect_equal(unclass(json_res$body), '{"name":["John"],"age":[30]}') 350 | 351 | # Create request preferring XML 352 | xml_rook <- fiery::fake_request( 353 | 'http://example.com', 354 | headers = list(Accept = 'application/xml, application/json;q=0.8') 355 | ) 356 | xml_req <- Request$new(xml_rook) 357 | xml_res <- xml_req$respond() 358 | 359 | # Format with same options 360 | xml_res$body <- test_data 361 | xml_res$format( 362 | json = format_json(), 363 | xml = format_xml(), 364 | html = format_html() 365 | ) 366 | 367 | expect_equal(xml_res$type, "application/xml") 368 | expect_match(xml_res$body, "John") 369 | 370 | # Test with default formatter when no match 371 | no_match_rook <- fiery::fake_request( 372 | 'http://example.com', 373 | headers = list(Accept = 'text/plain') 374 | ) 375 | no_match_req <- Request$new(no_match_rook) 376 | no_match_res <- no_match_req$respond() 377 | 378 | no_match_res$body <- test_data 379 | no_match_res$format( 380 | json = format_json(), 381 | xml = format_xml(), 382 | default = "json" 383 | ) 384 | 385 | expect_equal(no_match_res$type, "application/json") 386 | }) 387 | 388 | test_that("set_formatter works correctly", { 389 | # Create request with specific Accept header 390 | rook <- fiery::fake_request( 391 | 'http://example.com', 392 | headers = list(Accept = 'application/json') 393 | ) 394 | req <- Request$new(rook) 395 | res <- req$respond() 396 | 397 | # Set formatter 398 | result <- res$set_formatter( 399 | json = format_json(), 400 | xml = format_xml() 401 | ) 402 | 403 | expect_true(result) 404 | expect_equal(res$type, "application/json") 405 | expect_type(res$formatter, "closure") 406 | 407 | # Test with no matching formatter and no default 408 | no_match_rook <- fiery::fake_request( 409 | 'http://example.com', 410 | headers = list(Accept = 'text/plain') 411 | ) 412 | no_match_req <- Request$new(no_match_rook) 413 | no_match_res <- no_match_req$respond() 414 | 415 | expect_snapshot( 416 | no_match_res$set_formatter(json = format_json(), xml = format_xml(), autofail = TRUE), 417 | error = TRUE 418 | ) 419 | 420 | # Test with default formatter 421 | default_result <- no_match_res$set_formatter( 422 | json = format_json(), 423 | xml = format_xml(), 424 | default = "json", 425 | autofail = TRUE 426 | ) 427 | 428 | expect_true(default_result) 429 | expect_equal(no_match_res$type, "application/json") 430 | }) 431 | 432 | test_that("compress works correctly", { 433 | # Skip if brotli not available 434 | skip_if_not_installed("brotli") 435 | 436 | # Create request with gzip accept-encoding 437 | rook <- fiery::fake_request( 438 | 'http://example.com', 439 | headers = list(Accept_Encoding = 'gzip, deflate') 440 | ) 441 | req <- Request$new(rook, compression_limit = 10) # Low threshold for testing 442 | res <- req$respond() 443 | 444 | # Set a compressible type and content 445 | res$type <- "text/plain" 446 | res$body <- "This is a test string that should be compressed" 447 | 448 | # Compress 449 | result <- res$compress() 450 | 451 | expect_true(result) 452 | expect_equal(res$get_header("Content-Encoding"), "gzip") 453 | expect_equal(res$get_header("Vary"), "Accept-Encoding") 454 | expect_true(is.raw(res$body)) 455 | 456 | # Test with uncompressible type 457 | res$type <- "image/jpeg" 458 | res$body <- "Binary data" 459 | 460 | uncompressible_result <- res$compress() 461 | expect_false(uncompressible_result) 462 | 463 | # Test with force=TRUE 464 | force_result <- res$compress(force = TRUE) 465 | expect_true(force_result) 466 | }) 467 | 468 | test_that("content_length works correctly", { 469 | # Create request/response 470 | rook <- fiery::fake_request('http://example.com') 471 | req <- Request$new(rook) 472 | res <- req$respond() 473 | 474 | # Test with string body 475 | test_string <- "Test string" 476 | res$body <- test_string 477 | expect_equal(res$content_length(), nchar(test_string, "bytes")) 478 | 479 | # Test with raw body 480 | raw_data <- charToRaw("Binary data") 481 | res$body <- raw_data 482 | expect_equal(res$content_length(), length(raw_data)) 483 | 484 | # Test with file body 485 | temp_file <- tempfile() 486 | writeLines("File content", temp_file) 487 | on.exit(unlink(temp_file)) 488 | 489 | res$file <- temp_file 490 | expect_equal(res$content_length(), file.size(temp_file)) 491 | }) 492 | 493 | test_that("as_list prepares response correctly", { 494 | # Create request/response 495 | rook <- fiery::fake_request('http://example.com') 496 | req <- Request$new(rook) 497 | res <- req$respond() 498 | 499 | # Set some properties 500 | res$status <- 200L 501 | res$body <- "Test body" 502 | res$set_header("X-Custom", "Value") 503 | 504 | # Get as list 505 | list_response <- res$as_list() 506 | 507 | expect_equal(list_response$status, 200L) 508 | expect_equal(list_response$body, "Test body") 509 | expect_equal(list_response$headers[["content-type"]], "text/plain") 510 | expect_equal(list_response$headers[["x-custom"]], "Value") 511 | expect_true("date" %in% names(list_response$headers)) 512 | 513 | # Test with formatter 514 | res$body <- list(name = "Test") 515 | res$set_formatter(json = format_json()) 516 | 517 | formatted_response <- res$as_list() 518 | expect_equal(formatted_response$body, '{\"name\":[\"Test\"]}') 519 | }) 520 | 521 | test_that("as_message prints response correctly", { 522 | # Create request/response 523 | rook <- fiery::fake_request('http://example.com') 524 | req <- Request$new(rook) 525 | res <- req$respond() 526 | 527 | # Set properties 528 | res$status <- 200L 529 | res$body <- "Test response body" 530 | res$set_header("X-Custom", "Test header") 531 | 532 | # Capture output 533 | output <- capture.output(res$as_message()) 534 | 535 | # Check content 536 | expect_match(output[1], "HTTP/1.1 200 OK", fixed = TRUE) 537 | expect_true(any(grepl("X-Custom: Test header", output))) 538 | expect_true(any(grepl("Content-Length: 18", output))) 539 | expect_true(any(grepl("Test response body", output))) 540 | }) 541 | 542 | test_that("reset clears response state", { 543 | # Create request/response 544 | rook <- fiery::fake_request('http://example.com') 545 | req <- Request$new(rook) 546 | res <- req$respond() 547 | 548 | # Set some state 549 | res$status <- 200L 550 | res$body <- "Test body" 551 | res$set_header("X-Custom", "Value") 552 | res$set_data("test_key", "test_value") 553 | 554 | # Reset 555 | res$reset() 556 | 557 | # Check defaults 558 | expect_equal(res$status, 404L) 559 | expect_equal(res$body, "") 560 | expect_null(res$get_header("X-Custom")) 561 | expect_null(res$get_data("test_key")) 562 | expect_equal(res$type, "text/plain") 563 | }) 564 | 565 | test_that("session management works correctly", { 566 | skip_if_not_installed("sodium") 567 | 568 | # Generate a key for the session cookie 569 | key <- sodium::bin2hex(sodium::random(32)) 570 | 571 | # Create a session cookie settings object 572 | session_cookie_settings <- session_cookie( 573 | name = "test_session", 574 | path = "/app", 575 | secure = TRUE 576 | ) 577 | 578 | # Create request/response 579 | rook <- fiery::fake_request('http://example.com') 580 | req <- Request$new(rook, key = key, session_cookie = session_cookie_settings) 581 | res <- req$respond() 582 | 583 | # Set session data 584 | res$session <- list(user_id = 123, logged_in = TRUE) 585 | 586 | # Check that session is accessible from both request and response 587 | expect_equal(res$session$user_id, 123) 588 | expect_equal(req$session$user_id, 123) 589 | 590 | # Check that session data is included in response headers 591 | list_response <- res$as_list() 592 | session_headers <- list_response$headers[names(list_response$headers) == "set-cookie"] 593 | expect_true(any(grepl("test_session=", session_headers))) 594 | }) 595 | 596 | test_that("data store functions work correctly", { 597 | # Create request/response 598 | rook <- fiery::fake_request('http://example.com') 599 | req <- Request$new(rook) 600 | res <- req$respond() 601 | 602 | # Test set_data and get_data 603 | res$set_data("key1", "value1") 604 | res$set_data("key2", list(a = 1, b = 2)) 605 | 606 | expect_equal(res$get_data("key1"), "value1") 607 | expect_equal(res$get_data("key2"), list(a = 1, b = 2)) 608 | expect_true(res$has_data("key1")) 609 | expect_false(res$has_data("non_existent")) 610 | 611 | # Test remove_data 612 | res$remove_data("key1") 613 | expect_false(res$has_data("key1")) 614 | expect_true(res$has_data("key2")) 615 | 616 | # Test data_store accessor 617 | all_data <- res$data_store 618 | expect_type(all_data, "list") 619 | expect_named(all_data, "key2") 620 | 621 | # Test immutability of data store 622 | expect_snapshot(res$data_store <- list(), error = TRUE) 623 | }) 624 | -------------------------------------------------------------------------------- /tests/testthat/test-session-cookie.R: -------------------------------------------------------------------------------- 1 | headers <- list( 2 | Content_Type = 'application/json', 3 | Date = 'Wed, 21 Oct 2015 07:28:00 GMT', 4 | Accept = 'application/json, application/xml; q=0.5, text/*; q=0.3', 5 | Accept_Encoding = 'gzip, br', 6 | Cookie = 'id=Thomas; key=123', 7 | X_Forwarded_For = '500.0.0.0, 400.0.0.0', 8 | X_Forwarded_Host = 'www.example.com:80', 9 | X_Forwarded_Proto = 'https', 10 | X_Custom_Message = '"Testing string literals, with comma", no-literal' 11 | ) 12 | body <- '{"name":["Thomas Lin Pedersen"],"age":[31],"homepage":["www.data-imaginist.com","www.github.com/thomasp85"]}' 13 | rook <- fiery::fake_request( 14 | url = 'http://127.0.0.1:80/summary?id=2347&user=Thomas+Lin+Pedersen', 15 | content = body, 16 | headers = headers, 17 | REMOTE_ADDR = '230.45.12.45' 18 | ) 19 | 20 | key <- random_key() 21 | session_cookie <- session_cookie() 22 | 23 | test_that("Requests know about session cookies", { 24 | # No session cookie settings 25 | req <- Request$new(rook) 26 | res <- req$respond() 27 | expect_null(req$session_cookie_settings) 28 | expect_null(res$session_cookie_settings) 29 | expect_false(req$has_key) 30 | expect_false(res$has_key) 31 | expect_equal(req$session, list()) 32 | expect_equal(res$session, list()) 33 | expect_false(req$has_session_cookie) 34 | 35 | # Settings but no cookie 36 | req <- Request$new(rook, key = key, session_cookie = session_cookie) 37 | res <- req$respond() 38 | expect_equal(req$session_cookie_settings, session_cookie) 39 | expect_equal(res$session_cookie_settings, session_cookie) 40 | expect_true(req$has_key) 41 | expect_true(res$has_key) 42 | expect_equal(req$session, list()) 43 | expect_equal(res$session, list()) 44 | expect_false(req$has_session_cookie) 45 | 46 | # Adding session cookie to request 47 | session_val <- list(test = 4) 48 | val <- url_encode(req$encode_string(jsonlite::toJSON(session_val))) 49 | old_cookie <- rook$HTTP_COOKIE 50 | rook$HTTP_COOKIE <- paste0(old_cookie, "; ", session_cookie$name, "=", val) 51 | 52 | # Cookie but no settings 53 | req <- Request$new(rook) 54 | res <- req$respond() 55 | expect_null(req$session_cookie_settings) 56 | expect_null(res$session_cookie_settings) 57 | expect_false(req$has_key) 58 | expect_false(res$has_key) 59 | expect_equal(req$session, list()) 60 | expect_equal(res$session, list()) 61 | expect_false(req$has_session_cookie) 62 | 63 | # Cookie and settings 64 | req <- Request$new(rook, key = key, session_cookie = session_cookie) 65 | res <- req$respond() 66 | expect_equal(req$session_cookie_settings, session_cookie) 67 | expect_equal(res$session_cookie_settings, session_cookie) 68 | expect_true(req$has_key) 69 | expect_true(res$has_key) 70 | expect_equal(req$session, session_val) 71 | expect_equal(res$session, session_val) 72 | expect_true(req$has_session_cookie) 73 | 74 | rook$HTTP_COOKIE <- old_cookie 75 | }) 76 | 77 | test_that("Response knows how to handle session cookies", { 78 | # No session cookie settings 79 | req <- Request$new(rook) 80 | res <- req$respond() 81 | 82 | expect_snapshot(res$session$test <- 4) 83 | expect_equal(res$session, list()) 84 | 85 | # Adding session cookie to request 86 | req <- Request$new(rook, key = key, session_cookie = session_cookie) 87 | session_val <- list(test = 4) 88 | val <- url_encode(req$encode_string(jsonlite::toJSON(session_val))) 89 | old_cookie <- rook$HTTP_COOKIE 90 | rook$HTTP_COOKIE <- paste0(old_cookie, "; ", session_cookie$name, "=", val) 91 | 92 | req <- Request$new(rook, key = key, session_cookie = session_cookie) 93 | res <- req$respond() 94 | 95 | set_cookie <- res$as_list()$headers[["set-cookie"]] 96 | 97 | expect_true(grepl(paste0("^", session_cookie$name, "=.*; HttpOnly$"), set_cookie)) 98 | cookie_val <- sub(paste0("^", session_cookie$name, "=(.*); HttpOnly$"), "\\1", set_cookie) 99 | 100 | expect_equal(jsonlite::fromJSON(res$decode_string(url_decode(cookie_val))), res$session) 101 | 102 | res$session$test2 <- "A" 103 | 104 | set_cookie <- res$as_list()$headers[["set-cookie"]] 105 | cookie_val <- sub(paste0("^", session_cookie$name, "=(.*); HttpOnly$"), "\\1", set_cookie) 106 | 107 | expect_equal(jsonlite::fromJSON(res$decode_string(url_decode(cookie_val))), res$session) 108 | 109 | res$session <- NULL 110 | 111 | set_cookie <- res$as_list()$headers[["set-cookie"]] 112 | expect_equal(set_cookie, paste0(session_cookie$name, "=; Expires=Thu, 01 Jan 1970 00:00:00 GMT")) 113 | 114 | rook$HTTP_COOKIE <- old_cookie 115 | }) 116 | --------------------------------------------------------------------------------