├── .editorconfig ├── .github ├── ISSUE_TEMPLATE │ ├── bug-report.md │ ├── change-request.md │ └── config.yml ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── .gitignore ├── .tidyrc.json ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── bower.json ├── docs └── README.md ├── packages.dhall ├── spago.dhall ├── src ├── URI.purs └── URI │ ├── AbsoluteURI.purs │ ├── Authority.purs │ ├── Common.purs │ ├── Extra │ ├── MultiHostPortPair.purs │ ├── QueryPairs.purs │ └── UserPassInfo.purs │ ├── Fragment.purs │ ├── HierarchicalPart.purs │ ├── Host.purs │ ├── Host │ ├── Gen.purs │ ├── IPv4Address.purs │ ├── IPv6Address.purs │ └── RegName.purs │ ├── HostPortPair.purs │ ├── HostPortPair │ └── Gen.purs │ ├── Path.purs │ ├── Path │ ├── Absolute.purs │ ├── NoScheme.purs │ ├── Rootless.purs │ └── Segment.purs │ ├── Port.purs │ ├── Port │ └── Gen.purs │ ├── Query.purs │ ├── RelativePart.purs │ ├── RelativeRef.purs │ ├── Scheme.purs │ ├── Scheme │ └── Common.purs │ ├── URI.purs │ ├── URIRef.purs │ └── UserInfo.purs └── test ├── Main.purs ├── Spec.purs ├── URI ├── AbsoluteURI.purs ├── Authority.purs ├── Extra │ ├── MultiHostPortPair.purs │ ├── QueryPairs.purs │ └── UserPassInfo.purs ├── Fragment.purs ├── Host.purs ├── Path.purs ├── Port.purs ├── Scheme.purs ├── URIRef.purs └── UserInfo.purs └── Util.purs /.editorconfig: -------------------------------------------------------------------------------- 1 | # http://editorconfig.org 2 | root = true 3 | 4 | [*] 5 | indent_style = space 6 | indent_size = 2 7 | end_of_line = lf 8 | charset = utf-8 9 | trim_trailing_whitespace = true 10 | insert_final_newline = true 11 | 12 | [*.md] 13 | trim_trailing_whitespace = false 14 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug-report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Report an issue 4 | title: "" 5 | labels: bug 6 | assignees: "" 7 | --- 8 | 9 | **Describe the bug** 10 | A clear and concise description of the bug. 11 | 12 | **To Reproduce** 13 | A minimal code example (preferably a runnable example on [Try PureScript](https://try.purescript.org)!) or steps to reproduce the issue. 14 | 15 | **Expected behavior** 16 | A clear and concise description of what you expected to happen. 17 | 18 | **Additional context** 19 | Add any other context about the problem here. 20 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/change-request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Change request 3 | about: Propose an improvement to this library 4 | title: "" 5 | labels: "" 6 | assignees: "" 7 | --- 8 | 9 | **Is your change request related to a problem? Please describe.** 10 | A clear and concise description of the problem. 11 | 12 | Examples: 13 | 14 | - It's frustrating to have to [...] 15 | - I was looking for a function to [...] 16 | 17 | **Describe the solution you'd like** 18 | A clear and concise description of what a good solution to you looks like, including any solutions you've already considered. 19 | 20 | **Additional context** 21 | Add any other context about the change request here. 22 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/config.yml: -------------------------------------------------------------------------------- 1 | blank_issues_enabled: false 2 | contact_links: 3 | - name: PureScript Discourse 4 | url: https://discourse.purescript.org/ 5 | about: Ask and answer questions on the PureScript discussion forum. 6 | - name: PureScript Discord 7 | url: https://purescript.org/chat 8 | about: Ask and answer questions on the PureScript chat. 9 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. 3 | 4 | --- 5 | 6 | **Checklist:** 7 | 8 | - [ ] Added the change to the changelog's "Unreleased" section with a link to this PR and your username 9 | - [ ] Linked any existing issues or proposals that this pull request should close 10 | - [ ] Updated or added relevant documentation in the README and/or documentation directory 11 | - [ ] Added a test for the contribution (if applicable) 12 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | 13 | steps: 14 | - uses: actions/checkout@v2 15 | 16 | - name: Set up a PureScript toolchain 17 | uses: purescript-contrib/setup-purescript@main 18 | with: 19 | purescript: "unstable" 20 | purs-tidy: "latest" 21 | 22 | - name: Cache PureScript dependencies 23 | uses: actions/cache@v2 24 | with: 25 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}-2 26 | path: | 27 | .spago 28 | output 29 | 30 | - name: Install dependencies 31 | run: spago install 32 | 33 | - name: Build source 34 | run: spago build --no-install --purs-args '--censor-lib --strict' 35 | 36 | - name: Run tests 37 | run: spago test --no-install 38 | 39 | - name: Check formatting 40 | run: purs-tidy check src test 41 | 42 | - name: Verify Bower & Pulp 43 | run: | 44 | npm install bower pulp@16.0.0-0 45 | npx bower install 46 | npx pulp build -- --censor-lib --strict 47 | if [ -d "test" ]; then 48 | npx pulp test 49 | fi 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .* 2 | !.gitignore 3 | !.github 4 | !.editorconfig 5 | !.tidyrc.json 6 | 7 | output 8 | generated-docs 9 | bower_components 10 | node_modules 11 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importSort": "source", 3 | "importWrap": "source", 4 | "indent": 2, 5 | "operatorsFile": null, 6 | "ribbon": 1, 7 | "typeArrowPlacement": "first", 8 | "unicode": "never", 9 | "width": null 10 | } 11 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | 15 | ## [v9.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v9.0.0) - 2022-04-28 16 | 17 | Breaking changes: 18 | - Update project and deps to PureScript v0.15.0 (#70 by @JordanMartinez) 19 | 20 | New features: 21 | 22 | Bugfixes: 23 | - Made all parsers stack safe on long input (#63 by @garyb) 24 | - Exceptions are no longer thrown when using e.g. `valueFromString` with lone surrogates (#68 by @ysangkok) 25 | 26 | Other improvements: 27 | - Added `purs-tidy` formatter (#66 by @thomashoneyman) 28 | - Update README.md rfc link (#67 @codingedgar) 29 | 30 | ## [v8.0.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v8.0.1) - 2021-05-06 31 | 32 | Other improvements: 33 | - Fix warnings revealed by v0.14.1 PS release (#61 by @JordanMartinez) 34 | - Install missing dependencies used in source code (#61 by @JordanMartinez) 35 | 36 | ## [v8.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v8.0.0) - 2021-02-26 37 | 38 | Breaking changes: 39 | - Added support for PureScript 0.14 and dropped support for all previous versions (#57, #58) 40 | 41 | Other improvements: 42 | - Replaced 'id' with 'identity' in documentation (#52) 43 | - Changed default branch to `main` from `master` 44 | - Updated to comply with Contributors library guidelines by adding new issue and pull request templates, updating documentation, and migrating to Spago for local development and CI (#53, #55, #56, #39) 45 | 46 | ## [v7.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v7.0.0) - 2019-03-18 47 | 48 | - Updated dependencies 49 | 50 | ## [v6.1.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v6.1.0) - 2019-02-07 51 | 52 | - Raised upper boundary on `purescript-profunctor-lenses` dependency (@athanclark) 53 | 54 | ## [v6.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v6.0.0) - 2018-06-29 55 | 56 | - Updated for PureScript 0.12 57 | 58 | ## [v5.1.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v5.1.0) - 2018-03-20 59 | 60 | - Added Scheme.toString (#44, @safareli) 61 | 62 | ## [v5.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v5.0.0) - 2018-03-20 63 | 64 | - Completely redesigned to fix some problems with the previous representations, and to add flexibility in dealing with customised URI formats. See the README for more information. 65 | 66 | ## [v4.2.4](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.2.4) - 2018-01-26 67 | 68 | - Fixed `userInfo` encoding/decoding (#42, @safareli) 69 | Some Chars were not correctly encoded and decoded, `@` for example. 70 | 71 | ## [v4.2.3](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.2.3) - 2018-01-04 72 | 73 | - Fixed parsing to allow hostnames to start with numbers #39 74 | 75 | ## [v4.2.2](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.2.2) - 2017-11-22 76 | 77 | - Fixed Pursuit docs 78 | 79 | ## [v4.2.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.2.1) - 2017-11-08 80 | 81 | - Fixed query key and value encoding to percent-encode `=` 82 | 83 | ## [v4.2.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.2.0) - 2017-10-06 84 | 85 | - Each module now re-exports all types and lenses that are relevant to it, aside from `URIRef` since it would have conflicting lenses for relative vs hierarchical parts. 86 | 87 | ## [v4.1.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.1.1) - 2017-10-06 88 | 89 | - Fixed some parsing behaviour so now URIs like `/page.htm` and `../page.htm` will parse 90 | - Query, fragment, scheme, and authority parsers/printers now consistently include `?`, `#`, `:` and `//` in both directions 91 | 92 | ## [v4.1.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.1.0) - 2017-10-03 93 | 94 | - Added lenses 95 | 96 | ## [v4.0.2](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.0.2) - 2017-10-03 97 | 98 | - Fixed encoding/decoding of `;` and `&` within query parts #29 99 | 100 | ## [v4.0.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.0.1) - 2017-09-25 101 | 102 | - Removed unnecessary FFI usage (@joneshf) 103 | 104 | ## [v4.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v4.0.0) - 2017-08-15 105 | 106 | - Modules have been reorganised and names have been changed, with the intention that printers/parsers will be used as qualified 107 | - Encoding and decoding with %s should now behave more correctly for all parts of URIs. **When constructing URIs the values should not be pre-encoded.** 108 | 109 | ## [v3.1.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v3.1.0) - 2017-08-09 110 | 111 | - Added `Monoid` (and `Semigroup`) instances for `Query` 112 | 113 | ## [v2.0.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v2.0.1) - 2017-06-24 114 | 115 | - Backported the IPv4 address parsing fix from v3.0.1 116 | 117 | ## [v3.0.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v3.0.1) - 2017-04-24 118 | 119 | - Fixed a bug in the parsing of IPv4 addresses 120 | 121 | ## [v3.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v3.0.0) - 2017-04-16 122 | 123 | - Updated for PureScript 0.11 124 | 125 | ## [v2.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v2.0.0) - 2016-10-28 126 | 127 | - Dependencies updated for PureScript 0.10 128 | - `Query` representation is now a `List` of `Tuples` to accomodate duplicate keys 129 | 130 | ## [v1.0.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v1.0.0) - 2016-07-28 131 | 132 | - Updated for PureScript 0.9 133 | 134 | ## [v0.3.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.3.1) - 2016-05-11 135 | 136 | - Fixed `bower.json` for pursuit publishing (@hdgarrood) 137 | 138 | ## [v0.3.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.3.0) - 2016-04-13 139 | 140 | - Flipped URL left/right to dir/file to match Pathy 141 | - Better encoding/decoding for query string parts 142 | - Added re-exports 143 | 144 | This version is intended for use with PureScript v0.8.4+ 145 | 146 | ## [v0.2.4](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.2.4) - 2016-02-10 147 | 148 | - Fixed unused import warnings for psc 0.7.6. 149 | 150 | ## [v0.2.3](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.2.3) - 2016-02-08 151 | 152 | - Fixed a bug that allows some relative URLs to parse successfully that were previously rejected 153 | - Made the pretty printing of relative paths prettier (`file.html` rather than `./file.html`) 154 | 155 | ## [v0.2.2](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.2.2) - 2016-02-08 156 | 157 | - Fixed a parsing bug with empty host lists 158 | 159 | ## [v0.2.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.2.1) - 2016-01-18 160 | 161 | - Fix various warnings for PureScript 0.7.6.1 (@chrisdotcode) 162 | 163 | ## [v0.2.0](https://github.com/purescript-contrib/purescript-uri/releases/tag/v0.2.0) - 2015-10-06 164 | 165 | - Initial versioned release 166 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to URI 2 | 3 | Thanks for your interest in contributing to `uri`! We welcome new contributions regardless of your level of experience or familiarity with PureScript. 4 | 5 | Every library in the Contributors organization shares a simple handbook that helps new contributors get started. With that in mind, please [read the short contributing guide on purescript-contrib/governance](https://github.com/purescript-contrib/governance/blob/main/contributing.md) before contributing to this library. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # URI 2 | 3 | [![CI](https://github.com/purescript-contrib/purescript-uri/workflows/CI/badge.svg?branch=main)](https://github.com/purescript-contrib/purescript-uri/actions?query=workflow%3ACI+branch%3Amain) 4 | [![Release](http://img.shields.io/github/release/purescript-contrib/purescript-uri.svg)](https://github.com/purescript-contrib/purescript-uri/releases) 5 | [![Pursuit](http://pursuit.purescript.org/packages/purescript-uri/badge)](http://pursuit.purescript.org/packages/purescript-uri) 6 | [![Maintainer: garyb](https://img.shields.io/badge/maintainer-garyb-teal.svg)](http://github.com/garyb) 7 | 8 | A type-safe parser, printer, and ADT for URLs and URIs based on [RFC 3986](https://datatracker.ietf.org/doc/html/rfc3986.html). 9 | 10 | ## Installation 11 | 12 | Install `uri` with [Spago](https://github.com/purescript/spago): 13 | 14 | ```sh 15 | spago install uri 16 | ``` 17 | 18 | ## Quick start 19 | 20 | The quick start hasn't been written yet (contributions are welcome!). The quick start covers a common, minimal use case for the library, whereas longer examples and tutorials are kept in the [docs directory](./docs). 21 | 22 | ## Documentation 23 | 24 | `uri` documentation is stored in a few places: 25 | 26 | 1. Module documentation is [published on Pursuit](https://pursuit.purescript.org/packages/purescript-uri). 27 | 2. Written documentation is kept in [the docs directory](./docs). 28 | 3. Usage examples can be found in [the test suite](./test). 29 | 30 | If you get stuck, there are several ways to get help: 31 | 32 | - [Open an issue](https://github.com/purescript-contrib/purescript-uri/issues) if you have encountered a bug or problem. 33 | - Ask general questions on the [PureScript Discourse](https://discourse.purescript.org) forum or the [PureScript Discord](https://purescript.org/chat) chat. 34 | 35 | ## Contributing 36 | 37 | You can contribute to `uri` in several ways: 38 | 39 | 1. If you encounter a problem or have a question, please [open an issue](https://github.com/purescript-contrib/purescript-uri/issues). We'll do our best to work with you to resolve or answer it. 40 | 41 | 2. If you would like to contribute code, tests, or documentation, please [read the contributor guide](./CONTRIBUTING.md). It's a short, helpful introduction to contributing to this library, including development instructions. 42 | 43 | 3. If you have written a library, tutorial, guide, or other resource based on this package, please share it on the [PureScript Discourse](https://discourse.purescript.org)! Writing libraries and learning resources are a great way to help this library succeed. 44 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-uri", 3 | "homepage": "https://github.com/slamdata/purescript-uri", 4 | "description": "A type-safe parser, printer, and ADT for URLs and URIs.", 5 | "license": "Apache-2.0", 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/purescript-contrib/purescript-uri.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "bower_components", 13 | "node_modules", 14 | "output", 15 | "test", 16 | "bower.json", 17 | "package.json" 18 | ], 19 | "dependencies": { 20 | "purescript-arrays": "^7.0.0", 21 | "purescript-integers": "^6.0.0", 22 | "purescript-js-uri": "https://github.com/purescript-contrib/purescript-js-uri.git#^3.0.0", 23 | "purescript-numbers": "^9.0.0", 24 | "purescript-parsing": "^9.0.0", 25 | "purescript-prelude": "^6.0.0", 26 | "purescript-profunctor-lenses": "^8.0.0", 27 | "purescript-these": "^6.0.0", 28 | "purescript-transformers": "^6.0.0", 29 | "purescript-unfoldable": "^6.0.0" 30 | }, 31 | "devDependencies": { 32 | "purescript-aff": "^7.0.0", 33 | "purescript-assert": "^6.0.0", 34 | "purescript-quickcheck": "^8.0.1" 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | # URI Documentation 2 | 3 | This directory contains documentation for `uri`. If you are interested in contributing new documentation, please read the [contributor guidelines](../CONTRIBUTING.md) and [What Nobody Tells You About Documentation](https://documentation.divio.com) for help getting started. 4 | 5 | ## Getting started 6 | 7 | The types and names here are a fairly faithful representation of the components described in the spec. 8 | 9 | - [`URI`][URI] is for absolutely specified URIs that can also have path, query, and fragment (hash) parts. 10 | - [`AbsoluteURI`][AbsoluteURI] is a variation on `URI` that drops the ability for the URI to carry a fragment. 11 | - [`RelativeRef`][RelativeRef] is for relatively specified URIs that can also have path, query, and fragment (hash) parts. 12 | - [`URIRef`][URIRef] is combination of `URI` and `RelativeRef`, allowing the full range of representable URIs. 13 | 14 | The absolute/relative terminology when applied to URIs does not relate to the paths that a URI may carry, it refers to whether the URI has a "scheme" or not. For example `http://example.com` and `file://../test.txt` are absolute URIs but `//example.com` and `/test.txt` are relative. 15 | 16 | Assuming none of the `unsafe`-prefixed functions are used when constructing a URI, it should be impossible to construct a URI that is invalid using the types this library provides*. The slight downside of this is the data structures are relatively complex so as to only admit correct possibilities. 17 | 18 | \* Actually, there is one exception to that - `IPv6Address` is far too forgiving in what it allows currently. Contributions welcome! 19 | 20 | ### URI component representations 21 | 22 | Due to the differing needs of users of this library, the URI types are all parameterised to allow for custom representations to be used for parts of the URI. Take a look at the most heavily parametrised type, `URIRef`: 23 | 24 | ``` purescript 25 | type URIRef userInfo hosts path hierPath relPath query fragment = ... 26 | ``` 27 | 28 | This allows us to provide hooks into the parsing and printing processes for a URI, so that types better suited to the intended use case can be used. 29 | 30 | Taking `userInfo` as an example, according to the spec, the `user-info` part of an authority is just an arbitrary string of characters terminated by an `@` before a hostname. An extremely common usage for this is the `user:password` scheme, so by leaving the choice of representation as a type variable we can switch it out for a type specifically designed to handle that (this library includes one actually, under [`URI.Extra.UserPassInfo`][UserPassInfo]). 31 | 32 | ### App-specific URI type definitions 33 | 34 | When using this library, you'll probably want to define type synonyms for the URIs that make sense for your use case. A URI type that uses the simple representations for each component will look something like this: 35 | 36 | ``` purescript 37 | type MyURI = URIRef UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment 38 | ``` 39 | 40 | Along with these types, you'll want to define an options record that specifies how to parse and print URIs that look like this: 41 | 42 | ``` purescript 43 | options ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) 44 | options = 45 | { parseUserInfo: pure 46 | , printUserInfo: id 47 | , parseHosts: HostPortPair.parser pure pure 48 | , printHosts: HostPortPair.print id id 49 | , parsePath: pure 50 | , printPath: id 51 | , parseHierPath: pure 52 | , printHierPath: id 53 | , parseRelPath: pure 54 | , printRelPath: id 55 | , parseQuery: pure 56 | , printQuery: id 57 | , parseFragment: pure 58 | , printFragment: id 59 | } 60 | ``` 61 | 62 | As you can see by all the `pure` and `id`, we're not doing a whole lot here. `parseHosts` is a bit of an exception, but that's just due to the way that case is handled (see [later in this README](#host-parsing) for more details about that). 63 | 64 | These types ([`UserInfo`][UserInfo], [`HostPortPair`][HostPortPair], [`Host`][Host], etc.) are all provided by the library, and where necessary can only be constructed via smart constructor. This ensures that percent-encoding is applied to characters where necessary to ensure the constructed values will print as valid URIs, and so on. 65 | 66 | If we decided that we wanted to support `user:password` style user-info, we'd modify this by changing our type to use [`UserPassInfo`][UserPassInfo]: 67 | 68 | ``` purescript 69 | type MyURI = URIRef UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment 70 | ``` 71 | 72 | And update our options to use the appropriate parse/print functions accordingly: 73 | 74 | ``` purescript 75 | options ∷ Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) 76 | options = 77 | { parseUserInfo: UserPassInfo.parse 78 | , printUserInfo: UserPassInfo.print 79 | , ... 80 | ``` 81 | 82 | ### Writing custom component types 83 | 84 | These `parse/print` functions all share much the same shape of signature. For the case in the previous example, they come out as: 85 | 86 | ``` purescript 87 | parseUserInfo ∷ UserInfo → Either URIPartParseError UserPassInfo 88 | printUserInfo ∷ UserPassInfo → UserInfo 89 | ``` 90 | 91 | So you can see that for each component, when the options hooks/custom representation stuff is used, we take one of these library-provided component types and parse it into our new representation, and also print it back to that simple type later. 92 | 93 | Each of the library-provided component types have a `toString` function that extracts the inner value as a string after applying percent-decoding, and an `unsafeToString` that provides exactly the value that was parsed, preserving percent decoding. Similarly, there's a `fromString` that performs the minimal amount of required percent encoding for that part of the URI, and an `unsafeFromString` that performs no encoding at all. 94 | 95 | You may ask why it's ever useful to have access to the encoded values, or to be able to print without encoding, so here's a motivating example: 96 | 97 | For the [`UserPassInfo`][UserPassInfo] example, the typical way of encoding a username or password that contains a colon within it is to use `%3A` (`us:er` becomes `us%3Aer`). This allows colons-within-the-values to be recongised as independent from the colon-separating-username-and-password (`us%3Aer:password`). 98 | 99 | According to the spec it is not a requirement to encode colons in this part of the URI scheme, so just using [`toString`][UserInfo.toString] on `us:er` will get us back a `us:er`, resulting in `us:er:password`, so we'd have no way of knowing where the user ends and where the password starts. 100 | 101 | The solution when printing is to do some custom encoding that also replaces `:` with `%3A` for the user/password parts, and then joins them with the unencoded `:` afterwards. If we constructed the resulting [`UserInfo`][UserInfo] value with [`fromString`][UserInfo.fromString] it would re-encode our already encoded user/password parts (giving us `%253A` instead of `%3A`), so we use [`unsafeFromString`][UserInfo.unsafeFromString] since we've done the encoding ourselves. 102 | 103 | Similarly, when parsing these values back, we want to split on `:` and then percent-decode the user/password parts individually, so we need to use [`unsafeToString`][UserInfo.unsafeToString] to ensure we get the encoded version. 104 | 105 | Another example where this sort of thing might be useful is if you would like to encode/decode spaces in paths as `+` rather than `%20`. Having the ability to hook into the parse/print stage and choose to examine or print with or without percent encoding/decoding applied gives us the flexibility to produce and consume values exactly as we want, rather than the library attempting to know best in all cases. 106 | 107 | ### Host parsing 108 | 109 | The host printing/parsing setup is a little different. This is to accommodate something that lies outside of the RFC 3986 spec: multiple host definitions within a URI. The motivating case for this is things like connection strings for MongoDB, where host/port pairs can be defined separated by commas within a single URI: 110 | 111 | ``` 112 | mongodb://db1.example.net:27017,db2.example.net:2500/?replicaSet=test 113 | ``` 114 | 115 | This doesn't jive with what is said in RFC 3986, as there a comma is allowed as part of a hostname, but the multiple ports don't fit into the schema. To get around this, when it comes to parsing hosts, the parsing is entirely handed over to the `parseHosts` parser in the options (in the cases for the other parameters, a normal function is run on a value that has been parsed according to the spec already). 116 | 117 | For normal URIs the [`HostPortPair`][HostPortPair] parser/printer should serve well enough. This accepts functions to deal with the host/port parts allowing for those aspects to be dealt with much like all the other options. 118 | 119 | For URIs that are like the MongoDB connection string, this library provides [`URI.Extra.MultiHostPortPair`][MultiHostPortPair]. Given that both of these allow for custom `Host` / `Port` types, hopefully nobody else will need to write anything for the general host-section-parsing part! 120 | 121 | 122 | [AbsoluteURI]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.AbsoluteURI 123 | [Host]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.Host 124 | [HostPortPair]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.HostPortPair 125 | [MultiHostPortPair]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.Extra.MultiHostPortPair 126 | [RelativeRef]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.RelativeRef 127 | [URI]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.URI 128 | [URIRef]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.URIRef 129 | [UserInfo.fromString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:fromString 130 | [UserInfo.toString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:toString 131 | [UserInfo.unsafeFromString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:unsafeFromString 132 | [UserInfo.unsafeToString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:unsafeToString 133 | [UserInfo]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo 134 | [UserPassInfo]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.Extra.UserPassInfo 135 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall 3 | 4 | in upstream 5 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "uri" 2 | , dependencies = 3 | [ "aff" 4 | , "arrays" 5 | , "assert" 6 | , "bifunctors" 7 | , "console" 8 | , "control" 9 | , "effect" 10 | , "either" 11 | , "exceptions" 12 | , "foldable-traversable" 13 | , "gen" 14 | , "integers" 15 | , "js-uri" 16 | , "lists" 17 | , "maybe" 18 | , "newtype" 19 | , "parsing" 20 | , "partial" 21 | , "prelude" 22 | , "profunctor-lenses" 23 | , "quickcheck" 24 | , "strings" 25 | , "tailrec" 26 | , "these" 27 | , "transformers" 28 | , "tuples" 29 | ] 30 | , packages = ./packages.dhall 31 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 32 | } 33 | -------------------------------------------------------------------------------- /src/URI.purs: -------------------------------------------------------------------------------- 1 | module URI 2 | ( module URI.AbsoluteURI 3 | , module URI.Authority 4 | , module URI.Fragment 5 | , module URI.HierarchicalPart 6 | , module URI.Host 7 | , module URI.Path 8 | , module URI.Path.Absolute 9 | , module URI.Path.NoScheme 10 | , module URI.Path.Rootless 11 | , module URI.Port 12 | , module URI.Query 13 | , module URI.RelativePart 14 | , module URI.RelativeRef 15 | , module URI.Scheme 16 | , module URI.URI 17 | , module URI.URIRef 18 | , module URI.UserInfo 19 | ) where 20 | 21 | import URI.AbsoluteURI (AbsoluteURI(..)) 22 | import URI.Authority (Authority(..)) 23 | import URI.Fragment (Fragment) 24 | import URI.HierarchicalPart (HierarchicalPart(..), HierPath) 25 | import URI.Host (Host(..), RegName, IPv4Address, IPv6Address) 26 | import URI.Path (Path(..)) 27 | import URI.Path.Absolute (PathAbsolute(..)) 28 | import URI.Path.NoScheme (PathNoScheme(..)) 29 | import URI.Path.Rootless (PathRootless(..)) 30 | import URI.Port (Port) 31 | import URI.Query (Query) 32 | import URI.RelativePart (RelativePart(..), RelPath) 33 | import URI.RelativeRef (RelativeRef(..)) 34 | import URI.Scheme (Scheme) 35 | import URI.URI (URI(..)) 36 | import URI.URIRef (URIRef) 37 | import URI.UserInfo (UserInfo) 38 | -------------------------------------------------------------------------------- /src/URI/AbsoluteURI.purs: -------------------------------------------------------------------------------- 1 | module URI.AbsoluteURI 2 | ( AbsoluteURI(..) 3 | , AbsoluteURIOptions 4 | , AbsoluteURIParseOptions 5 | , AbsoluteURIPrintOptions 6 | , parser 7 | , print 8 | , _scheme 9 | , _hierPart 10 | , _query 11 | , module URI.HierarchicalPart 12 | , module URI.Query 13 | , module URI.Scheme 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Data.Array as Array 19 | import Data.Either (Either) 20 | import Data.Generic.Rep (class Generic) 21 | import Data.Lens (Lens', lens) 22 | import Data.Maybe (Maybe(..)) 23 | import Data.Show.Generic (genericShow) 24 | import Data.String as String 25 | import Parsing (Parser) 26 | import Parsing.Combinators (optionMaybe) 27 | import Parsing.String (eof) 28 | import URI.Common (URIPartParseError, wrapParser) 29 | import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) 30 | import URI.HierarchicalPart as HPart 31 | import URI.Query (Query) 32 | import URI.Query as Query 33 | import URI.Scheme (Scheme) 34 | import URI.Scheme as Scheme 35 | 36 | -- | A strictly absolute URI. An absolute URI can still contain relative paths 37 | -- | but is required to have a `Scheme` component. 38 | data AbsoluteURI userInfo hosts path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) 39 | 40 | derive instance eqAbsoluteURI :: (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query) => Eq (AbsoluteURI userInfo hosts path hierPath query) 41 | derive instance ordAbsoluteURI :: (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord query) => Ord (AbsoluteURI userInfo hosts path hierPath query) 42 | derive instance genericAbsoluteURI :: Generic (AbsoluteURI userInfo hosts path hierPath query) _ 43 | 44 | instance showAbsoluteURI :: (Show userInfo, Show hosts, Show path, Show hierPath, Show query) => Show (AbsoluteURI userInfo hosts path hierPath query) where 45 | show = genericShow 46 | 47 | -- | A row type for describing the options fields used by the absolute URI 48 | -- | parser and printer. 49 | -- | 50 | -- | Used as `Record (AbsoluteURIOptions userInfo hosts path hierPath query)` 51 | -- | when type anotating an options record. 52 | -- | 53 | -- | See below for details of how to use these configuration options. 54 | type AbsoluteURIOptions userInfo hosts path hierPath query = 55 | AbsoluteURIParseOptions userInfo hosts path hierPath query 56 | (AbsoluteURIPrintOptions userInfo hosts path hierPath query ()) 57 | 58 | -- | A row type for describing the options fields used by the absolute URI 59 | -- | parser. 60 | -- | 61 | -- | Used as `Record (AbsoluteURIParseOptions userInfo hosts path hierPath query ())` 62 | -- | when type anotating an options record. 63 | -- | 64 | -- | Having this options record allows custom representations to be used for 65 | -- | the URI components. If this is not necessary, `pure` can be used for all 66 | -- | the options aside from `parseHosts`, which will typically be 67 | -- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) 68 | -- | for more information on the host/port pair parser. 69 | type AbsoluteURIParseOptions userInfo hosts path hierPath query r = 70 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 71 | , parseHosts :: Parser String hosts 72 | , parsePath :: Path -> Either URIPartParseError path 73 | , parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError hierPath 74 | , parseQuery :: Query -> Either URIPartParseError query 75 | | r 76 | ) 77 | 78 | -- | A row type for describing the options fields used by the absolute URI 79 | -- | printer. 80 | -- | 81 | -- | Used as `Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query ())` 82 | -- | when type anotating an options record. 83 | -- | 84 | -- | As a reverse of the parse options, this specifies how to print values back 85 | -- | from custom representations. If this is not necessary, `identity` can be used for 86 | -- | all the options aside from `printHosts`, which will typically be 87 | -- | `HostPortPair.printHosts identity identity`. See [`URI.HostPortPair`](../URI.HostPortPair) 88 | -- | for more information on the host/port pair printer. 89 | type AbsoluteURIPrintOptions userInfo hosts path hierPath query r = 90 | ( printUserInfo :: userInfo -> UserInfo 91 | , printHosts :: hosts -> String 92 | , printPath :: path -> Path 93 | , printHierPath :: hierPath -> Either PathAbsolute PathRootless 94 | , printQuery :: query -> Query 95 | | r 96 | ) 97 | 98 | -- | A parser for an absolute URI. 99 | parser 100 | :: forall userInfo hosts path hierPath query r 101 | . Record (AbsoluteURIParseOptions userInfo hosts path hierPath query r) 102 | -> Parser String (AbsoluteURI userInfo hosts path hierPath query) 103 | parser opts = 104 | AbsoluteURI 105 | <$> Scheme.parser 106 | <*> HPart.parser opts 107 | <*> optionMaybe (wrapParser opts.parseQuery Query.parser) 108 | <* eof 109 | 110 | -- | A printer for an absolute URI. 111 | print 112 | :: forall userInfo hosts path hierPath query r 113 | . Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query r) 114 | -> AbsoluteURI userInfo hosts path hierPath query 115 | -> String 116 | print opts (AbsoluteURI s h q) = 117 | String.joinWith "" $ Array.catMaybes 118 | [ Just (Scheme.print s) 119 | , Just (HPart.print opts h) 120 | , Query.print <<< opts.printQuery <$> q 121 | ] 122 | 123 | -- | The scheme component of an absolute URI. 124 | _scheme :: forall userInfo hosts path hierPath query. Lens' (AbsoluteURI userInfo hosts path hierPath query) Scheme 125 | _scheme = 126 | lens 127 | (\(AbsoluteURI s _ _) -> s) 128 | (\(AbsoluteURI _ h q) s -> AbsoluteURI s h q) 129 | 130 | -- | The hierarchical-part component of an absolute URI. 131 | _hierPart :: forall userInfo hosts path hierPath query. Lens' (AbsoluteURI userInfo hosts path hierPath query) (HierarchicalPart userInfo hosts path hierPath) 132 | _hierPart = 133 | lens 134 | (\(AbsoluteURI _ h _) -> h) 135 | (\(AbsoluteURI s _ q) h -> AbsoluteURI s h q) 136 | 137 | -- | The query component of an absolute URI. 138 | _query :: forall userInfo hosts path hierPath query. Lens' (AbsoluteURI userInfo hosts path hierPath query) (Maybe query) 139 | _query = 140 | lens 141 | (\(AbsoluteURI _ _ q) -> q) 142 | (\(AbsoluteURI s h _) q -> AbsoluteURI s h q) 143 | -------------------------------------------------------------------------------- /src/URI/Authority.purs: -------------------------------------------------------------------------------- 1 | module URI.Authority 2 | ( Authority(..) 3 | , AuthorityOptions 4 | , AuthorityParseOptions 5 | , AuthorityPrintOptions 6 | , parser 7 | , print 8 | , _userInfo 9 | , _hosts 10 | , module URI.Host 11 | , module URI.Port 12 | , module URI.UserInfo 13 | ) where 14 | 15 | import Prelude 16 | 17 | import Data.Either (Either) 18 | import Data.Generic.Rep (class Generic) 19 | import Data.Lens (Lens', lens) 20 | import Data.Maybe (Maybe(..)) 21 | import Data.Show.Generic (genericShow) 22 | import Parsing (Parser) 23 | import Parsing.Combinators (optionMaybe, try) 24 | import Parsing.String (char, string) 25 | import URI.Common (URIPartParseError, wrapParser) 26 | import URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) 27 | import URI.Port (Port) 28 | import URI.UserInfo (UserInfo) 29 | import URI.UserInfo as UserInfo 30 | 31 | -- | The authority part of a URI. For example: `purescript.org`, 32 | -- | `localhost:3000`, `user@example.net`. 33 | data Authority userInfo hosts = Authority (Maybe userInfo) hosts 34 | 35 | derive instance eqAuthority :: (Eq userInfo, Eq hosts) => Eq (Authority userInfo hosts) 36 | derive instance ordAuthority :: (Ord userInfo, Ord hosts) => Ord (Authority userInfo hosts) 37 | derive instance genericAuthority :: Generic (Authority userInfo hosts) _ 38 | 39 | instance showAuthority :: (Show userInfo, Show hosts) => Show (Authority userInfo hosts) where 40 | show = genericShow 41 | 42 | -- | A row type for describing the options fields used by the authority parser 43 | -- | and printer. 44 | -- | 45 | -- | Used as `Record (AuthorityOptions userInfo hosts)` when type annotating an 46 | -- | options record. 47 | type AuthorityOptions userInfo hosts = 48 | AuthorityParseOptions userInfo hosts 49 | (AuthorityPrintOptions userInfo hosts ()) 50 | 51 | -- | A row type for describing the options fields used by the authority parser. 52 | -- | 53 | -- | Used as `Record (AuthorityParseOptions userInfo hosts ())` when type 54 | -- | annotating an options record. 55 | type AuthorityParseOptions userInfo hosts r = 56 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 57 | , parseHosts :: Parser String hosts 58 | | r 59 | ) 60 | 61 | -- | A row type for describing the options fields used by the authority printer. 62 | -- | 63 | -- | Used as `Record (AuthorityPrintOptions userInfo hosts ())` when type 64 | -- | annotating an options record. 65 | type AuthorityPrintOptions userInfo hosts r = 66 | ( printUserInfo :: userInfo -> UserInfo 67 | , printHosts :: hosts -> String 68 | | r 69 | ) 70 | 71 | -- | A parser for the authority part of a URI. Expects values with a `"//"` 72 | -- | prefix. 73 | parser 74 | :: forall userInfo hosts r 75 | . Record (AuthorityParseOptions userInfo hosts r) 76 | -> Parser String (Authority userInfo hosts) 77 | parser opts = do 78 | _ <- string "//" 79 | ui <- optionMaybe $ try (wrapParser opts.parseUserInfo UserInfo.parser <* char '@') 80 | hosts <- opts.parseHosts 81 | pure $ Authority ui hosts 82 | 83 | -- | A printer for the authority part of a URI. Will print the value with a 84 | -- | `"//"` prefix. 85 | print 86 | :: forall userInfo hosts r 87 | . Record (AuthorityPrintOptions userInfo hosts r) 88 | -> Authority userInfo hosts 89 | -> String 90 | print opts (Authority mui hs) = case mui of 91 | Just ui -> "//" <> UserInfo.print (opts.printUserInfo ui) <> "@" <> opts.printHosts hs 92 | Nothing -> "//" <> opts.printHosts hs 93 | 94 | -- | A lens for the user-info component of the authority. 95 | _userInfo :: forall userInfo hosts. Lens' (Authority userInfo hosts) (Maybe userInfo) 96 | _userInfo = 97 | lens 98 | (\(Authority ui _) -> ui) 99 | (\(Authority _ hs) ui -> Authority ui hs) 100 | 101 | -- | A lens for the host(s) component of the authority. 102 | _hosts :: forall userInfo hosts. Lens' (Authority userInfo hosts) hosts 103 | _hosts = 104 | lens 105 | (\(Authority _ hs) -> hs) 106 | (\(Authority ui _) hs -> Authority ui hs) 107 | -------------------------------------------------------------------------------- /src/URI/Common.purs: -------------------------------------------------------------------------------- 1 | -- | Common functions used in parsing and printing URI components. 2 | module URI.Common 3 | ( URIPartParseError(..) 4 | , wrapParser 5 | , alpha 6 | , alphaNum 7 | , unreserved 8 | , pctEncoded 9 | , subDelims 10 | , printEncoded 11 | , printEncoded' 12 | , decodeURIComponent' 13 | ) where 14 | 15 | import Prelude 16 | 17 | import Control.Alt ((<|>)) 18 | import Control.Monad.Except (throwError) 19 | import Data.Either (Either(..), either) 20 | import Data.Generic.Rep (class Generic) 21 | import Data.List as List 22 | import Data.Maybe (Maybe(..), fromJust) 23 | import Data.Newtype (class Newtype) 24 | import Data.Show.Generic (genericShow) 25 | import Data.String.CodeUnits (singleton) as String 26 | import Data.String.NonEmpty (NonEmptyString) 27 | import Data.String.NonEmpty (joinWith, toString, unsafeFromString) as NES 28 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 29 | import JSURI (decodeURIComponent, encodeURIComponent) 30 | import Parsing (ParseError(..), ParseState(..), Parser, ParserT, getParserT, initialPos, runParser) 31 | import Parsing.String (anyChar, char, eof, satisfy) 32 | import Parsing.String.Basic (oneOf) 33 | import Parsing.Token (digit, hexDigit) 34 | import Partial.Unsafe (unsafePartial) 35 | 36 | -- | An error type used when a custom component parser fails to handle a value. 37 | newtype URIPartParseError = URIPartParseError String 38 | 39 | derive newtype instance eqURIPartParseError :: Eq URIPartParseError 40 | derive newtype instance ordURIPartParseError :: Ord URIPartParseError 41 | derive instance newtypeURIPartParseError :: Newtype URIPartParseError _ 42 | derive instance genericURIPartParseError :: Generic URIPartParseError _ 43 | 44 | instance showURIPartParseError :: Show URIPartParseError where 45 | show = genericShow 46 | 47 | -- | Adapts a parser with a parser-esque function. First the original 48 | -- | parser runs, then it attempts to refine the result with the function. 49 | wrapParser 50 | :: forall s m a b 51 | . Monad m 52 | => (a -> Either URIPartParseError b) 53 | -> ParserT s m a 54 | -> ParserT s m b 55 | wrapParser parseA p = do 56 | (ParseState _ pos _) <- getParserT 57 | a <- p 58 | case parseA a of 59 | Left (URIPartParseError err) -> throwError (ParseError err pos) 60 | Right b -> pure b 61 | 62 | -- | Parser for ascii alphabetical characters (upper and lowercase). 63 | alpha :: Parser String Char 64 | alpha = satisfy \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') 65 | 66 | -- | Parser for ascii alphanumeric characters (upper and lowercase for letters). 67 | alphaNum :: Parser String Char 68 | alphaNum = alpha <|> digit 69 | 70 | -- | Parser for characters that are allowed in a URI but do not have a reserved 71 | -- | purpose. 72 | unreserved :: Parser String Char 73 | unreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~' 74 | 75 | -- | Parser for the "sub-delims" group of reserved characters. 76 | subDelims :: Parser String Char 77 | subDelims = 78 | oneOf [ '!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ',' ] 79 | 80 | -- | Parser for a percent-encoded character. 81 | pctEncoded :: Parser String NonEmptyString 82 | pctEncoded = do 83 | d0 <- char '%' 84 | d1 <- hexDigit 85 | d2 <- hexDigit 86 | pure $ NES.singleton d0 <> NES.singleton d1 <> NES.singleton d2 87 | 88 | -- | A helper function for printing URI components using percent-encoding for 89 | -- | characters that require it. 90 | -- | 91 | -- | Accepts a parser that is used to determine whether a character is allowed 92 | -- | to appear un-encoded in the URI component and the string to encode. 93 | printEncoded :: Parser String Char -> String -> String 94 | printEncoded p s = either (const s) identity (runParser s parse) 95 | where 96 | parse :: Parser String String 97 | parse = (NES.joinWith "" <$> List.manyRec (simpleChar <|> encodedChar)) <* eof 98 | 99 | simpleChar :: Parser String NonEmptyString 100 | simpleChar = NES.singleton <$> p 101 | 102 | encodedChar :: Parser String NonEmptyString 103 | encodedChar = handleURIEncodingResult =<< encodeURIComponent <<< String.singleton <$> anyChar 104 | 105 | handleURIEncodingResult :: Maybe String -> Parser String NonEmptyString 106 | handleURIEncodingResult Nothing = 107 | -- E.g. when there is a lone surrogate. See encodeURIComponent MDN documentation. 108 | throwError $ ParseError "Could not URI encode" initialPos 109 | handleURIEncodingResult (Just encoded) = 110 | pure $ unsafePartial (NES.unsafeFromString encoded) 111 | 112 | -- | A version of [`printEncoded`](#v:printEncoded) that operates on non-empty 113 | -- | strings. 114 | printEncoded' :: Parser String Char -> NonEmptyString -> NonEmptyString 115 | printEncoded' p = 116 | unsafePartial NES.unsafeFromString <<< printEncoded p <<< NES.toString 117 | 118 | -- | A version of [`decodeURIComponent`](https://pursuit.purescript.org/packages/purescript-jsuri/docs/JSURI#v:decodeURIComponent) 119 | -- | that operates on non-empty strings. 120 | decodeURIComponent' :: NonEmptyString -> NonEmptyString 121 | decodeURIComponent' = 122 | unsafePartial NES.unsafeFromString <<< unsafePartial fromJust <<< decodeURIComponent <<< NES.toString 123 | -------------------------------------------------------------------------------- /src/URI/Extra/MultiHostPortPair.purs: -------------------------------------------------------------------------------- 1 | module URI.Extra.MultiHostPortPair 2 | ( MultiHostPortPair 3 | , parser 4 | , print 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Control.Alt ((<|>)) 10 | import Data.Array as Array 11 | import Data.Array.NonEmpty as NEA 12 | import Data.Either (Either) 13 | import Data.Maybe (Maybe(..)) 14 | import Data.String as String 15 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 16 | import Data.String.NonEmpty (join1With) as NES 17 | import Data.These (These(..)) 18 | import Parsing (Parser, fail) 19 | import Parsing.Combinators (optionMaybe, sepBy, try) 20 | import Parsing.String (char) 21 | import Parsing.String.Basic (oneOf) 22 | import URI.Common (URIPartParseError, unreserved, pctEncoded, wrapParser) 23 | import URI.Host (Host(..), RegName) 24 | import URI.Host.IPv4Address as IPv4Address 25 | import URI.Host.IPv6Address as IPv6Address 26 | import URI.Host.RegName as RegName 27 | import URI.HostPortPair as HostPortPair 28 | import URI.Port (Port) 29 | import URI.Port as Port 30 | 31 | -- | Multi-host/port pairs, where host & port combinations can be separated by 32 | -- | `,`, as used by some connection URI schemes. This is not strictly 33 | -- | compatible with RFC 3986, as in that spec `RegName`s can contain `,`, and 34 | -- | only one port can be specified in the authority. 35 | -- | 36 | -- | A motivating example for where this may be useful: dealing with mongodb 37 | -- | connection strings. 38 | type MultiHostPortPair host port = Array (These host port) 39 | 40 | -- | A parser for multiple host/port pairs embedded in a URI. 41 | -- | 42 | -- | This function allows for the `Host` and `Port` components to be parsed into 43 | -- | custom representations. If this is not necessary, use `pure` for both of 44 | -- | these arguments. 45 | parser 46 | :: forall host port 47 | . (Host -> Either URIPartParseError host) 48 | -> (Port -> Either URIPartParseError port) 49 | -> Parser String (MultiHostPortPair host port) 50 | parser parseHost parsePort = 51 | Array.fromFoldable <$> sepBy (parsePair parseHost parsePort) (char ',') 52 | 53 | parsePair 54 | :: forall host port 55 | . (Host -> Either URIPartParseError host) 56 | -> (Port -> Either URIPartParseError port) 57 | -> Parser String (These host port) 58 | parsePair parseHost parsePort = do 59 | mh <- optionMaybe (parseHost' parseHost) 60 | mp <- optionMaybe (wrapParser parsePort Port.parser) 61 | case mh, mp of 62 | Just h, Nothing -> pure (This h) 63 | Nothing, Just p -> pure (That p) 64 | Just h, Just p -> pure (Both h p) 65 | Nothing, Nothing -> fail "Neither host nor port present" 66 | 67 | parseHost' :: forall h. (Host -> Either URIPartParseError h) -> Parser String h 68 | parseHost' p = wrapParser p do 69 | (IPv6Address <$> IPv6Address.parser) 70 | <|> try (IPv4Address <$> IPv4Address.parser) 71 | <|> (NameAddress <$> parseRegName') 72 | 73 | parseRegName' :: Parser String RegName 74 | parseRegName' = RegName.unsafeFromString <<< NES.join1With "" <$> NEA.some p 75 | where 76 | p = pctEncoded <|> NES.singleton <$> c 77 | c = unreserved <|> oneOf [ '!', '$', '&', '\'', '(', ')', '*', '+', ';', '=' ] 78 | 79 | -- | A printer for multiple host/port pairs embedded in a URI. 80 | -- | 81 | -- | As a counterpart to the `parser` this function also requires the `Host` 82 | -- | and `Port` components to be printed back from their custom representations. 83 | -- | If no custom types are being used, pass `identity` for both of these arguments. 84 | print 85 | :: forall host port 86 | . (host -> Host) 87 | -> (port -> Port) 88 | -> MultiHostPortPair host port 89 | -> String 90 | print printHost printPort = 91 | String.joinWith "," <<< map (HostPortPair.print printHost printPort <<< Just) 92 | -------------------------------------------------------------------------------- /src/URI/Extra/QueryPairs.purs: -------------------------------------------------------------------------------- 1 | module URI.Extra.QueryPairs 2 | ( QueryPairs(..) 3 | , parse 4 | , print 5 | , keyPartChar 6 | , valuePartChar 7 | , Key 8 | , keyFromString 9 | , keyToString 10 | , unsafeKeyFromString 11 | , unsafeKeyToString 12 | , Value 13 | , valueFromString 14 | , valueToString 15 | , unsafeValueFromString 16 | , unsafeValueToString 17 | ) where 18 | 19 | import Prelude 20 | 21 | import Control.Alt ((<|>)) 22 | import Data.Array as Array 23 | import Data.Bifunctor (bimap) 24 | import Data.Either (Either) 25 | import Data.Generic.Rep (class Generic) 26 | import Data.List as List 27 | import Data.Maybe (Maybe(..), fromJust) 28 | import Data.Show.Generic (genericShow) 29 | import Data.String as String 30 | import Data.String.NonEmpty (joinWith) as NES 31 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 32 | import Data.Traversable (traverse) 33 | import Data.Tuple (Tuple(..)) 34 | import JSURI (decodeURIComponent) 35 | import Partial.Unsafe (unsafePartial) 36 | import Parsing (ParseError(..), Parser, runParser) 37 | import Parsing.Combinators (optionMaybe, sepBy) 38 | import Parsing.String (char) 39 | import Parsing.String.Basic (oneOf) 40 | import URI.Common (URIPartParseError(..), unreserved, pctEncoded, printEncoded, wrapParser) 41 | import URI.Query as Q 42 | 43 | -- | A query string split into an array of key/value pairs. There is no precise 44 | -- | spec for this, but the format is commonly used, so this attempts to handle 45 | -- | these strings in a sensible way. 46 | -- | 47 | -- | - The representation uses an array rather than a map, so duplicate keys 48 | -- | are supported. 49 | -- | - Keys are not required to have a value associated. 50 | -- | - `&` and `;` are both treated as pair delimiters. 51 | newtype QueryPairs k v = QueryPairs (Array (Tuple k (Maybe v))) 52 | 53 | derive instance genericQueryPairs :: Generic (QueryPairs k v) _ 54 | derive newtype instance eqQueryPairs :: (Eq k, Eq v) => Eq (QueryPairs k v) 55 | derive newtype instance ordQueryPairs :: (Ord k, Ord v) => Ord (QueryPairs k v) 56 | derive newtype instance semigroupQueryPairs :: Semigroup (QueryPairs k v) 57 | derive newtype instance monoidQueryPairs :: Monoid (QueryPairs k v) 58 | 59 | instance showQueryPairs :: (Show k, Show v) => Show (QueryPairs k v) where 60 | show = genericShow 61 | 62 | -- | Parses a query into key/value pairs. 63 | -- | 64 | -- | This function allows for the `Key` and `Value` components to be parsed 65 | -- | into custom representations. If this is not necessary, use `pure` for both 66 | -- | these arguments. 67 | parse 68 | :: forall k v 69 | . (Key -> Either URIPartParseError k) 70 | -> (Value -> Either URIPartParseError v) 71 | -> Q.Query 72 | -> Either URIPartParseError (QueryPairs k v) 73 | parse parseK parseV = 74 | bimap (\(ParseError err _) -> URIPartParseError err) QueryPairs 75 | <<< flip runParser (Array.fromFoldable <$> sepBy (parsePart parseK parseV) (char '&')) 76 | <<< Q.unsafeToString 77 | 78 | parsePart 79 | :: forall k v 80 | . (Key -> Either URIPartParseError k) 81 | -> (Value -> Either URIPartParseError v) 82 | -> Parser String (Tuple k (Maybe v)) 83 | parsePart parseK parseV = do 84 | key <- wrapParser (parseK <<< Key) $ 85 | NES.joinWith "" <$> List.someRec (NES.singleton <$> keyPartChar <|> pctEncoded) 86 | value <- wrapParser (traverse (parseV <<< Value)) $ optionMaybe do 87 | _ <- char '=' 88 | NES.joinWith "" <$> List.manyRec (NES.singleton <$> valuePartChar <|> pctEncoded) 89 | pure $ Tuple key value 90 | 91 | -- | A printer for key/value pairs style query string. 92 | -- | 93 | -- | As a counterpart to the `parser` this function also requires the `Key` 94 | -- | and `Value` components to be printed back from their custom representations. 95 | -- | If no custom types are being used, pass `identity` for both of these arguments. 96 | print 97 | :: forall k v 98 | . (k -> Key) 99 | -> (v -> Value) 100 | -> QueryPairs k v 101 | -> Q.Query 102 | print printK printV (QueryPairs m) = 103 | Q.unsafeFromString $ String.joinWith "&" $ Array.fromFoldable (printPart <$> m) 104 | where 105 | printPart :: Tuple k (Maybe v) -> String 106 | printPart = case _ of 107 | Tuple k Nothing -> 108 | unsafeKeyToString (printK k) 109 | Tuple k (Just v) -> 110 | unsafeKeyToString (printK k) <> "=" <> unsafeValueToString (printV v) 111 | 112 | -- | The default `Key` type used for `QueryPairs`. 113 | newtype Key = Key String 114 | 115 | derive newtype instance eqKey :: Eq Key 116 | derive newtype instance ordKey :: Ord Key 117 | derive newtype instance semigroupKey :: Semigroup Key 118 | derive newtype instance monoidKey :: Monoid Key 119 | 120 | instance showKey :: Show Key where 121 | show (Key s) = "(QueryPairs.unsafeKeyFromString " <> show s <> ")" 122 | 123 | -- | Constructs a key value from a string, percent-encoding any characters 124 | -- | that require it. Note that running this on a string that has already had 125 | -- | percent-encoding applied will double-encode it, for those situations use 126 | -- | `unsafeKeyFromString` instead. 127 | -- | 128 | -- | ``` purescript 129 | -- | keyFromString "foo" = unsafeKeyFromString "foo" 130 | -- | keyFromString "foo#bar" = unsafeKeyFromString "foo%23bar" 131 | -- | keyFromString "foo%23bar" = unsafeKeyFromString "foo%2523bar" 132 | -- | ``` 133 | keyFromString :: String -> Key 134 | keyFromString = Key <<< printEncoded keyPartChar 135 | 136 | -- | Returns the string value for a key, percent-decoding any characters 137 | -- | that require it. 138 | -- | 139 | -- | ``` purescript 140 | -- | keyToString (unsafeKeyFromString "foo") = "foo" 141 | -- | keyToString (unsafeKeyFromString "foo%23bar") = "foo#bar" 142 | -- | ``` 143 | keyToString :: Key -> String 144 | keyToString (Key s) = unsafePartial $ fromJust $ decodeURIComponent s 145 | 146 | -- | Constructs a key value from a string directly - no percent-encoding 147 | -- | will be applied. This is useful when using a custom encoding scheme for 148 | -- | the key, to prevent double-encoding. 149 | unsafeKeyFromString :: String -> Key 150 | unsafeKeyFromString = Key 151 | 152 | -- | Returns the string value for a key without percent-decoding. Only 153 | -- | "unsafe" in the sense that values this produces may need further decoding, 154 | -- | the name is more for symmetry with the `fromString`/`unsafeFromString` 155 | -- | pairing. 156 | unsafeKeyToString :: Key -> String 157 | unsafeKeyToString (Key s) = s 158 | 159 | -- | The default `Value` type used for `QueryPairs`. 160 | newtype Value = Value String 161 | 162 | derive newtype instance eqValue :: Eq Value 163 | derive newtype instance ordValue :: Ord Value 164 | derive newtype instance semigroupValue :: Semigroup Value 165 | derive newtype instance monoidValue :: Monoid Value 166 | 167 | instance showValue :: Show Value where 168 | show (Value s) = "(QueryPairs.unsafeValueFromString " <> show s <> ")" 169 | 170 | -- | Constructs a value from a string, percent-encoding any characters 171 | -- | that require it. Note that running this on a string that has already had 172 | -- | percent-encoding applied will double-encode it, for those situations use 173 | -- | `unsafeValueFromString` instead. 174 | -- | 175 | -- | ``` purescript 176 | -- | valueFromString "foo" = unsafeValueFromString "foo" 177 | -- | valueFromString "foo#bar" = unsafeValueFromString "foo%23bar" 178 | -- | valueFromString "foo%23bar" = unsafeValueFromString "foo%2523bar" 179 | -- | ``` 180 | valueFromString :: String -> Value 181 | valueFromString = 182 | -- `keyPartChar` is used intentionally here. It only differs from 183 | -- `valuePartChar` by excluding `=`, and `=` should be encoded as `%3D`, but 184 | -- can be unambiguously decoded so we want to accept it when reading but do 185 | -- the right thing when printing 186 | Value <<< printEncoded keyPartChar 187 | 188 | -- | Returns the string value for a value, percent-decoding any characters 189 | -- | that require it. 190 | -- | 191 | -- | ``` purescript 192 | -- | valueToString (unsafeValueFromString "foo") = "foo" 193 | -- | valueToString (unsafeValueFromString "foo%23bar") = "foo#bar" 194 | -- | ``` 195 | valueToString :: Value -> String 196 | valueToString (Value s) = unsafePartial $ fromJust $ decodeURIComponent s 197 | 198 | -- | Constructs a value from a string directly - no percent-encoding 199 | -- | will be applied. This is useful when using a custom encoding scheme for 200 | -- | the value, to prevent double-encoding. 201 | unsafeValueFromString :: String -> Value 202 | unsafeValueFromString = Value 203 | 204 | -- | Returns the string value for a value without percent-decoding. Only 205 | -- | "unsafe" in the sense that values this produces may need further decoding, 206 | -- | the name is more for symmetry with the `fromString`/`unsafeFromString` 207 | -- | pairing. 208 | unsafeValueToString :: Value -> String 209 | unsafeValueToString (Value s) = s 210 | 211 | -- | The supported key characters, excluding percent-encodings. 212 | keyPartChar :: Parser String Char 213 | keyPartChar = 214 | unreserved 215 | <|> oneOf [ '!', '$', '\'', '(', ')', '*', '+', ',', ':', '@', '/', '?' ] 216 | 217 | -- | The supported value characters, excluding percent-encodings. 218 | valuePartChar :: Parser String Char 219 | valuePartChar = keyPartChar <|> char '=' 220 | -------------------------------------------------------------------------------- /src/URI/Extra/UserPassInfo.purs: -------------------------------------------------------------------------------- 1 | module URI.Extra.UserPassInfo 2 | ( UserPassInfo(..) 3 | , parse 4 | , print 5 | , userPassInfoChar 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Control.Alt ((<|>)) 11 | import Data.Either (Either(..)) 12 | import Data.Maybe (Maybe(..)) 13 | import Data.Newtype (class Newtype) 14 | import Data.String as String 15 | import Data.String.NonEmpty (NonEmptyString) 16 | import Data.String.NonEmpty.CodeUnits (singleton, splitAt, indexOf, drop) as NES 17 | import Parsing (Parser) 18 | import URI.Common (URIPartParseError(..), decodeURIComponent', subDelims, unreserved, printEncoded') 19 | import URI.UserInfo (UserInfo) 20 | import URI.UserInfo as UserInfo 21 | 22 | -- | `user:password` formatted user-info components for URI authorities. 23 | -- | 24 | -- | This format is considered deprecated according to RFC3986 but is still 25 | -- | very common, so this is provided for cases where it is necessary. 26 | -- | 27 | -- | The username part is required, so a value like `:hello` will fail to parse 28 | -- | for this type. 29 | -- | 30 | -- | The `:` characer will be percent-encoded in all locations other than the 31 | -- | `user:password` separator, although the parser will accept passwords 32 | -- | containing un-encoded `:` characters. 33 | newtype UserPassInfo = UserPassInfo 34 | { user :: NonEmptyString 35 | , password :: Maybe NonEmptyString 36 | } 37 | 38 | derive instance eqUserPassInfo :: Eq UserPassInfo 39 | derive instance ordUserPassInfo :: Ord UserPassInfo 40 | derive instance newtypeUserPassInfo :: Newtype UserPassInfo _ 41 | 42 | instance showUserPassInfo :: Show UserPassInfo where 43 | show (UserPassInfo { user, password }) = 44 | "(UserPassInfo { user: " <> show user <> ", password: " <> show password <> "})" 45 | 46 | -- | A parser for `user:password` formatted user-info. 47 | parse :: UserInfo -> Either URIPartParseError UserPassInfo 48 | parse ui = do 49 | let s = UserInfo.unsafeToString ui 50 | case flip NES.splitAt s <$> NES.indexOf (String.Pattern ":") s of 51 | Just { before: Nothing } -> 52 | Left (URIPartParseError "Expected a username before a password segment") 53 | Just { before: Just before, after: Just after } -> 54 | Right $ UserPassInfo 55 | { user: decodeURIComponent' before 56 | , password: decodeURIComponent' <$> NES.drop 1 after 57 | } 58 | _ -> 59 | Right $ UserPassInfo 60 | { user: decodeURIComponent' s 61 | , password: Nothing 62 | } 63 | 64 | -- | A printer for `user:password` formatted user-info. 65 | print :: UserPassInfo -> UserInfo 66 | print (UserPassInfo { user, password }) = 67 | case password of 68 | Nothing -> 69 | UserInfo.unsafeFromString (printEncoded' userPassInfoChar user) 70 | Just p -> 71 | UserInfo.unsafeFromString $ 72 | printEncoded' userPassInfoChar user 73 | <> NES.singleton ':' 74 | <> printEncoded' userPassInfoChar p 75 | 76 | -- | The supported user/password characters, excluding percent-encodings. 77 | userPassInfoChar :: Parser String Char 78 | userPassInfoChar = unreserved <|> subDelims 79 | -------------------------------------------------------------------------------- /src/URI/Fragment.purs: -------------------------------------------------------------------------------- 1 | module URI.Fragment 2 | ( Fragment 3 | , fromString 4 | , toString 5 | , unsafeFromString 6 | , unsafeToString 7 | , parser 8 | , print 9 | , fragmentChar 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Control.Alt ((<|>)) 15 | import Data.List as List 16 | import Data.Maybe (fromJust) 17 | import Data.String.NonEmpty (joinWith) as NES 18 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 19 | import JSURI (decodeURIComponent) 20 | import Partial.Unsafe (unsafePartial) 21 | import Parsing (Parser) 22 | import Parsing.String (char) 23 | import URI.Common (subDelims, unreserved, pctEncoded, printEncoded) 24 | 25 | -- | The fragment component (hash) of a URI. 26 | newtype Fragment = Fragment String 27 | 28 | derive newtype instance eqFragment :: Eq Fragment 29 | derive newtype instance ordFragment :: Ord Fragment 30 | derive newtype instance semigroupFragment :: Semigroup Fragment 31 | derive newtype instance monoidFragment :: Monoid Fragment 32 | 33 | instance showFragment :: Show Fragment where 34 | show (Fragment s) = "(Fragment.unsafeFromString " <> show s <> ")" 35 | 36 | -- | Constructs a fragment value from a string, percent-encoding any characters 37 | -- | that require it. Note that running this on a string that has already had 38 | -- | percent-encoding applied will double-encode it, for those situations use 39 | -- | `unsafeFromString` instead. 40 | -- | 41 | -- | ``` purescript 42 | -- | fromString "foo" = unsafeFromString "foo" 43 | -- | fromString "foo#bar" = unsafeFromString "foo%23bar" 44 | -- | fromString "foo%23bar" = unsafeFromString "foo%2523bar" 45 | -- | ``` 46 | fromString :: String -> Fragment 47 | fromString = Fragment <<< printEncoded fragmentChar 48 | 49 | -- | Returns the string value for a fragment, percent-decoding any characters 50 | -- | that require it. 51 | -- | 52 | -- | ``` purescript 53 | -- | toString (unsafeFromString "foo") = "foo" 54 | -- | toString (unsafeFromString "foo%23bar") = "foo#bar" 55 | -- | ``` 56 | toString :: Fragment -> String 57 | toString (Fragment s) = unsafePartial $ fromJust $ decodeURIComponent s 58 | 59 | -- | Constructs a fragment value from a string directly - no percent-encoding 60 | -- | will be applied. This is useful when using a custom encoding scheme for 61 | -- | the fragment, to prevent double-encoding. 62 | unsafeFromString :: String -> Fragment 63 | unsafeFromString = Fragment 64 | 65 | -- | Returns the string value for the fragment without percent-decoding. Only 66 | -- | "unsafe" in the sense that values this produces may need further decoding, 67 | -- | the name is more for symmetry with the `fromString`/`unsafeFromString` 68 | -- | pairing. 69 | unsafeToString :: Fragment -> String 70 | unsafeToString (Fragment s) = s 71 | 72 | -- | A parser for the fragment component of a URI. Expects values with a `'#'` 73 | -- | prefix. 74 | parser :: Parser String Fragment 75 | parser = 76 | char '#' *> 77 | ( Fragment <<< NES.joinWith "" 78 | <$> List.manyRec (pctEncoded <|> NES.singleton <$> fragmentChar) 79 | ) 80 | 81 | -- | A printer for the fragment component of a URI. Will print the value with 82 | -- | a `'#'` prefix. 83 | print :: Fragment -> String 84 | print (Fragment f) = "#" <> f 85 | 86 | -- | The supported fragment characters, excluding percent-encodings. 87 | fragmentChar :: Parser String Char 88 | fragmentChar = 89 | unreserved <|> subDelims 90 | <|> char ':' 91 | <|> char '@' 92 | <|> char '/' 93 | <|> char '?' 94 | -------------------------------------------------------------------------------- /src/URI/HierarchicalPart.purs: -------------------------------------------------------------------------------- 1 | module URI.HierarchicalPart 2 | ( HierarchicalPart(..) 3 | , HierarchicalPartOptions 4 | , HierarchicalPartParseOptions 5 | , HierarchicalPartPrintOptions 6 | , HierPath 7 | , parser 8 | , print 9 | , _authority 10 | , _path 11 | , _hierPath 12 | , module URI.Authority 13 | , module URI.Path 14 | , module URI.Path.Absolute 15 | , module URI.Path.Rootless 16 | ) where 17 | 18 | import Prelude 19 | 20 | import Control.Alt ((<|>)) 21 | import Data.Either (Either(..), either) 22 | import Data.Generic.Rep (class Generic) 23 | import Data.Lens (Traversal', wander) 24 | import Data.Maybe (Maybe(..), maybe) 25 | import Data.Show.Generic (genericShow) 26 | import Parsing (Parser) 27 | import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) 28 | import URI.Authority as Authority 29 | import URI.Common (URIPartParseError, wrapParser) 30 | import URI.Path (Path(..)) 31 | import URI.Path as Path 32 | import URI.Path.Absolute (PathAbsolute(..)) 33 | import URI.Path.Absolute as PathAbs 34 | import URI.Path.Rootless (PathRootless(..)) 35 | import URI.Path.Rootless as PathRootless 36 | 37 | -- | The "hierarchical part" of a generic or absolute URI. This combines an 38 | -- | authority (optional) with a path value. 39 | -- | 40 | -- | When the authority is present a generic path representation can be used, 41 | -- | otherwise there are some restrictions on the path construction to ensure 42 | -- | no ambiguity in parsing (this is per the spec, not a restriction of the 43 | -- | library). 44 | data HierarchicalPart userInfo hosts path hierPath 45 | = HierarchicalPartAuth (Authority userInfo hosts) path 46 | | HierarchicalPartNoAuth (Maybe hierPath) 47 | 48 | derive instance eqHierarchicalPart :: (Eq userInfo, Eq hosts, Eq path, Eq hierPath) => Eq (HierarchicalPart userInfo hosts path hierPath) 49 | derive instance ordHierarchicalPart :: (Ord userInfo, Ord hosts, Ord path, Ord hierPath) => Ord (HierarchicalPart userInfo hosts path hierPath) 50 | derive instance genericHierarchicalPart :: Generic (HierarchicalPart userInfo hosts path hierPath) _ 51 | 52 | instance showHierarchicalPart :: (Show userInfo, Show hosts, Show path, Show hierPath) => Show (HierarchicalPart userInfo hosts path hierPath) where 53 | show = genericShow 54 | 55 | -- | A row type for describing the options fields used by the hierarchical-part 56 | -- | parser and printer. 57 | -- | 58 | -- | Used as `Record (HierarchicalPartOptions userInfo hosts path hierPath)` 59 | -- | when type anotating an options record. 60 | type HierarchicalPartOptions userInfo hosts path hierPath = 61 | HierarchicalPartParseOptions userInfo hosts path hierPath 62 | (HierarchicalPartPrintOptions userInfo hosts path hierPath ()) 63 | 64 | -- | A row type for describing the options fields used by the hierarchical-part 65 | -- | parser. 66 | -- | 67 | -- | Used as `Record (HierarchicalPartParseOptions userInfo hosts path hierPath ())` 68 | -- | when type anotating an options record. 69 | type HierarchicalPartParseOptions userInfo hosts path hierPath r = 70 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 71 | , parseHosts :: Parser String hosts 72 | , parsePath :: Path -> Either URIPartParseError path 73 | , parseHierPath :: HierPath -> Either URIPartParseError hierPath 74 | | r 75 | ) 76 | 77 | -- | A row type for describing the options fields used by the hierarchical-part 78 | -- | printer. 79 | -- | 80 | -- | Used as `Record (HierarchicalPartPrintOptions userInfo hosts path hierPath ())` 81 | -- | when type anotating an options record. 82 | type HierarchicalPartPrintOptions userInfo hosts path hierPath r = 83 | ( printUserInfo :: userInfo -> UserInfo 84 | , printHosts :: hosts -> String 85 | , printPath :: path -> Path 86 | , printHierPath :: hierPath -> HierPath 87 | | r 88 | ) 89 | 90 | -- | The specific path types supported in a hierarchical-part when there is no 91 | -- | authority present. See [`URI.Path.Absolute`](../URI.Path.Absolute) and 92 | -- | [`URI.Path.Rootless`](../URI.Path.Rootless) for an explanation of these 93 | -- | forms. 94 | type HierPath = Either PathAbsolute PathRootless 95 | 96 | -- | A parser for the hierarchical-part of a URI. 97 | parser 98 | :: forall userInfo hosts path hierPath r 99 | . Record (HierarchicalPartParseOptions userInfo hosts path hierPath r) 100 | -> Parser String (HierarchicalPart userInfo hosts path hierPath) 101 | parser opts = withAuth <|> withoutAuth 102 | where 103 | withAuth = 104 | HierarchicalPartAuth 105 | <$> Authority.parser opts 106 | <*> wrapParser opts.parsePath Path.parser 107 | withoutAuth = 108 | HierarchicalPartNoAuth <$> noAuthPath 109 | noAuthPath = (Just <$> wrapParser (opts.parseHierPath <<< Left) PathAbs.parse) 110 | <|> (Just <$> wrapParser (opts.parseHierPath <<< Right) PathRootless.parse) 111 | <|> pure Nothing 112 | 113 | -- | A printer for the hierarchical-part of a URI. 114 | print 115 | :: forall userInfo hosts path hierPath r 116 | . Record (HierarchicalPartPrintOptions userInfo hosts path hierPath r) 117 | -> HierarchicalPart userInfo hosts path hierPath 118 | -> String 119 | print opts = case _ of 120 | HierarchicalPartAuth a p -> 121 | Authority.print opts a <> Path.print (opts.printPath p) 122 | HierarchicalPartNoAuth p -> 123 | maybe "" (either PathAbs.print PathRootless.print <<< opts.printHierPath) p 124 | 125 | -- | An affine traversal for the authority component of a hierarchical-part. 126 | _authority :: forall userInfo hosts path hierPath. Traversal' (HierarchicalPart userInfo hosts path hierPath) (Authority userInfo hosts) 127 | _authority = wander \f -> case _ of 128 | HierarchicalPartAuth a p -> flip HierarchicalPartAuth p <$> f a 129 | a -> pure a 130 | 131 | -- | An affine traversal for the path component of a hierarchical-part, this 132 | -- | succeeds when the authority is present also. 133 | _path :: forall userInfo hosts path hierPath. Traversal' (HierarchicalPart userInfo hosts path hierPath) path 134 | _path = wander \f -> case _ of 135 | HierarchicalPartAuth a p -> HierarchicalPartAuth a <$> f p 136 | a -> pure a 137 | 138 | -- | An affine traversal for the path component of a hierarchical-part, this 139 | -- | succeeds when the authority is not present. 140 | _hierPath :: forall userInfo hosts path hierPath. Traversal' (HierarchicalPart userInfo hosts path hierPath) (Maybe hierPath) 141 | _hierPath = wander \f -> case _ of 142 | HierarchicalPartNoAuth p -> HierarchicalPartNoAuth <$> f p 143 | a -> pure a 144 | -------------------------------------------------------------------------------- /src/URI/Host.purs: -------------------------------------------------------------------------------- 1 | module URI.Host 2 | ( Host(..) 3 | , parser 4 | , print 5 | , _IPv6Address 6 | , _IPv4Address 7 | , _NameAddress 8 | , module URI.Host.IPv4Address 9 | , module URI.Host.IPv6Address 10 | , module URI.Host.RegName 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Alt ((<|>)) 16 | import Data.Generic.Rep (class Generic) 17 | import Data.Lens (Prism', prism') 18 | import Data.Maybe (Maybe(..)) 19 | import Data.Show.Generic (genericShow) 20 | import Parsing (Parser) 21 | import Parsing.Combinators (try) 22 | import URI.Host.IPv4Address (IPv4Address) 23 | import URI.Host.IPv4Address as IPv4Address 24 | import URI.Host.IPv6Address (IPv6Address) 25 | import URI.Host.IPv6Address as IPv6Address 26 | import URI.Host.RegName (RegName) 27 | import URI.Host.RegName as RegName 28 | 29 | -- | A host address. Supports named addresses, IPv4, and IPv6. 30 | data Host 31 | = IPv6Address IPv6Address 32 | | IPv4Address IPv4Address 33 | | NameAddress RegName 34 | 35 | derive instance eqHost :: Eq Host 36 | derive instance ordHost :: Ord Host 37 | derive instance genericHost :: Generic Host _ 38 | instance showHost :: Show Host where 39 | show = genericShow 40 | 41 | -- | A parser for host addresses. 42 | parser :: Parser String Host 43 | parser = 44 | (IPv6Address <$> IPv6Address.parser) 45 | <|> try (IPv4Address <$> IPv4Address.parser) 46 | <|> (NameAddress <$> RegName.parser) 47 | 48 | -- | A printer for host addresses. 49 | print :: Host -> String 50 | print = case _ of 51 | IPv6Address addr -> IPv6Address.unsafeToString addr 52 | IPv4Address addr -> IPv4Address.print addr 53 | NameAddress addr -> RegName.print addr 54 | 55 | -- | A prism for the `IPv6Address` constructor. 56 | _IPv6Address :: Prism' Host IPv6Address 57 | _IPv6Address = prism' IPv6Address case _ of 58 | IPv6Address addr -> Just addr 59 | _ -> Nothing 60 | 61 | -- | A prism for the `IPv4Address` constructor. 62 | _IPv4Address :: Prism' Host IPv4Address 63 | _IPv4Address = prism' IPv4Address case _ of 64 | IPv4Address addr -> Just addr 65 | _ -> Nothing 66 | 67 | -- | A prism for the `NameAddress` constructor. 68 | _NameAddress :: Prism' Host RegName 69 | _NameAddress = prism' NameAddress case _ of 70 | NameAddress addr -> Just addr 71 | _ -> Nothing 72 | -------------------------------------------------------------------------------- /src/URI/Host/Gen.purs: -------------------------------------------------------------------------------- 1 | module URI.Host.Gen where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Gen as Gen 6 | import Control.Monad.Rec.Class (class MonadRec) 7 | import Data.Char.Gen as GenChar 8 | import Data.String.Gen as GenString 9 | import Data.String.NonEmpty.CodeUnits as NES 10 | import URI.Host (Host(..), IPv4Address, RegName) 11 | import URI.Host.IPv4Address as IPv4Address 12 | import URI.Host.RegName as RegName 13 | 14 | -- | Generates a random `IPv4Address` for testing purposes. 15 | genIPv4 :: forall m. Gen.MonadGen m => m IPv4Address 16 | genIPv4 = do 17 | a <- Gen.chooseInt 0 255 18 | b <- Gen.chooseInt 0 255 19 | c <- Gen.chooseInt 0 255 20 | d <- Gen.chooseInt 0 255 21 | pure $ IPv4Address.unsafeFromInts a b c d 22 | 23 | -- | Generates a random `RegName` for testing purposes. 24 | genRegName :: forall m. Gen.MonadGen m => MonadRec m => m RegName 25 | genRegName = do 26 | head <- genAlphaNumeric 27 | tail <- GenString.genString genAlphaNumeric 28 | pure $ RegName.fromString $ NES.cons head tail 29 | where 30 | genAlphaNumeric = Gen.choose GenChar.genAlpha GenChar.genDigitChar 31 | 32 | -- | Generates a random `Host` for testing purposes. 33 | genHost :: forall m. Gen.MonadGen m => MonadRec m => m Host 34 | genHost = Gen.choose (NameAddress <$> genRegName) (IPv4Address <$> genIPv4) 35 | -------------------------------------------------------------------------------- /src/URI/Host/IPv4Address.purs: -------------------------------------------------------------------------------- 1 | module URI.Host.IPv4Address 2 | ( IPv4Address 3 | , fromInts 4 | , unsafeFromInts 5 | , parser 6 | , print 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Control.Alt ((<|>)) 12 | import Data.Either (Either(..)) 13 | import Data.Int as Int 14 | import Data.Maybe (Maybe(..)) 15 | import Data.String.CodeUnits as String 16 | import Partial.Unsafe (unsafeCrashWith) 17 | import Parsing (Parser) 18 | import Parsing.Combinators (try) 19 | import Parsing.String (char, satisfy) 20 | import Parsing.Token (digit) 21 | import URI.Common (URIPartParseError(..), wrapParser) 22 | 23 | -- | The IPv4 address variation of the host part of a URI. 24 | data IPv4Address = IPv4Address Int Int Int Int 25 | 26 | derive instance eqIPv4Address :: Eq IPv4Address 27 | derive instance ordIPv4Address :: Ord IPv4Address 28 | 29 | instance showIPv4Address :: Show IPv4Address where 30 | show (IPv4Address o1 o2 o3 o4) = "(IPv4Address.unsafeFromInts " <> show o1 <> " " <> show o2 <> " " <> show o3 <> " " <> show o4 <> ")" 31 | 32 | -- | Constructs a `IPv4Address` part safely: bounds-checks each octet to ensure 33 | -- | it occurs within the range 0-255 (inclusive). 34 | fromInts :: Int -> Int -> Int -> Int -> Maybe IPv4Address 35 | fromInts o1 o2 o3 o4 = 36 | IPv4Address <$> check o1 <*> check o2 <*> check o3 <*> check o4 37 | where 38 | check :: Int -> Maybe Int 39 | check i 40 | | i >= 0 && i <= 255 = Just i 41 | | otherwise = Nothing 42 | 43 | -- | Constructs a `IPv4Address` part unsafely: if any of the arguments are 44 | -- | outside the allowable bounds, a runtime error will be thrown. 45 | -- | 46 | -- | This is intended as a convenience when describing `IPv4Address`es 47 | -- | statically in PureScript code, in all other cases `fromInts` should be 48 | -- | used. 49 | unsafeFromInts :: Int -> Int -> Int -> Int -> IPv4Address 50 | unsafeFromInts o1 o2 o3 o4 = 51 | case fromInts o1 o2 o3 o4 of 52 | Just addr -> addr 53 | Nothing -> unsafeCrashWith "IPv4Address octet was out of range" 54 | 55 | -- | A parser for IPv4 addresses. 56 | parser :: Parser String IPv4Address 57 | parser = do 58 | o1 <- octet <* char '.' 59 | o2 <- octet <* char '.' 60 | o3 <- octet <* char '.' 61 | o4 <- octet 62 | pure $ IPv4Address o1 o2 o3 o4 63 | 64 | -- | A printer for IPv4 adddresses. 65 | print :: IPv4Address -> String 66 | print (IPv4Address o1 o2 o3 o4) = 67 | show o1 <> "." <> show o2 <> "." <> show o3 <> "." <> show o4 68 | 69 | octet :: Parser String Int 70 | octet = wrapParser toInt $ 71 | try ((\x y z -> String.fromCharArray [ x, y, z ]) <$> nzDigit <*> digit <*> digit) 72 | <|> try ((\x y -> String.fromCharArray [ x, y ]) <$> nzDigit <*> digit) 73 | <|> (String.singleton <$> digit) 74 | 75 | nzDigit :: Parser String Char 76 | nzDigit = satisfy (\c -> c >= '1' && c <= '9') 77 | 78 | toInt :: String -> Either URIPartParseError Int 79 | toInt s = case Int.fromString s of 80 | Just n | n >= 0 && n <= 255 -> Right n 81 | _ -> Left (URIPartParseError "Invalid IPv4 address octet") 82 | -------------------------------------------------------------------------------- /src/URI/Host/IPv6Address.purs: -------------------------------------------------------------------------------- 1 | module URI.Host.IPv6Address 2 | ( IPv6Address 3 | , unsafeFromString 4 | , unsafeToString 5 | , parser 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Control.Alt ((<|>)) 11 | import Data.List as List 12 | import Data.String.NonEmpty as NES 13 | import Data.String.NonEmpty.CodeUnits as NESCU 14 | import Parsing (Parser) 15 | import Parsing.Combinators (()) 16 | import Parsing.String (char) 17 | import Parsing.Token (hexDigit) 18 | 19 | -- | This type and parser are much too forgiving currently, allowing almost 20 | -- | anything through that looks vaguely IPv6ish. 21 | newtype IPv6Address = IPv6Address String 22 | 23 | derive newtype instance eqIPv6Address :: Eq IPv6Address 24 | derive newtype instance ordIPv6Address :: Ord IPv6Address 25 | 26 | instance showIPv6Address :: Show IPv6Address where 27 | show (IPv6Address s) = "(IPv6Address.unsafeFromString " <> show s <> ")" 28 | 29 | unsafeFromString :: String -> IPv6Address 30 | unsafeFromString = IPv6Address 31 | 32 | unsafeToString :: IPv6Address -> String 33 | unsafeToString (IPv6Address s) = "[" <> s <> "]" 34 | 35 | parser :: Parser String IPv6Address 36 | parser = 37 | IPv6Address 38 | <$> (char '[' *> (NES.joinWith "" <$> List.someRec (NESCU.singleton <$> ipv6Char)) <* char ']') 39 | "IPv6 address" 40 | where 41 | ipv6Char :: Parser String Char 42 | ipv6Char = hexDigit <|> char ':' <|> char '.' 43 | -------------------------------------------------------------------------------- /src/URI/Host/RegName.purs: -------------------------------------------------------------------------------- 1 | module URI.Host.RegName 2 | ( RegName 3 | , fromString 4 | , toString 5 | , unsafeFromString 6 | , unsafeToString 7 | , parser 8 | , print 9 | , regNameChar 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Control.Alt ((<|>)) 15 | import Data.Array.NonEmpty as NEA 16 | import Data.String.NonEmpty (NonEmptyString) 17 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 18 | import Data.String.NonEmpty (join1With, toString) as NES 19 | import Parsing (Parser) 20 | import URI.Common (decodeURIComponent', subDelims, unreserved, pctEncoded, printEncoded') 21 | 22 | -- | The reg-name variation of the host part of a URI. A reg-name is probably 23 | -- | more commonly referred to as just a host name or domain name (but it is 24 | -- | actually a name, rather than an IP address). 25 | newtype RegName = RegName NonEmptyString 26 | 27 | derive newtype instance eqRegName :: Eq RegName 28 | derive newtype instance ordRegName :: Ord RegName 29 | derive newtype instance semigroupRegName :: Semigroup RegName 30 | 31 | instance showRegName :: Show RegName where 32 | show (RegName s) = "(RegName.unsafeFromString " <> show s <> ")" 33 | 34 | -- | Constructs a reg-name value from a string, percent-encoding any characters 35 | -- | that require it. Note that running this on a string that has already had 36 | -- | percent-encoding applied will double-encode it, for those situations use 37 | -- | `unsafeFromString` instead. 38 | -- | 39 | -- | ``` purescript 40 | -- | fromString "foo.com" = unsafeFromString "foo.com" 41 | -- | fromString "foo:bar" = unsafeFromString "foo%3Abar" 42 | -- | fromString "foo%3Abar" = unsafeFromString "foo%253Abar" 43 | -- | ``` 44 | fromString :: NonEmptyString -> RegName 45 | fromString = RegName <<< printEncoded' regNameChar 46 | 47 | -- | Returns the string value for a reg-name, percent-decoding any characters 48 | -- | that require it. 49 | -- | 50 | -- | ``` purescript 51 | -- | toString (unsafeFromString "foo.com") = "foo.com" 52 | -- | toString (unsafeFromString "foo%3Abar") = "foo:bar" 53 | -- | ``` 54 | toString :: RegName -> NonEmptyString 55 | toString (RegName s) = decodeURIComponent' s 56 | 57 | -- | Constructs a query value from a string directly - no percent-encoding 58 | -- | will be applied. This is useful when using a custom encoding scheme for 59 | -- | the query, to prevent double-encoding. 60 | unsafeFromString :: NonEmptyString -> RegName 61 | unsafeFromString = RegName 62 | 63 | -- | Returns the string value for the reg-name without percent-decoding. Only 64 | -- | "unsafe" in the sense that values this produces may need further decoding, 65 | -- | the name is more for symmetry with the `fromString`/`unsafeFromString` 66 | -- | pairing. 67 | unsafeToString :: RegName -> NonEmptyString 68 | unsafeToString (RegName s) = s 69 | 70 | -- | A parser for reg-names. 71 | parser :: Parser String RegName 72 | parser = RegName <<< NES.join1With "" <$> NEA.some p 73 | where 74 | p = pctEncoded <|> NES.singleton <$> regNameChar 75 | 76 | -- | A printer for reg-names. 77 | print :: RegName -> String 78 | print = NES.toString <<< unsafeToString 79 | 80 | -- | The supported reg-name characters, excluding percent-encodings. 81 | regNameChar :: Parser String Char 82 | regNameChar = unreserved <|> subDelims 83 | -------------------------------------------------------------------------------- /src/URI/HostPortPair.purs: -------------------------------------------------------------------------------- 1 | module URI.HostPortPair where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.These (These(..)) 8 | import Parsing (Parser) 9 | import Parsing.Combinators (optionMaybe) 10 | import URI.Common (URIPartParseError, wrapParser) 11 | import URI.Host (Host) 12 | import URI.Host as Host 13 | import URI.Port (Port) 14 | import URI.Port as Port 15 | 16 | -- | A spec-conformant host/port pair (may also be empty). 17 | -- | For example: `purescript.org`, `localhost:3000`, `:9000`. 18 | type HostPortPair host port = Maybe (These host port) 19 | 20 | -- | A parser for a spec-conformant host/port pair. 21 | -- | 22 | -- | This function allows for the `Host` and `Port` components to be parsed into 23 | -- | custom representations. If this is not necessary, use `pure` for both of 24 | -- | these arguments. 25 | -- | 26 | -- | Host parsing is dealt with a little differently to all the other URI 27 | -- | components, as for hosts the control is passed entirely to the component 28 | -- | parser. This is to accomodate multi-host URIs that are used sometimes for 29 | -- | connection strings and the like, but as these are not spec-conforming this 30 | -- | part of parsing may need to bend the rules a little. See 31 | -- | [`URI.Extra.MultiHostPortPair`](../URI.Extra.MultiHostPortPair) for an 32 | -- | example of this. 33 | parser 34 | :: forall host port 35 | . (Host -> Either URIPartParseError host) 36 | -> (Port -> Either URIPartParseError port) 37 | -> Parser String (HostPortPair host port) 38 | parser parseHost parsePort = do 39 | mh <- optionMaybe (wrapParser parseHost Host.parser) 40 | mp <- optionMaybe (wrapParser parsePort Port.parser) 41 | pure case mh, mp of 42 | Just h, Nothing -> Just (This h) 43 | Nothing, Just p -> Just (That p) 44 | Just h, Just p -> Just (Both h p) 45 | Nothing, Nothing -> Nothing 46 | 47 | -- | A printer for a spec-conformant host/port pair. 48 | -- | 49 | -- | As a counterpart to the `parser` this function also requires the `Host` 50 | -- | and `Port` components to be printed back from their custom representations. 51 | -- | If no custom types are being used, pass `identity` for both of these arguments. 52 | print 53 | :: forall host port 54 | . (host -> Host) 55 | -> (port -> Port) 56 | -> HostPortPair host port 57 | -> String 58 | print printHost printPort = case _ of 59 | Nothing -> 60 | "" 61 | Just (This host) -> 62 | Host.print (printHost host) 63 | Just (That port) -> 64 | Port.print (printPort port) 65 | Just (Both host port) -> 66 | Host.print (printHost host) <> Port.print (printPort port) 67 | -------------------------------------------------------------------------------- /src/URI/HostPortPair/Gen.purs: -------------------------------------------------------------------------------- 1 | module URI.HostPortPair.Gen 2 | ( genHostPortPair 3 | , module URI.Host.Gen 4 | , module URI.Port.Gen 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Control.Monad.Gen as Gen 10 | import Data.Maybe (Maybe(..)) 11 | import Data.These (These(..)) 12 | import URI.Host.Gen (genHost, genIPv4, genRegName) 13 | import URI.HostPortPair (HostPortPair) 14 | import URI.Port.Gen (genPort) 15 | 16 | -- | Generates a random `HostPortPair` for testing purposes. 17 | genHostPortPair 18 | :: forall m host port 19 | . Gen.MonadGen m 20 | => m host 21 | -> m port 22 | -> m (HostPortPair host port) 23 | genHostPortPair host port = do 24 | h <- sometimes 0.75 host 25 | p <- sometimes 0.25 port 26 | pure case h, p of 27 | Just h', Just p' -> Just (Both h' p') 28 | Just h', Nothing -> Just (This h') 29 | Nothing, Just p' -> Just (That p') 30 | Nothing, Nothing -> Nothing 31 | where 32 | sometimes :: forall a. Number -> m a -> m (Maybe a) 33 | sometimes chance g = do 34 | n <- Gen.chooseFloat 0.0 1.0 35 | if n > chance then Just <$> g else pure Nothing 36 | -------------------------------------------------------------------------------- /src/URI/Path.purs: -------------------------------------------------------------------------------- 1 | module URI.Path where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Generic.Rep (class Generic) 7 | import Data.List as List 8 | import Data.Show.Generic (genericShow) 9 | import Data.String as String 10 | import Parsing (Parser) 11 | import Parsing.String (char) 12 | import URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) 13 | 14 | -- | A generic absolute-or-empty path, used in both hierarchical-part and 15 | -- | relative-parts when an authority component is present. Corresponds to 16 | -- | _path-abempty_ in the spec. 17 | -- | 18 | -- | A path value of `/` corresponds to `Path [""]`, an empty path is `Path []`. 19 | newtype Path = Path (Array PathSegment) 20 | 21 | derive newtype instance eqPath :: Eq Path 22 | derive newtype instance ordPath :: Ord Path 23 | derive newtype instance semigroupPath :: Semigroup Path 24 | derive newtype instance monoidPath :: Monoid Path 25 | derive instance genericPath :: Generic Path _ 26 | 27 | instance showPath :: Show Path where 28 | show = genericShow 29 | 30 | -- | A parser for a _path-abempty_ URI component. 31 | parser :: Parser String Path 32 | parser = Path <<< Array.fromFoldable <$> List.manyRec (char '/' *> parseSegment) 33 | 34 | -- | A printer for a _path-abempty_ URI component. 35 | print :: Path -> String 36 | print (Path segs) 37 | | Array.null segs = "" 38 | | otherwise = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) 39 | -------------------------------------------------------------------------------- /src/URI/Path/Absolute.purs: -------------------------------------------------------------------------------- 1 | module URI.Path.Absolute where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Generic.Rep (class Generic) 7 | import Data.List as List 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Show.Generic (genericShow) 10 | import Data.String as String 11 | import Data.Tuple (Tuple(..)) 12 | import Parsing (Parser) 13 | import Parsing.Combinators (optionMaybe) 14 | import Parsing.String (char) 15 | import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNZ, printSegmentNZ, printSegment) 16 | 17 | -- | An absolute path, corresponding to _path-absolute_ in the spec. This path 18 | -- | cannot represent the value `//` - it must either be `/`, or start with a 19 | -- | segment that is not empty, for example: `/something`, `/.`, `/..`. This 20 | -- | type can appear in both hierarchical-part and relative-parts to represent 21 | -- | an absolute path when no authority component is present. 22 | -- | 23 | -- | This restriction exists as a value begining with `//` at this point in the 24 | -- | grammar must be an authority, attempting to decide whether a value is an 25 | -- | authority or a path would be ambiguous if `//` paths were allowed. The `//` 26 | -- | path means the same thing as `/` anyway! 27 | newtype PathAbsolute = PathAbsolute (Maybe (Tuple PathSegmentNZ (Array PathSegment))) 28 | 29 | derive instance eqPathAbsolute :: Eq PathAbsolute 30 | derive instance ordPathAbsolute :: Ord PathAbsolute 31 | derive instance genericPathAbsolute :: Generic PathAbsolute _ 32 | 33 | instance showPathAbsolute :: Show PathAbsolute where 34 | show = genericShow 35 | 36 | -- | A parser for a _path-absolute_ URI component. 37 | parse :: Parser String PathAbsolute 38 | parse = do 39 | _ <- char '/' 40 | optionMaybe parseSegmentNZ >>= case _ of 41 | Just head -> 42 | PathAbsolute 43 | <<< Just 44 | <<< Tuple head 45 | <<< Array.fromFoldable 46 | <$> List.manyRec (char '/' *> parseSegment) 47 | Nothing -> 48 | pure (PathAbsolute Nothing) 49 | 50 | -- | A printer for a _path-absolute_ URI component. 51 | print :: PathAbsolute -> String 52 | print = case _ of 53 | PathAbsolute Nothing -> 54 | "/" 55 | PathAbsolute (Just (Tuple head [])) -> 56 | "/" <> printSegmentNZ head 57 | PathAbsolute (Just (Tuple head tail)) -> 58 | "/" 59 | <> printSegmentNZ head 60 | <> "/" 61 | <> String.joinWith "/" (map printSegment tail) 62 | -------------------------------------------------------------------------------- /src/URI/Path/NoScheme.purs: -------------------------------------------------------------------------------- 1 | module URI.Path.NoScheme where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Generic.Rep (class Generic) 7 | import Data.List as List 8 | import Data.Show.Generic (genericShow) 9 | import Data.String as String 10 | import Data.Tuple (Tuple(..)) 11 | import Parsing (Parser) 12 | import Parsing.String (char) 13 | import URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNZNC, printSegmentNZNC, printSegment) 14 | 15 | -- | A relative path that doesn't look like a URI scheme, corresponding to 16 | -- | _path-noscheme_ in the spec. This path cannot start with the character 17 | -- | `/`, contain the character `:` before the first `/`, or be entirely empty. 18 | -- | This type can appear in a relative-part when there is no authority 19 | -- | component. 20 | newtype PathNoScheme = PathNoScheme (Tuple PathSegmentNZNC (Array PathSegment)) 21 | 22 | derive instance eqPathNoScheme :: Eq PathNoScheme 23 | derive instance ordPathNoScheme :: Ord PathNoScheme 24 | derive instance genericPathNoScheme :: Generic PathNoScheme _ 25 | 26 | instance showPathNoScheme :: Show PathNoScheme where 27 | show = genericShow 28 | 29 | -- | A parser for a _path-noscheme_ URI component. 30 | parse :: Parser String PathNoScheme 31 | parse = do 32 | head <- parseSegmentNZNC 33 | tail <- List.manyRec (char '/' *> parseSegment) 34 | pure (PathNoScheme (Tuple head (Array.fromFoldable tail))) 35 | 36 | -- | A printer for a _path-noscheme_ URI component. 37 | print :: PathNoScheme -> String 38 | print (PathNoScheme (Tuple head tail)) = 39 | case tail of 40 | [] -> printSegmentNZNC head 41 | _ -> printSegmentNZNC head <> "/" <> String.joinWith "/" (map printSegment tail) 42 | -------------------------------------------------------------------------------- /src/URI/Path/Rootless.purs: -------------------------------------------------------------------------------- 1 | module URI.Path.Rootless where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Generic.Rep (class Generic) 7 | import Data.List as List 8 | import Data.Show.Generic (genericShow) 9 | import Data.String as String 10 | import Data.Tuple (Tuple(..)) 11 | import Parsing (Parser) 12 | import Parsing.String (char) 13 | import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNZ, printSegmentNZ, printSegment) 14 | 15 | -- | A relative path, corresponding to _path-rootless_ in the spec. This path 16 | -- | cannot start with the character `/` or be entirely empty. This type can 17 | -- | appear in a hierarchical-part when there is no authority component. 18 | newtype PathRootless = PathRootless (Tuple PathSegmentNZ (Array PathSegment)) 19 | 20 | derive instance eqPathRootless :: Eq PathRootless 21 | derive instance ordPathRootless :: Ord PathRootless 22 | derive instance genericPathRootless :: Generic PathRootless _ 23 | 24 | instance showPathRootless :: Show PathRootless where 25 | show = genericShow 26 | 27 | -- | A parser for a _path-rootless_ URI component. 28 | parse :: Parser String PathRootless 29 | parse = do 30 | head <- parseSegmentNZ 31 | tail <- List.manyRec (char '/' *> parseSegment) 32 | pure (PathRootless (Tuple head (Array.fromFoldable tail))) 33 | 34 | -- | A printer for a _path-rootless_ URI component. 35 | print :: PathRootless -> String 36 | print = case _ of 37 | PathRootless (Tuple head []) -> 38 | printSegmentNZ head 39 | PathRootless (Tuple head tail) -> 40 | printSegmentNZ head 41 | <> "/" 42 | <> String.joinWith "/" (map printSegment tail) 43 | -------------------------------------------------------------------------------- /src/URI/Path/Segment.purs: -------------------------------------------------------------------------------- 1 | module URI.Path.Segment 2 | ( PathSegment 3 | , segmentFromString 4 | , segmentToString 5 | , unsafeSegmentFromString 6 | , unsafeSegmentToString 7 | , parseSegment 8 | , printSegment 9 | , PathSegmentNZ 10 | , segmentNZFromString 11 | , segmentNZToString 12 | , unsafeSegmentNZFromString 13 | , unsafeSegmentNZToString 14 | , parseSegmentNZ 15 | , printSegmentNZ 16 | , PathSegmentNZNC 17 | , segmentNZNCFromString 18 | , segmentNZNCToString 19 | , unsafeSegmentNZNCFromString 20 | , unsafeSegmentNZNCToString 21 | , parseSegmentNZNC 22 | , printSegmentNZNC 23 | , segmentChar 24 | , segmentNCChar 25 | ) where 26 | 27 | import Prelude 28 | 29 | import Control.Alt ((<|>)) 30 | import Data.Array.NonEmpty as NEA 31 | import Data.List as List 32 | import Data.Maybe (fromJust) 33 | import Data.String.NonEmpty (NonEmptyString) 34 | import Data.String.NonEmpty (join1With, joinWith, toString) as NES 35 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 36 | import JSURI (decodeURIComponent) 37 | import Partial.Unsafe (unsafePartial) 38 | import Parsing (Parser) 39 | import Parsing.String (char) 40 | import URI.Common (decodeURIComponent', pctEncoded, printEncoded, printEncoded', subDelims, unreserved) 41 | 42 | -- | A path segment. Can be empty, as this is required to represent some paths - 43 | -- | segments are joined together with slashes, so in cases where a path 44 | -- | contains multiple contiguous slashes this is represented by a group of 45 | -- | empty path segments. Corresponds to _segment_ in the spec. 46 | newtype PathSegment = PathSegment String 47 | 48 | derive newtype instance eqPathSegment :: Eq PathSegment 49 | derive newtype instance ordPathSegment :: Ord PathSegment 50 | 51 | instance showPathSegment :: Show PathSegment where 52 | show (PathSegment s) = "(Segment.unsafeSegmentToString " <> show s <> ")" 53 | 54 | -- | Constructs a segment value from a string, percent-encoding any characters 55 | -- | that require it. Note that running this on a string that has already had 56 | -- | percent-encoding applied will double-encode it, for those situations use 57 | -- | `unsafeSegmentFromString` instead. 58 | segmentFromString :: String -> PathSegment 59 | segmentFromString = PathSegment <<< printEncoded segmentChar 60 | 61 | -- | Returns the string value for a segment, percent-decoding any characters 62 | -- | that require it. 63 | segmentToString :: PathSegment -> String 64 | segmentToString (PathSegment s) = unsafePartial $ fromJust $ decodeURIComponent s 65 | 66 | -- | Constructs a segment value from a string directly - no percent-encoding 67 | -- | will be applied. This is useful when using a custom encoding scheme for 68 | -- | the segment, to prevent double-encoding. 69 | unsafeSegmentFromString :: String -> PathSegment 70 | unsafeSegmentFromString = PathSegment 71 | 72 | -- | Returns the string value for the segment without percent-decoding. Only 73 | -- | "unsafe" in the sense that values this produces may need further decoding, 74 | -- | the name is more for symmetry with the `segmentFromString`/ 75 | -- | `unsafeSegmentFromString` pairing. 76 | unsafeSegmentToString :: PathSegment -> String 77 | unsafeSegmentToString (PathSegment s) = s 78 | 79 | -- | A parser for a _segment_ component of a URI. 80 | parseSegment :: Parser String PathSegment 81 | parseSegment = 82 | PathSegment 83 | <<< NES.joinWith "" 84 | <$> List.manyRec (pctEncoded <|> NES.singleton <$> segmentChar) 85 | 86 | -- | A printer for a _segment_ component of a URI. 87 | printSegment :: PathSegment -> String 88 | printSegment = unsafeSegmentToString 89 | 90 | -- | A path segment that cannot be empty. Corresponds to _segment-nz_ in the 91 | -- | spec. 92 | newtype PathSegmentNZ = PathSegmentNZ NonEmptyString 93 | 94 | derive newtype instance eqPathSegmentNZ :: Eq PathSegmentNZ 95 | derive newtype instance ordPathSegmentNZ :: Ord PathSegmentNZ 96 | 97 | instance showPathSegmentNZ :: Show PathSegmentNZ where 98 | show (PathSegmentNZ s) = "(Segment.unsafeSegmentNZFromString " <> show s <> ")" 99 | 100 | -- | Constructs a non-empty segment value from a string, percent-encoding any 101 | -- | characters that require it. Note that running this on a string that has 102 | -- | already had percent-encoding applied will double-encode it, for those 103 | -- | situations use `unsafeSegmentNZFromString` instead. 104 | segmentNZFromString :: NonEmptyString -> PathSegmentNZ 105 | segmentNZFromString = PathSegmentNZ <<< printEncoded' segmentChar 106 | 107 | -- | Returns the string value for a non-empty segment, percent-decoding any 108 | -- | characters that require it. 109 | segmentNZToString :: PathSegmentNZ -> NonEmptyString 110 | segmentNZToString (PathSegmentNZ s) = decodeURIComponent' s 111 | 112 | -- | Constructs a non-empty segment value from a string directly - no 113 | -- | percent-encoding will be applied. This is useful when using a custom 114 | -- | encoding scheme for the segment, to prevent double-encoding. 115 | unsafeSegmentNZFromString :: NonEmptyString -> PathSegmentNZ 116 | unsafeSegmentNZFromString = PathSegmentNZ 117 | 118 | -- | Returns the string value for a non-empty segment without percent-decoding. 119 | -- | Only "unsafe" in the sense that values this produces may need further 120 | -- | decoding, the name is more for symmetry with the `segmentNZFromString`/ 121 | -- | `unsafeSegmentNZFromString` pairing. 122 | unsafeSegmentNZToString :: PathSegmentNZ -> NonEmptyString 123 | unsafeSegmentNZToString (PathSegmentNZ s) = s 124 | 125 | -- | A parser for a _segment-nz_ component of a URI. 126 | parseSegmentNZ :: Parser String PathSegmentNZ 127 | parseSegmentNZ = 128 | PathSegmentNZ 129 | <<< NES.join1With "" 130 | <$> NEA.some (pctEncoded <|> NES.singleton <$> segmentChar) 131 | 132 | -- | A printer for a _segment-nz_ component of a URI. 133 | printSegmentNZ :: PathSegmentNZ -> String 134 | printSegmentNZ = NES.toString <<< unsafeSegmentNZToString 135 | 136 | -- | A path segment that cannot be empty or contain the `:` character. 137 | -- | Corresponds to _segment-nz-nc_ in the spec. 138 | newtype PathSegmentNZNC = PathSegmentNZNC NonEmptyString 139 | 140 | derive newtype instance eqPathSegmentNZNC :: Eq PathSegmentNZNC 141 | derive newtype instance ordPathSegmentNZNC :: Ord PathSegmentNZNC 142 | 143 | instance showPathSegmentNZNC :: Show PathSegmentNZNC where 144 | show (PathSegmentNZNC s) = "(Segment.unsafeSegmentNZNCToString " <> show s <> ")" 145 | 146 | -- | Constructs a non-empty-no-colon segment value from a string, 147 | -- | percent-encoding any characters that require it. Note that running this on 148 | -- | a string that has already had percent-encoding applied will double-encode 149 | -- | it, for those situations use `unsafeSegmentNZNCFromString` instead. 150 | segmentNZNCFromString :: NonEmptyString -> PathSegmentNZNC 151 | segmentNZNCFromString = PathSegmentNZNC <<< printEncoded' segmentNCChar 152 | 153 | -- | Constructs a non-empty-no-colon segment value from a string directly - no 154 | -- | percent-encoding will be applied. This is useful when using a custom 155 | -- | encoding scheme for the segment, to prevent double-encoding. 156 | segmentNZNCToString :: PathSegmentNZNC -> NonEmptyString 157 | segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent' s 158 | 159 | -- | Returns the string value for a non-empty-no-colon segment, percent-decoding 160 | -- | any characters that require it. 161 | unsafeSegmentNZNCFromString :: NonEmptyString -> PathSegmentNZNC 162 | unsafeSegmentNZNCFromString = PathSegmentNZNC 163 | 164 | -- | Returns the string value for the non-empty-no-colon segment without 165 | -- | percent-decoding. Only "unsafe" in the sense that values this produces may 166 | -- | need further decoding, the name is more for symmetry with the 167 | -- | `segmentNZNCFromString`/`unsafeSegmentNZNCFromString` pairing. 168 | unsafeSegmentNZNCToString :: PathSegmentNZNC -> NonEmptyString 169 | unsafeSegmentNZNCToString (PathSegmentNZNC s) = s 170 | 171 | -- | A parser for a _segment-nz-nc_ component of a URI. 172 | parseSegmentNZNC :: Parser String PathSegmentNZNC 173 | parseSegmentNZNC = 174 | PathSegmentNZNC 175 | <<< NES.join1With "" 176 | <$> NEA.some (pctEncoded <|> NES.singleton <$> segmentNCChar) 177 | 178 | -- | A printer for a _segment-nz-nc_ component of a URI. 179 | printSegmentNZNC :: PathSegmentNZNC -> String 180 | printSegmentNZNC = NES.toString <<< unsafeSegmentNZNCToString 181 | 182 | -- | The supported path segment characters, excluding percent-encodings. 183 | segmentChar :: Parser String Char 184 | segmentChar = segmentNCChar <|> char ':' 185 | 186 | -- | The supported no-colon path segment characters, excluding 187 | -- | percent-encodings. 188 | segmentNCChar :: Parser String Char 189 | segmentNCChar = unreserved <|> subDelims <|> char '@' 190 | -------------------------------------------------------------------------------- /src/URI/Port.purs: -------------------------------------------------------------------------------- 1 | module URI.Port 2 | ( Port 3 | , toInt 4 | , fromInt 5 | , unsafeFromInt 6 | , parser 7 | , print 8 | ) where 9 | 10 | import Prelude 11 | 12 | import Data.Int (decimal, fromStringAs) 13 | import Data.List as List 14 | import Data.Maybe (Maybe(..)) 15 | import Data.String.NonEmpty (joinWith) as NES 16 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 17 | import Partial.Unsafe (unsafeCrashWith) 18 | import Parsing (Parser, fail) 19 | import Parsing.String (char) 20 | import Parsing.Token (digit) 21 | 22 | -- | The port component of a host in a URI. 23 | newtype Port = Port Int 24 | 25 | derive newtype instance eqPort :: Eq Port 26 | derive newtype instance ordPort :: Ord Port 27 | 28 | instance showPort :: Show Port where 29 | show (Port i) = "(Port.unsafeFromInt " <> show i <> ")" 30 | 31 | -- | Returns the port number as an integer. 32 | toInt :: Port -> Int 33 | toInt (Port i) = i 34 | 35 | -- | Attempts to create a port from the passed integer. If the value falls 36 | -- | outside of the range 0-65535 (inclusive) `Nothing` will be returned. 37 | fromInt :: Int -> Maybe Port 38 | fromInt i 39 | | i >= 0 && i <= 65535 = Just (Port i) 40 | | otherwise = Nothing 41 | 42 | -- | Constructs a port from an integer directly: if the value is not an 43 | -- | acceptable port number a runtime error will be thrown. 44 | -- | 45 | -- | This is intended as a convenience when describing `Port`s statically in 46 | -- | PureScript code, in all other cases `fromInt` should be preferred. 47 | unsafeFromInt :: Int -> Port 48 | unsafeFromInt i = 49 | case fromInt i of 50 | Just addr -> addr 51 | Nothing -> unsafeCrashWith $ "Port value " <> show i <> " is out of range" 52 | 53 | -- | A parser for the port component of a host in a URI. Expects values with a 54 | -- | `':'` prefix. 55 | parser :: Parser String Port 56 | parser = do 57 | s <- NES.joinWith "" <$> (char ':' *> List.someRec (NES.singleton <$> digit)) 58 | case fromStringAs decimal s of 59 | Just x -> pure (Port x) 60 | _ -> fail "Expected a valid port number" 61 | 62 | -- | A printer for the port component of a host in a URI. Will print the value 63 | -- | with a `':'` prefix. 64 | print :: Port -> String 65 | print (Port x) = ":" <> show x 66 | -------------------------------------------------------------------------------- /src/URI/Port/Gen.purs: -------------------------------------------------------------------------------- 1 | module URI.Port.Gen where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Gen as Gen 6 | import URI.Port (Port) 7 | import URI.Port as Port 8 | 9 | -- | Generates a random `Port` for testing purposes. 10 | genPort :: forall m. Gen.MonadGen m => m Port 11 | genPort = Port.unsafeFromInt <$> Gen.chooseInt 0 65535 12 | -------------------------------------------------------------------------------- /src/URI/Query.purs: -------------------------------------------------------------------------------- 1 | module URI.Query 2 | ( Query 3 | , fromString 4 | , toString 5 | , unsafeFromString 6 | , unsafeToString 7 | , parser 8 | , print 9 | , queryChar 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Control.Alt ((<|>)) 15 | import Data.List as List 16 | import Data.Maybe (fromJust) 17 | import Data.String.NonEmpty (joinWith) as NES 18 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 19 | import JSURI (decodeURIComponent) 20 | import Partial.Unsafe (unsafePartial) 21 | import Parsing (Parser) 22 | import Parsing.String (char) 23 | import URI.Common (subDelims, unreserved, pctEncoded, printEncoded) 24 | 25 | -- | The query component of a URI. 26 | -- | 27 | -- | This type treats the entire string as an undifferentiated blob, if you 28 | -- | would like to deal with the common `?key1=value1&key2=value2` format, take 29 | -- | a look at `URI.Extra.QueryPairs`. 30 | newtype Query = Query String 31 | 32 | derive newtype instance eqQuery :: Eq Query 33 | derive newtype instance ordQuery :: Ord Query 34 | derive newtype instance semigroupQuery :: Semigroup Query 35 | derive newtype instance monoidQuery :: Monoid Query 36 | 37 | instance showQuery :: Show Query where 38 | show (Query s) = "(Query.unsafeFromString " <> show s <> ")" 39 | 40 | -- | Constructs a query value from a string, percent-encoding any characters 41 | -- | that require it. Note that running this on a string that has already had 42 | -- | percent-encoding applied will double-encode it, for those situations use 43 | -- | `unsafeFromString` instead. 44 | -- | 45 | -- | ``` purescript 46 | -- | fromString "foo" = unsafeFromString "foo" 47 | -- | fromString "foo#bar" = unsafeFromString "foo%23bar" 48 | -- | fromString "foo%23bar" = unsafeFromString "foo%2523bar" 49 | -- | ``` 50 | fromString :: String -> Query 51 | fromString = Query <<< printEncoded queryChar 52 | 53 | -- | Returns the string value for a query, percent-decoding any characters 54 | -- | that require it. 55 | -- | 56 | -- | ``` purescript 57 | -- | toString (unsafeFromString "foo") = "foo" 58 | -- | toString (unsafeFromString "foo%23bar") = "foo#bar" 59 | -- | ``` 60 | toString :: Query -> String 61 | toString (Query s) = unsafePartial $ fromJust $ decodeURIComponent s 62 | 63 | -- | Constructs a query value from a string directly - no percent-encoding 64 | -- | will be applied. This is useful when using a custom encoding scheme for 65 | -- | the query, to prevent double-encoding. 66 | unsafeFromString :: String -> Query 67 | unsafeFromString = Query 68 | 69 | -- | Returns the string value for a query without percent-decoding. Only 70 | -- | "unsafe" in the sense that values this produces may need further decoding, 71 | -- | the name is more for symmetry with the `fromString`/`unsafeFromString` 72 | -- | pairing. 73 | unsafeToString :: Query -> String 74 | unsafeToString (Query s) = s 75 | 76 | -- | A parser for the query component of a URI. Expects values with a `'?'` 77 | -- | prefix. 78 | parser :: Parser String Query 79 | parser = 80 | char '?' *> 81 | ( Query <<< NES.joinWith "" 82 | <$> List.manyRec (NES.singleton <$> queryChar <|> pctEncoded) 83 | ) 84 | 85 | -- | A printer for the query component of a URI. Will print the value with 86 | -- | a `'?'` prefix. 87 | print :: Query -> String 88 | print (Query s) = "?" <> s 89 | 90 | -- | The supported query characters, excluding percent-encodings. 91 | queryChar :: Parser String Char 92 | queryChar = unreserved 93 | <|> subDelims 94 | <|> char ':' 95 | <|> char '@' 96 | <|> char '/' 97 | <|> char '?' 98 | -------------------------------------------------------------------------------- /src/URI/RelativePart.purs: -------------------------------------------------------------------------------- 1 | module URI.RelativePart 2 | ( RelativePart(..) 3 | , RelativePartOptions 4 | , RelativePartParseOptions 5 | , RelativePartPrintOptions 6 | , RelPath 7 | , parser 8 | , print 9 | , _authority 10 | , _path 11 | , _relPath 12 | , module URI.Authority 13 | , module URI.Path 14 | , module URI.Path.Absolute 15 | , module URI.Path.NoScheme 16 | ) where 17 | 18 | import Prelude 19 | 20 | import Control.Alt ((<|>)) 21 | import Data.Either (Either(..), either) 22 | import Data.Generic.Rep (class Generic) 23 | import Data.Lens (Traversal', wander) 24 | import Data.Maybe (Maybe(..), maybe) 25 | import Data.Show.Generic (genericShow) 26 | import Parsing (Parser) 27 | import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) 28 | import URI.Authority as Authority 29 | import URI.Common (URIPartParseError, wrapParser) 30 | import URI.Path (Path) 31 | import URI.Path as Path 32 | import URI.Path.Absolute (PathAbsolute) 33 | import URI.Path.Absolute as PathAbs 34 | import URI.Path.NoScheme (PathNoScheme) 35 | import URI.Path.NoScheme as PathNoScheme 36 | 37 | -- | The "relative part" of a relative reference. This combines an authority 38 | -- | (optional) with a path value. 39 | -- | 40 | -- | When the authority is present a generic path representation can be used, 41 | -- | otherwise there are some restrictions on the path construction to ensure 42 | -- | no ambiguity in parsing (this is per the spec, not a restriction of the 43 | -- | library). 44 | data RelativePart userInfo hosts path relPath 45 | = RelativePartAuth (Authority userInfo hosts) path 46 | | RelativePartNoAuth (Maybe relPath) 47 | 48 | derive instance eqRelativePart :: (Eq userInfo, Eq hosts, Eq path, Eq relPath) => Eq (RelativePart userInfo hosts path relPath) 49 | derive instance ordRelativePart :: (Ord userInfo, Ord hosts, Ord path, Ord relPath) => Ord (RelativePart userInfo hosts path relPath) 50 | derive instance genericRelativePart :: Generic (RelativePart userInfo hosts path relPath) _ 51 | 52 | instance showRelativePart :: (Show userInfo, Show hosts, Show path, Show relPath) => Show (RelativePart userInfo hosts path relPath) where 53 | show = genericShow 54 | 55 | -- | A row type for describing the options fields used by the relative-part 56 | -- | parser and printer. 57 | -- | 58 | -- | Used as `Record (RelativePartOptions userInfo hosts path relPath)` 59 | -- | when type annotating an options record. 60 | type RelativePartOptions userInfo hosts path relPath = 61 | RelativePartParseOptions userInfo hosts path relPath 62 | (RelativePartPrintOptions userInfo hosts path relPath ()) 63 | 64 | -- | A row type for describing the options fields used by the relative-part 65 | -- | parser. 66 | -- | 67 | -- | Used as `Record (RelativePartParseOptions userInfo hosts path relPath ())` 68 | -- | when type annotating an options record. 69 | type RelativePartParseOptions userInfo hosts path relPath r = 70 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 71 | , parseHosts :: Parser String hosts 72 | , parsePath :: Path -> Either URIPartParseError path 73 | , parseRelPath :: RelPath -> Either URIPartParseError relPath 74 | | r 75 | ) 76 | 77 | -- | A row type for describing the options fields used by the relative-part 78 | -- | printer. 79 | -- | 80 | -- | Used as `Record (RelativePartPrintOptions userInfo hosts path relPath ())` 81 | -- | when type annotating an options record. 82 | type RelativePartPrintOptions userInfo hosts path relPath r = 83 | ( printUserInfo :: userInfo -> UserInfo 84 | , printHosts :: hosts -> String 85 | , printPath :: path -> Path 86 | , printRelPath :: relPath -> RelPath 87 | | r 88 | ) 89 | 90 | -- | The specific path types supported in a relative-part when there is no 91 | -- | authority present. See [`URI.Path.Absolute`](../URI.Path.Absolute) and 92 | -- | [`URI.Path.PathNoScheme`](../URI.Path.PathNoScheme) for an explanation of 93 | -- | these forms. 94 | type RelPath = Either PathAbsolute PathNoScheme 95 | 96 | -- | A parser for the relative-part of a URI. 97 | parser 98 | :: forall userInfo hosts path relPath r 99 | . Record (RelativePartParseOptions userInfo hosts path relPath r) 100 | -> Parser String (RelativePart userInfo hosts path relPath) 101 | parser opts = withAuth <|> withoutAuth 102 | where 103 | withAuth = 104 | RelativePartAuth 105 | <$> Authority.parser opts 106 | <*> wrapParser opts.parsePath Path.parser 107 | withoutAuth = 108 | RelativePartNoAuth <$> noAuthPath 109 | noAuthPath = 110 | (Just <$> wrapParser (opts.parseRelPath <<< Left) PathAbs.parse) 111 | <|> (Just <$> wrapParser (opts.parseRelPath <<< Right) PathNoScheme.parse) 112 | <|> pure Nothing 113 | 114 | -- | A printer for the relative-part of a URI. 115 | print 116 | :: forall userInfo hosts path relPath r 117 | . Record (RelativePartPrintOptions userInfo hosts path relPath r) 118 | -> RelativePart userInfo hosts path relPath 119 | -> String 120 | print opts = case _ of 121 | RelativePartAuth a p -> 122 | Authority.print opts a <> Path.print (opts.printPath p) 123 | RelativePartNoAuth p -> 124 | maybe "" (either PathAbs.print PathNoScheme.print <<< opts.printRelPath) p 125 | 126 | -- | An affine traversal for the authority component of a relative-part. 127 | _authority :: forall userInfo hosts path relPath. Traversal' (RelativePart userInfo hosts path relPath) (Authority userInfo hosts) 128 | _authority = wander \f -> case _ of 129 | RelativePartAuth a p -> flip RelativePartAuth p <$> f a 130 | a -> pure a 131 | 132 | -- | An affine traversal for the path component of a relative-part, this 133 | -- | succeeds when the authority is present also. 134 | _path :: forall userInfo hosts path relPath. Traversal' (RelativePart userInfo hosts path relPath) path 135 | _path = wander \f -> case _ of 136 | RelativePartAuth a p -> RelativePartAuth a <$> f p 137 | a -> pure a 138 | 139 | -- | An affine traversal for the path component of a relative-part, this 140 | -- | succeeds when the authority is not present. 141 | _relPath :: forall userInfo hosts path relPath. Traversal' (RelativePart userInfo hosts path relPath) (Maybe relPath) 142 | _relPath = wander \f a -> case a of 143 | RelativePartNoAuth p -> RelativePartNoAuth <$> f p 144 | _ -> pure a 145 | -------------------------------------------------------------------------------- /src/URI/RelativeRef.purs: -------------------------------------------------------------------------------- 1 | module URI.RelativeRef 2 | ( RelativeRef(..) 3 | , RelativeRefOptions 4 | , RelativeRefParseOptions 5 | , RelativeRefPrintOptions 6 | , parser 7 | , print 8 | , _relPart 9 | , _query 10 | , _fragment 11 | , module URI.Fragment 12 | , module URI.Query 13 | , module URI.RelativePart 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Data.Array as Array 19 | import Data.Either (Either) 20 | import Data.Generic.Rep (class Generic) 21 | import Data.Lens (Lens', lens) 22 | import Data.Maybe (Maybe(..)) 23 | import Data.Show.Generic (genericShow) 24 | import Data.String as String 25 | import Parsing (Parser) 26 | import Parsing.Combinators (optionMaybe) 27 | import Parsing.String (eof) 28 | import URI.Common (URIPartParseError, wrapParser) 29 | import URI.Fragment (Fragment) 30 | import URI.Fragment as Fragment 31 | import URI.Query (Query) 32 | import URI.Query as Query 33 | import URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) 34 | import URI.RelativePart as RPart 35 | 36 | -- | A relative URI. Relative in the sense that it lacks a `Scheme` component. 37 | data RelativeRef userInfo hosts path relPath query fragment = RelativeRef (RelativePart userInfo hosts path relPath) (Maybe query) (Maybe fragment) 38 | 39 | derive instance eqRelativeRef :: (Eq userInfo, Eq hosts, Eq path, Eq relPath, Eq query, Eq fragment) => Eq (RelativeRef userInfo hosts path relPath query fragment) 40 | derive instance ordRelativeRef :: (Ord userInfo, Ord hosts, Ord path, Ord relPath, Ord query, Ord fragment) => Ord (RelativeRef userInfo hosts path relPath query fragment) 41 | derive instance genericRelativeRef :: Generic (RelativeRef userInfo hosts path relPath query fragment) _ 42 | 43 | instance showRelativeRef :: (Show userInfo, Show hosts, Show path, Show relPath, Show query, Show fragment) => Show (RelativeRef userInfo hosts path relPath query fragment) where 44 | show = genericShow 45 | 46 | -- | A row type for describing the options fields used by the relative URI 47 | -- | parser and printer. 48 | -- | 49 | -- | Used as `Record (RelativeRefOptions userInfo hosts path relPath query fragment)` 50 | -- | when type anotating an options record. 51 | -- | 52 | -- | See below for details of how to use these configuration options. 53 | type RelativeRefOptions userInfo hosts path relPath query fragment = 54 | RelativeRefParseOptions userInfo hosts path relPath query fragment 55 | (RelativeRefPrintOptions userInfo hosts path relPath query fragment ()) 56 | 57 | -- | A row type for describing the options fields used by the relative URI 58 | -- | parser. 59 | -- | 60 | -- | Used as `Record (RelativeRefParseOptions userInfo hosts path relPath query fragment ())` 61 | -- | when type anotating an options record. 62 | -- | 63 | -- | Having this options record allows custom representations to be used for 64 | -- | the URI components. If this is not necessary, `pure` can be used for all 65 | -- | the options aside from `parseHosts`, which will typically be 66 | -- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) 67 | -- | for more information on the host/port pair parser. 68 | type RelativeRefParseOptions userInfo hosts path relPath query fragment r = 69 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 70 | , parseHosts :: Parser String hosts 71 | , parsePath :: Path -> Either URIPartParseError path 72 | , parseRelPath :: Either PathAbsolute PathNoScheme -> Either URIPartParseError relPath 73 | , parseQuery :: Query -> Either URIPartParseError query 74 | , parseFragment :: Fragment -> Either URIPartParseError fragment 75 | | r 76 | ) 77 | 78 | -- | A row type for describing the options fields used by the relative URI 79 | -- | printer. 80 | -- | 81 | -- | As a reverse of the parse options, this specifies how to print values back 82 | -- | from custom representations. If this is not necessary, `identity` can be used for 83 | -- | all the options aside from `printHosts`, which will typically be 84 | -- | `HostPortPair.printHosts identity identity`. See [`URI.HostPortPair`](../URI.HostPortPair) 85 | -- | for more information on the host/port pair printer. 86 | type RelativeRefPrintOptions userInfo hosts path relPath query fragment r = 87 | ( printUserInfo :: userInfo -> UserInfo 88 | , printHosts :: hosts -> String 89 | , printPath :: path -> Path 90 | , printRelPath :: relPath -> Either PathAbsolute PathNoScheme 91 | , printQuery :: query -> Query 92 | , printFragment :: fragment -> Fragment 93 | | r 94 | ) 95 | 96 | -- | A parser for a relative URI. 97 | parser 98 | :: forall userInfo hosts path relPath query fragment r 99 | . Record (RelativeRefParseOptions userInfo hosts path relPath query fragment r) 100 | -> Parser String (RelativeRef userInfo hosts path relPath query fragment) 101 | parser opts = 102 | RelativeRef 103 | <$> RPart.parser opts 104 | <*> optionMaybe (wrapParser opts.parseQuery Query.parser) 105 | <*> optionMaybe (wrapParser opts.parseFragment Fragment.parser) 106 | <* eof 107 | 108 | -- | A printer for a relative URI. 109 | print 110 | :: forall userInfo hosts path relPath query fragment r 111 | . Record (RelativeRefPrintOptions userInfo hosts path relPath query fragment r) 112 | -> RelativeRef userInfo hosts path relPath query fragment 113 | -> String 114 | print opts (RelativeRef h q f) = 115 | String.joinWith "" $ Array.catMaybes 116 | [ Just (RPart.print opts h) 117 | , Query.print <<< opts.printQuery <$> q 118 | , Fragment.print <<< opts.printFragment <$> f 119 | ] 120 | 121 | -- | The relative-part component of a relative URI. 122 | _relPart :: forall userInfo hosts path relPath query fragment. Lens' (RelativeRef userInfo hosts path relPath query fragment) (RelativePart userInfo hosts path relPath) 123 | _relPart = 124 | lens 125 | (\(RelativeRef r _ _) -> r) 126 | (\(RelativeRef _ q f) r -> RelativeRef r q f) 127 | 128 | -- | The query component of a relative URI. 129 | _query :: forall userInfo hosts path relPath query fragment. Lens' (RelativeRef userInfo hosts path relPath query fragment) (Maybe query) 130 | _query = 131 | lens 132 | (\(RelativeRef _ q _) -> q) 133 | (\(RelativeRef r _ f) q -> RelativeRef r q f) 134 | 135 | -- | The fragment component of a relative URI. 136 | _fragment :: forall userInfo hosts path relPath query fragment. Lens' (RelativeRef userInfo hosts path relPath query fragment) (Maybe fragment) 137 | _fragment = 138 | lens 139 | (\(RelativeRef _ _ f) -> f) 140 | (\(RelativeRef r q _) f -> RelativeRef r q f) 141 | -------------------------------------------------------------------------------- /src/URI/Scheme.purs: -------------------------------------------------------------------------------- 1 | module URI.Scheme 2 | ( Scheme 3 | , fromString 4 | , toString 5 | , unsafeFromString 6 | , parser 7 | , print 8 | ) where 9 | 10 | import Prelude 11 | 12 | import Control.Alt ((<|>)) 13 | import Data.Either (hush) 14 | import Data.List as List 15 | import Data.Maybe (Maybe(..)) 16 | import Data.String.NonEmpty (NonEmptyString) 17 | import Data.String.NonEmpty (appendString, joinWith, toString) as NES 18 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 19 | import Partial.Unsafe (unsafeCrashWith) 20 | import Parsing (Parser, runParser) 21 | import Parsing.String (char, eof) 22 | import URI.Common (alpha, alphaNum) 23 | 24 | -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. 25 | newtype Scheme = Scheme NonEmptyString 26 | 27 | derive newtype instance eqScheme :: Eq Scheme 28 | derive newtype instance ordScheme :: Ord Scheme 29 | 30 | instance showScheme :: Show Scheme where 31 | show (Scheme s) = "(Scheme.unsafeFromString " <> show (NES.toString s) <> ")" 32 | 33 | -- | Attempts to create a `Scheme` from the passed string. The scheme component 34 | -- | of a URI has no escape sequences, so this function will return `Nothing` 35 | -- | if an invalid value is provided. 36 | -- | 37 | -- | ``` purescript 38 | -- | fromString "http" == Just (Scheme.unsafeFromString "http") 39 | -- | fromString "git+ssh" == Just (Scheme.unsafeFromString "git+ssh") 40 | -- | fromString "!!!" == Nothing 41 | -- | fromString "" == Nothing 42 | -- | ``` 43 | fromString :: String -> Maybe Scheme 44 | fromString = map Scheme <<< hush <<< flip runParser (parseScheme <* eof) 45 | 46 | -- | Returns the string value for a scheme. 47 | -- | 48 | -- | ``` purescript 49 | -- | toString (unsafeFromString "http") == "http" 50 | -- | toString (unsafeFromString "git+ssh") == "git+ssh" 51 | -- | ``` 52 | toString :: Scheme -> NonEmptyString 53 | toString (Scheme s) = s 54 | 55 | -- | Constructs a `Scheme` part unsafely: if the value is not an acceptable 56 | -- | scheme a runtime error will be thrown. 57 | -- | 58 | -- | This is intended as a convenience when describing `Scheme`s statically in 59 | -- | PureScript code, in all other cases `fromString` should be used. 60 | unsafeFromString :: String -> Scheme 61 | unsafeFromString s = case fromString s of 62 | Just s' -> s' 63 | Nothing -> unsafeCrashWith $ "Scheme value is invalid: `" <> show s <> "`" 64 | 65 | -- | A parser for the scheme component of a URI. Expects a scheme string 66 | -- | followed by `':'`. 67 | parser :: Parser String Scheme 68 | parser = Scheme <$> parseScheme <* char ':' 69 | 70 | parseScheme :: Parser String NonEmptyString 71 | parseScheme = do 72 | init <- alpha 73 | rest <- NES.joinWith "" <$> List.manyRec (NES.singleton <$> (alphaNum <|> char '+' <|> char '-' <|> char '.')) 74 | pure $ NES.singleton init `NES.appendString` rest 75 | 76 | -- | A printer for the scheme component of a URI. Prints a scheme value 77 | -- | followed by a `':'`. 78 | print :: Scheme -> String 79 | print (Scheme s) = NES.toString s <> ":" 80 | -------------------------------------------------------------------------------- /src/URI/Scheme/Common.purs: -------------------------------------------------------------------------------- 1 | -- | Common URI schemes, taken from the list of permanent URI schemes 2 | -- | [assigned by IANA](https://www.iana.org/assignments/uri-schemes/uri-schemes.xhtml). 3 | module URI.Scheme.Common where 4 | 5 | import URI.Scheme (Scheme, unsafeFromString) 6 | 7 | -- | Diameter Protocol ([RFC6733](https://tools.ietf.org/html/rfc6733)) 8 | aaa :: Scheme 9 | aaa = unsafeFromString "aaa" 10 | 11 | -- | Diameter Protocol with Secure ([RFC6733](https://tools.ietf.org/html/rfc6733)) 12 | aaas :: Scheme 13 | aaas = unsafeFromString "aaas" 14 | 15 | -- | about ([RFC6694](https://tools.ietf.org/html/rfc6694)) 16 | about :: Scheme 17 | about = unsafeFromString "about" 18 | 19 | -- | application configuration access ([RFC2244](https://tools.ietf.org/html/rfc2244)) 20 | acap :: Scheme 21 | acap = unsafeFromString "acap" 22 | 23 | -- | acct ([RFC7565](https://tools.ietf.org/html/rfc7565)) 24 | acct :: Scheme 25 | acct = unsafeFromString "acct" 26 | 27 | -- | Calendar Access Protocol ([RFC4324](https://tools.ietf.org/html/rfc4324)) 28 | cap :: Scheme 29 | cap = unsafeFromString "cap" 30 | 31 | -- | content identifier ([RFC2392](https://tools.ietf.org/html/rfc2392)) 32 | cid :: Scheme 33 | cid = unsafeFromString "cid" 34 | 35 | -- | coap ([RFC7252](https://tools.ietf.org/html/rfc7252)) 36 | coap :: Scheme 37 | coap = unsafeFromString "coap" 38 | 39 | -- | coap+tcp ([RFC8323](https://tools.ietf.org/html/rfc8323)) 40 | coaptcp :: Scheme 41 | coaptcp = unsafeFromString "coap+tcp" 42 | 43 | -- | coap+ws ([RFC8323](https://tools.ietf.org/html/rfc8323)) 44 | coapws :: Scheme 45 | coapws = unsafeFromString "coap+ws" 46 | 47 | -- | coaps ([RFC7252](https://tools.ietf.org/html/rfc7252)) 48 | coaps :: Scheme 49 | coaps = unsafeFromString "coaps" 50 | 51 | -- | coaps+tcp ([RFC8323](https://tools.ietf.org/html/rfc8323)) 52 | coapstcp :: Scheme 53 | coapstcp = unsafeFromString "coaps+tcp" 54 | 55 | -- | coaps+ws ([RFC8323](https://tools.ietf.org/html/rfc8323)) 56 | coapsws :: Scheme 57 | coapsws = unsafeFromString "coaps+ws" 58 | 59 | -- | TV-Anytime Content Reference ([RFC4078](https://tools.ietf.org/html/rfc4078)) 60 | crid :: Scheme 61 | crid = unsafeFromString "crid" 62 | 63 | -- | data ([RFC2397](https://tools.ietf.org/html/rfc2397)) 64 | data_ :: Scheme 65 | data_ = unsafeFromString "data" 66 | 67 | -- | dav ([RFC4918](https://tools.ietf.org/html/rfc4918)) 68 | dav :: Scheme 69 | dav = unsafeFromString "dav" 70 | 71 | -- | dictionary service protocol ([RFC2229](https://tools.ietf.org/html/rfc2229)) 72 | dict :: Scheme 73 | dict = unsafeFromString "dict" 74 | 75 | -- | Domain Name System ([RFC4501](https://tools.ietf.org/html/rfc4501)) 76 | dns :: Scheme 77 | dns = unsafeFromString "dns" 78 | 79 | -- | example ([RFC7595](https://tools.ietf.org/html/rfc7595)) 80 | example :: Scheme 81 | example = unsafeFromString "example" 82 | 83 | -- | Host-specific file names ([RFC8089](https://tools.ietf.org/html/rfc8089)) 84 | file :: Scheme 85 | file = unsafeFromString "file" 86 | 87 | -- | File Transfer Protocol ([RFC1738](https://tools.ietf.org/html/rfc1738)) 88 | ftp :: Scheme 89 | ftp = unsafeFromString "ftp" 90 | 91 | -- | Geographic Locations ([RFC5870](https://tools.ietf.org/html/rfc5870)) 92 | geo :: Scheme 93 | geo = unsafeFromString "geo" 94 | 95 | -- | go ([RFC3368](https://tools.ietf.org/html/rfc3368)) 96 | go :: Scheme 97 | go = unsafeFromString "go" 98 | 99 | -- | The Gopher Protocol ([RFC4266](https://tools.ietf.org/html/rfc4266)) 100 | gopher :: Scheme 101 | gopher = unsafeFromString "gopher" 102 | 103 | -- | H.323 ([RFC3508](https://tools.ietf.org/html/rfc3508)) 104 | h323 :: Scheme 105 | h323 = unsafeFromString "h323" 106 | 107 | -- | Hypertext Transfer Protocol ([RFC7230, Section 2.7.1](https://tools.ietf.org/html/rfc7230#section-2.7.1)) 108 | http :: Scheme 109 | http = unsafeFromString "http" 110 | 111 | -- | Hypertext Transfer Protocol Secure ([RFC7230, Section 2.7.2](https://tools.ietf.org/html/rfc7230#section-2.7.2)) 112 | https :: Scheme 113 | https = unsafeFromString "https" 114 | 115 | -- | Inter-Asterisk eXchange Version 2 ([RFC5456](https://tools.ietf.org/html/rfc5456)) 116 | iax :: Scheme 117 | iax = unsafeFromString "iax" 118 | 119 | -- | Internet Content Adaptation Protocol ([RFC3507](https://tools.ietf.org/html/rfc3507)) 120 | icap :: Scheme 121 | icap = unsafeFromString "icap" 122 | 123 | -- | Instant Messaging ([RFC3860](https://tools.ietf.org/html/rfc3860)) 124 | im :: Scheme 125 | im = unsafeFromString "im" 126 | 127 | -- | internet message access protocol ([RFC5092](https://tools.ietf.org/html/rfc5092)) 128 | imap :: Scheme 129 | imap = unsafeFromString "imap" 130 | 131 | -- | registry of public namespaces, which ([RFC4452](https://tools.ietf.org/html/rfc4452)) 132 | info :: Scheme 133 | info = unsafeFromString "info" 134 | 135 | -- | Internet Printing Protocol ([RFC3510](https://tools.ietf.org/html/rfc3510)) 136 | ipp :: Scheme 137 | ipp = unsafeFromString "ipp" 138 | 139 | -- | Internet Printing Protocol over ([RFC7472](https://tools.ietf.org/html/rfc7472)) 140 | ipps :: Scheme 141 | ipps = unsafeFromString "ipps" 142 | 143 | -- | Internet Registry Information ([RFC3981](https://tools.ietf.org/html/rfc3981)) 144 | iris :: Scheme 145 | iris = unsafeFromString "iris" 146 | 147 | -- | iris.beep ([RFC3983](https://tools.ietf.org/html/rfc3983)) 148 | irisbeep :: Scheme 149 | irisbeep = unsafeFromString "iris.beep" 150 | 151 | -- | iris.lwz ([RFC4993](https://tools.ietf.org/html/rfc4993)) 152 | irislwz :: Scheme 153 | irislwz = unsafeFromString "iris.lwz" 154 | 155 | -- | iris.xpc ([RFC4992](https://tools.ietf.org/html/rfc4992)) 156 | irisxpc :: Scheme 157 | irisxpc = unsafeFromString "iris.xpc" 158 | 159 | -- | iris.xpcs ([RFC4992](https://tools.ietf.org/html/rfc4992)) 160 | irisxpcs :: Scheme 161 | irisxpcs = unsafeFromString "iris.xpcs" 162 | 163 | -- | Lightweight Directory Access ([RFC4516](https://tools.ietf.org/html/rfc4516)) 164 | ldap :: Scheme 165 | ldap = unsafeFromString "ldap" 166 | 167 | -- | Electronic mail address ([RFC6068](https://tools.ietf.org/html/rfc6068)) 168 | mailto :: Scheme 169 | mailto = unsafeFromString "mailto" 170 | 171 | -- | message identifier ([RFC2392](https://tools.ietf.org/html/rfc2392)) 172 | mid :: Scheme 173 | mid = unsafeFromString "mid" 174 | 175 | -- | Message Session Relay Protocol ([RFC4975](https://tools.ietf.org/html/rfc4975)) 176 | msrp :: Scheme 177 | msrp = unsafeFromString "msrp" 178 | 179 | -- | Message Session Relay Protocol ([RFC4975](https://tools.ietf.org/html/rfc4975)) 180 | msrps :: Scheme 181 | msrps = unsafeFromString "msrps" 182 | 183 | -- | Message Tracking Query Protocol ([RFC3887](https://tools.ietf.org/html/rfc3887)) 184 | mtqp :: Scheme 185 | mtqp = unsafeFromString "mtqp" 186 | 187 | -- | Mailbox Update (MUPDATE) Protocol ([RFC3656](https://tools.ietf.org/html/rfc3656)) 188 | mupdate :: Scheme 189 | mupdate = unsafeFromString "mupdate" 190 | 191 | -- | USENET news ([RFC5538](https://tools.ietf.org/html/rfc5538)) 192 | news :: Scheme 193 | news = unsafeFromString "news" 194 | 195 | -- | network file system protocol ([RFC2224](https://tools.ietf.org/html/rfc2224)) 196 | nfs :: Scheme 197 | nfs = unsafeFromString "nfs" 198 | 199 | -- | ni ([RFC6920](https://tools.ietf.org/html/rfc6920)) 200 | ni :: Scheme 201 | ni = unsafeFromString "ni" 202 | 203 | -- | nih ([RFC6920](https://tools.ietf.org/html/rfc6920)) 204 | nih :: Scheme 205 | nih = unsafeFromString "nih" 206 | 207 | -- | USENET news using NNTP access ([RFC5538](https://tools.ietf.org/html/rfc5538)) 208 | nntp :: Scheme 209 | nntp = unsafeFromString "nntp" 210 | 211 | -- | opaquelocktokent ([RFC4918](https://tools.ietf.org/html/rfc4918)) 212 | opaquelocktoken :: Scheme 213 | opaquelocktoken = unsafeFromString "opaquelocktoken" 214 | 215 | -- | PKCS#11 ([RFC7512](https://tools.ietf.org/html/rfc7512)) 216 | pkcs11 :: Scheme 217 | pkcs11 = unsafeFromString "pkcs11" 218 | 219 | -- | Post Office Protocol v3 ([RFC2384](https://tools.ietf.org/html/rfc2384)) 220 | pop :: Scheme 221 | pop = unsafeFromString "pop" 222 | 223 | -- | Presence ([RFC3859](https://tools.ietf.org/html/rfc3859)) 224 | pres :: Scheme 225 | pres = unsafeFromString "pres" 226 | 227 | -- | reload ([RFC6940](https://tools.ietf.org/html/rfc6940)) 228 | reload :: Scheme 229 | reload = unsafeFromString "reload" 230 | 231 | -- | Real-Time Streaming Protocol (RTSP) ([RFC2326](https://tools.ietf.org/html/rfc2326), [RFC7826](https://tools.ietf.org/html/rfc7826)) 232 | rtsp :: Scheme 233 | rtsp = unsafeFromString "rtsp" 234 | 235 | -- | Real-Time Streaming Protocol (RTSP) ([RFC2326](https://tools.ietf.org/html/rfc2326), [RFC7826](https://tools.ietf.org/html/rfc7826)) 236 | rtsps :: Scheme 237 | rtsps = unsafeFromString "rtsps" 238 | 239 | -- | Real-Time Streaming Protocol (RTSP) ([RFC2326](https://tools.ietf.org/html/rfc2326)) 240 | rtspu :: Scheme 241 | rtspu = unsafeFromString "rtspu" 242 | 243 | -- | service location ([RFC2609](https://tools.ietf.org/html/rfc2609)) 244 | service :: Scheme 245 | service = unsafeFromString "service" 246 | 247 | -- | session ([RFC6787](https://tools.ietf.org/html/rfc6787)) 248 | session :: Scheme 249 | session = unsafeFromString "session" 250 | 251 | -- | Secure Hypertext Transfer Protocol ([RFC2660](https://tools.ietf.org/html/rfc2660)) 252 | shttp :: Scheme 253 | shttp = unsafeFromString "shttp" 254 | 255 | -- | ManageSieve Protocol ([RFC5804](https://tools.ietf.org/html/rfc5804)) 256 | sieve :: Scheme 257 | sieve = unsafeFromString "sieve" 258 | 259 | -- | session initiation protocol ([RFC3261](https://tools.ietf.org/html/rfc3261)) 260 | sip :: Scheme 261 | sip = unsafeFromString "sip" 262 | 263 | -- | secure session initiation protocol ([RFC3261](https://tools.ietf.org/html/rfc3261)) 264 | sips :: Scheme 265 | sips = unsafeFromString "sips" 266 | 267 | -- | Short Message Service ([RFC5724](https://tools.ietf.org/html/rfc5724)) 268 | sms :: Scheme 269 | sms = unsafeFromString "sms" 270 | 271 | -- | Simple Network Management Protocol ([RFC4088](https://tools.ietf.org/html/rfc4088)) 272 | snmp :: Scheme 273 | snmp = unsafeFromString "snmp" 274 | 275 | -- | soap.beep ([RFC4227](https://tools.ietf.org/html/rfc4227)) 276 | soapbeep :: Scheme 277 | soapbeep = unsafeFromString "soap.beep" 278 | 279 | -- | soap.beeps ([RFC4227](https://tools.ietf.org/html/rfc4227)) 280 | soapbeeps :: Scheme 281 | soapbeeps = unsafeFromString "soap.beeps" 282 | 283 | -- | stun ([RFC7064](https://tools.ietf.org/html/rfc7064)) 284 | stun :: Scheme 285 | stun = unsafeFromString "stun" 286 | 287 | -- | stuns ([RFC7064](https://tools.ietf.org/html/rfc7064)) 288 | stuns :: Scheme 289 | stuns = unsafeFromString "stuns" 290 | 291 | -- | tag ([RFC4151](https://tools.ietf.org/html/rfc4151)) 292 | tag :: Scheme 293 | tag = unsafeFromString "tag" 294 | 295 | -- | telephone ([RFC3966](https://tools.ietf.org/html/rfc3966)) 296 | tel :: Scheme 297 | tel = unsafeFromString "tel" 298 | 299 | -- | Reference to interactive sessions ([RFC4248](https://tools.ietf.org/html/rfc4248)) 300 | telnet :: Scheme 301 | telnet = unsafeFromString "telnet" 302 | 303 | -- | Trivial File Transfer Protocol ([RFC3617](https://tools.ietf.org/html/rfc3617)) 304 | tftp :: Scheme 305 | tftp = unsafeFromString "tftp" 306 | 307 | -- | multipart/related relative reference ([RFC2557](https://tools.ietf.org/html/rfc2557)) 308 | thismessage :: Scheme 309 | thismessage = unsafeFromString "thismessage" 310 | 311 | -- | Transaction Internet Protocol ([RFC2371](https://tools.ietf.org/html/rfc2371)) 312 | tip :: Scheme 313 | tip = unsafeFromString "tip" 314 | 315 | -- | Interactive 3270 emulation sessions ([RFC6270](https://tools.ietf.org/html/rfc6270)) 316 | tn3270 :: Scheme 317 | tn3270 = unsafeFromString "tn3270" 318 | 319 | -- | turn ([RFC7065](https://tools.ietf.org/html/rfc7065)) 320 | turn :: Scheme 321 | turn = unsafeFromString "turn" 322 | 323 | -- | turns ([RFC7065](https://tools.ietf.org/html/rfc7065)) 324 | turns :: Scheme 325 | turns = unsafeFromString "turns" 326 | 327 | -- | TV Broadcasts ([RFC2838](https://tools.ietf.org/html/rfc2838)) 328 | tv :: Scheme 329 | tv = unsafeFromString "tv" 330 | 331 | -- | Uniform Resource Names ([RFC8141](https://tools.ietf.org/html/rfc8141)) 332 | urn :: Scheme 333 | urn = unsafeFromString "urn" 334 | 335 | -- | versatile multimedia interface ([RFC2122](https://tools.ietf.org/html/rfc2122)) 336 | vemmi :: Scheme 337 | vemmi = unsafeFromString "vemmi" 338 | 339 | -- | Remote Framebuffer Protocol ([RFC7869](https://tools.ietf.org/html/rfc7869)) 340 | vnc :: Scheme 341 | vnc = unsafeFromString "vnc" 342 | 343 | -- | WebSocket connections ([RFC6455](https://tools.ietf.org/html/rfc6455)) 344 | ws :: Scheme 345 | ws = unsafeFromString "ws" 346 | 347 | -- | Encrypted WebSocket connections ([RFC6455](https://tools.ietf.org/html/rfc6455)) 348 | wss :: Scheme 349 | wss = unsafeFromString "wss" 350 | 351 | -- | xcon ([RFC6501](https://tools.ietf.org/html/rfc6501)) 352 | xcon :: Scheme 353 | xcon = unsafeFromString "xcon" 354 | 355 | -- | xcon-userid ([RFC6501](https://tools.ietf.org/html/rfc6501)) 356 | xconuserid :: Scheme 357 | xconuserid = unsafeFromString "xcon-userid" 358 | 359 | -- | xmlrpc.beep ([RFC3529](https://tools.ietf.org/html/rfc3529)) 360 | xmlrpcbeep :: Scheme 361 | xmlrpcbeep = unsafeFromString "xmlrpc.beep" 362 | 363 | -- | xmlrpc.beeps ([RFC3529](https://tools.ietf.org/html/rfc3529)) 364 | xmlrpcbeeps :: Scheme 365 | xmlrpcbeeps = unsafeFromString "xmlrpc.beeps" 366 | 367 | -- | Extensible Messaging and Presence ([RFC5122](https://tools.ietf.org/html/rfc5122)) 368 | xmpp :: Scheme 369 | xmpp = unsafeFromString "xmpp" 370 | 371 | -- | Z39.50 Retrieval ([RFC2056](https://tools.ietf.org/html/rfc2056)) 372 | z3950r :: Scheme 373 | z3950r = unsafeFromString "z39.50r" 374 | 375 | -- | Z39.50 Session ([RFC2056](https://tools.ietf.org/html/rfc2056)) 376 | z3950s :: Scheme 377 | z3950s = unsafeFromString "z39.50s" 378 | -------------------------------------------------------------------------------- /src/URI/URI.purs: -------------------------------------------------------------------------------- 1 | module URI.URI 2 | ( URI(..) 3 | , URIOptions 4 | , URIParseOptions 5 | , URIPrintOptions 6 | , parser 7 | , print 8 | , _scheme 9 | , _hierPart 10 | , _query 11 | , _fragment 12 | , module URI.HierarchicalPart 13 | , module URI.Query 14 | , module URI.Scheme 15 | ) where 16 | 17 | import Prelude 18 | 19 | import Data.Array as Array 20 | import Data.Either (Either) 21 | import Data.Generic.Rep (class Generic) 22 | import Data.Lens (Lens', lens) 23 | import Data.Maybe (Maybe(..)) 24 | import Data.Show.Generic (genericShow) 25 | import Data.String as String 26 | import Parsing (Parser) 27 | import Parsing.Combinators (optionMaybe) 28 | import Parsing.String (eof) 29 | import URI.Common (URIPartParseError, wrapParser) 30 | import URI.Fragment (Fragment) 31 | import URI.Fragment as Fragment 32 | import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) 33 | import URI.HierarchicalPart as HPart 34 | import URI.Query (Query) 35 | import URI.Query as Query 36 | import URI.Scheme (Scheme) 37 | import URI.Scheme as Scheme 38 | 39 | -- | A general purpose absolute URI - similar to `AbsoluteURI` but also admits 40 | -- | a fragment component. An absolute URI can still contain relative paths 41 | -- | but is required to have a `Scheme` component. 42 | data URI userInfo hosts path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) (Maybe fragment) 43 | 44 | derive instance eqURI :: (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query, Eq fragment) => Eq (URI userInfo hosts path hierPath query fragment) 45 | derive instance ordURI :: (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord query, Ord fragment) => Ord (URI userInfo hosts path hierPath query fragment) 46 | derive instance genericURI :: Generic (URI userInfo hosts path hierPath query fragment) _ 47 | instance showURI :: (Show userInfo, Show hosts, Show path, Show hierPath, Show query, Show fragment) => Show (URI userInfo hosts path hierPath query fragment) where 48 | show = genericShow 49 | 50 | -- | A row type for describing the options fields used by the URI parser and 51 | -- | printer. 52 | -- | 53 | -- | Used as `Record (URIOptions userInfo hosts path hierPath query fragment)` 54 | -- | when type anotating an options record. 55 | -- | 56 | -- | See below for details of how to use these configuration options. 57 | type URIOptions userInfo hosts path hierPath query fragment = 58 | URIParseOptions userInfo hosts path hierPath query fragment 59 | (URIPrintOptions userInfo hosts path hierPath query fragment ()) 60 | 61 | -- | A row type for describing the options fields used by the URI parser. 62 | -- | 63 | -- | Used as `Record (URIParseOptions userInfo hosts path hierPath query fragment ())` 64 | -- | when type anotating an options record. 65 | -- | 66 | -- | Having this options record allows custom representations to be used for 67 | -- | the URI components. If this is not necessary, `pure` can be used for all 68 | -- | the options aside from `parseHosts`, which will typically be 69 | -- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) 70 | -- | for more information on the host/port pair parser. 71 | type URIParseOptions userInfo hosts path hierPath query fragment r = 72 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 73 | , parseHosts :: Parser String hosts 74 | , parsePath :: Path -> Either URIPartParseError path 75 | , parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError hierPath 76 | , parseQuery :: Query -> Either URIPartParseError query 77 | , parseFragment :: Fragment -> Either URIPartParseError fragment 78 | | r 79 | ) 80 | 81 | -- | A row type for describing the options fields used by the URI printer. 82 | -- | 83 | -- | Used as `Record (URIPrintOptions userInfo hosts path hierPath query fragment ())` 84 | -- | when type anotating an options record. 85 | -- | 86 | -- | As a reverse of the parse options, this specifies how to print values back 87 | -- | from custom representations. If this is not necessary, `identity` can be used for 88 | -- | all the options aside from `printHosts`, which will typically be 89 | -- | `HostPortPair.printHosts identity identity`. See [`URI.HostPortPair`](../URI.HostPortPair) 90 | -- | for more information on the host/port pair printer. 91 | type URIPrintOptions userInfo hosts path hierPath query fragment r = 92 | ( printUserInfo :: userInfo -> UserInfo 93 | , printHosts :: hosts -> String 94 | , printPath :: path -> Path 95 | , printHierPath :: hierPath -> Either PathAbsolute PathRootless 96 | , printQuery :: query -> Query 97 | , printFragment :: fragment -> Fragment 98 | | r 99 | ) 100 | 101 | -- | A parser for a URI. 102 | parser 103 | :: forall userInfo hosts path hierPath query fragment r 104 | . Record (URIParseOptions userInfo hosts path hierPath query fragment r) 105 | -> Parser String (URI userInfo hosts path hierPath query fragment) 106 | parser opts = 107 | URI 108 | <$> Scheme.parser 109 | <*> HPart.parser opts 110 | <*> optionMaybe (wrapParser opts.parseQuery Query.parser) 111 | <*> optionMaybe (wrapParser opts.parseFragment Fragment.parser) 112 | <* eof 113 | 114 | -- | A printer for a URI. 115 | print 116 | :: forall userInfo hosts path hierPath query fragment r 117 | . Record (URIPrintOptions userInfo hosts path hierPath query fragment r) 118 | -> URI userInfo hosts path hierPath query fragment 119 | -> String 120 | print opts (URI s h q f) = 121 | String.joinWith "" $ Array.catMaybes 122 | [ Just (Scheme.print s) 123 | , Just (HPart.print opts h) 124 | , Query.print <<< opts.printQuery <$> q 125 | , Fragment.print <<< opts.printFragment <$> f 126 | ] 127 | 128 | -- | The scheme component of a URI. 129 | _scheme :: forall userInfo hosts path hierPath query fragment. Lens' (URI userInfo hosts path hierPath query fragment) Scheme 130 | _scheme = 131 | lens 132 | (\(URI s _ _ _) -> s) 133 | (\(URI _ h q f) s -> URI s h q f) 134 | 135 | -- | The hierarchical-part component of a URI. 136 | _hierPart :: forall userInfo hosts path hierPath query fragment. Lens' (URI userInfo hosts path hierPath query fragment) (HierarchicalPart userInfo hosts path hierPath) 137 | _hierPart = 138 | lens 139 | (\(URI _ h _ _) -> h) 140 | (\(URI s _ q f) h -> URI s h q f) 141 | 142 | -- | The query component of a URI. 143 | _query :: forall userInfo hosts path hierPath query fragment. Lens' (URI userInfo hosts path hierPath query fragment) (Maybe query) 144 | _query = 145 | lens 146 | (\(URI _ _ q _) -> q) 147 | (\(URI s h _ f) q -> URI s h q f) 148 | 149 | -- | The fragment component of a URI. 150 | _fragment :: forall userInfo hosts path hierPath query fragment. Lens' (URI userInfo hosts path hierPath query fragment) (Maybe fragment) 151 | _fragment = 152 | lens 153 | (\(URI _ _ _ f) -> f) 154 | (\(URI s h q _) f -> URI s h q f) 155 | -------------------------------------------------------------------------------- /src/URI/URIRef.purs: -------------------------------------------------------------------------------- 1 | module URI.URIRef 2 | ( URIRef 3 | , URIRefOptions 4 | , URIRefParseOptions 5 | , URIRefPrintOptions 6 | , parser 7 | , print 8 | , module URI.Authority 9 | , module URI.Fragment 10 | , module URI.Host 11 | , module URI.Path 12 | , module URI.Path.Absolute 13 | , module URI.Path.NoScheme 14 | , module URI.Path.Rootless 15 | , module URI.Port 16 | , module URI.Query 17 | , module URI.RelativeRef 18 | , module URI.Scheme 19 | , module URI.URI 20 | , module URI.UserInfo 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Control.Alt ((<|>)) 26 | import Data.Either (Either(..), either) 27 | import Parsing (Parser) 28 | import Parsing.Combinators (try) 29 | import URI.Authority (Authority(..)) 30 | import URI.Common (URIPartParseError) 31 | import URI.Fragment (Fragment) 32 | import URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) 33 | import URI.Path (Path(..)) 34 | import URI.Path.Absolute (PathAbsolute(..)) 35 | import URI.Path.NoScheme (PathNoScheme(..)) 36 | import URI.Path.Rootless (PathRootless(..)) 37 | import URI.Port (Port) 38 | import URI.Query (Query) 39 | import URI.RelativeRef (RelativeRef(..), RelativePart(..), RelPath) 40 | import URI.RelativeRef as RelativeRef 41 | import URI.Scheme (Scheme) 42 | import URI.URI (URI(..), HierarchicalPart(..), HierPath) 43 | import URI.URI as URI 44 | import URI.UserInfo (UserInfo) 45 | 46 | -- | The most general kind of URI, can either be relative or absolute. 47 | type URIRef userInfo hosts path hierPath relPath query fragment = 48 | Either 49 | (URI.URI userInfo hosts path hierPath query fragment) 50 | (RelativeRef.RelativeRef userInfo hosts path relPath query fragment) 51 | 52 | -- | A row type for describing the options fields used by the general URI 53 | -- | parser and printer. 54 | -- | 55 | -- | Used as `Record (URIRefOptions userInfo hosts path hierPath relPath query fragment)` 56 | -- | when type anotating an options record. 57 | -- | 58 | -- | See below for details of how to use these configuration options. 59 | type URIRefOptions userInfo hosts path hierPath relPath query fragment = 60 | URIRefParseOptions userInfo hosts path hierPath relPath query fragment 61 | (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment ()) 62 | 63 | -- | A row type for describing the options fields used by the general URI 64 | -- | parser. 65 | -- | 66 | -- | Used as `Record (URIRefParseOptions userInfo hosts path hierPath relPath query fragment ())` 67 | -- | when type anotating an options record. 68 | -- | 69 | -- | Having this options record allows custom representations to be used for 70 | -- | the URI components. If this is not necessary, `pure` can be used for all 71 | -- | the options aside from `parseHosts`, which will typically be 72 | -- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) 73 | -- | for more information on the host/port pair parser. 74 | type URIRefParseOptions userInfo hosts path hierPath relPath query fragment r = 75 | ( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo 76 | , parseHosts :: Parser String hosts 77 | , parsePath :: Path -> Either URIPartParseError path 78 | , parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError hierPath 79 | , parseRelPath :: Either PathAbsolute PathNoScheme -> Either URIPartParseError relPath 80 | , parseQuery :: Query -> Either URIPartParseError query 81 | , parseFragment :: Fragment -> Either URIPartParseError fragment 82 | | r 83 | ) 84 | 85 | -- | A row type for describing the options fields used by the general URI 86 | -- | printer. 87 | -- | 88 | -- | Used as `Record (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment ())` 89 | -- | when type anotating an options record. 90 | -- | 91 | -- | As a reverse of the parse options, this specifies how to print values back 92 | -- | from custom representations. If this is not necessary, `id` can be used for 93 | -- | all the options aside from `printHosts`, which will typically be 94 | -- | `HostPortPair.printHosts id id`. See [`URI.HostPortPair`](../URI.HostPortPair) 95 | -- | for more information on the host/port pair printer. 96 | type URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r = 97 | ( printUserInfo :: userInfo -> UserInfo 98 | , printHosts :: hosts -> String 99 | , printPath :: path -> Path 100 | , printHierPath :: hierPath -> Either PathAbsolute PathRootless 101 | , printRelPath :: relPath -> Either PathAbsolute PathNoScheme 102 | , printQuery :: query -> Query 103 | , printFragment :: fragment -> Fragment 104 | | r 105 | ) 106 | 107 | -- | A parser for a general URI. 108 | parser 109 | :: forall userInfo hosts path hierPath relPath query fragment r 110 | . Record (URIRefParseOptions userInfo hosts path hierPath relPath query fragment r) 111 | -> Parser String (URIRef userInfo hosts path hierPath relPath query fragment) 112 | parser opts = try (Left <$> URI.parser opts) <|> (Right <$> RelativeRef.parser opts) 113 | 114 | -- | A printer for a general URI. 115 | print 116 | :: forall userInfo hosts path hierPath relPath query fragment r 117 | . Record (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r) 118 | -> URIRef userInfo hosts path hierPath relPath query fragment 119 | -> String 120 | print opts = either (URI.print opts) (RelativeRef.print opts) 121 | -------------------------------------------------------------------------------- /src/URI/UserInfo.purs: -------------------------------------------------------------------------------- 1 | module URI.UserInfo 2 | ( UserInfo 3 | , fromString 4 | , toString 5 | , unsafeFromString 6 | , unsafeToString 7 | , parser 8 | , print 9 | , userInfoChar 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Control.Alt ((<|>)) 15 | import Data.Array.NonEmpty as NEA 16 | import Data.String.NonEmpty (NonEmptyString) 17 | import Data.String.NonEmpty.CodeUnits (singleton) as NES 18 | import Data.String.NonEmpty (join1With, toString) as NES 19 | import Parsing (Parser) 20 | import Parsing.String (char) 21 | import URI.Common (decodeURIComponent', subDelims, unreserved, pctEncoded, printEncoded') 22 | 23 | -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. 24 | -- | 25 | -- | This type treats the entire string as an undifferentiated blob, if you 26 | -- | would like to specifically deal with the `user:password` format, take a 27 | -- | look at `URI.Extra.UserPassInfo`. 28 | newtype UserInfo = UserInfo NonEmptyString 29 | 30 | derive newtype instance eqUserInfo :: Eq UserInfo 31 | derive newtype instance ordUserInfo :: Ord UserInfo 32 | derive newtype instance semigroupUserInfo :: Semigroup UserInfo 33 | 34 | instance showUserInfo :: Show UserInfo where 35 | show (UserInfo s) = "(UserInfo.unsafeFromString " <> show s <> ")" 36 | 37 | -- | Constructs a user-info value from a string, percent-encoding any characters 38 | -- | that require it. Note that running this on a string that has already had 39 | -- | percent-encoding applied will double-encode it, for those situations use 40 | -- | `unsafeFromString` instead. 41 | -- | 42 | -- | ``` purescript 43 | -- | fromString "foo" = unsafeFromString "foo" 44 | -- | fromString "foo@bar" = unsafeFromString "foo%40bar" 45 | -- | fromString "foo%40bar" = unsafeFromString "foo%2540bar" 46 | -- | ``` 47 | fromString :: NonEmptyString -> UserInfo 48 | fromString = UserInfo <<< printEncoded' userInfoChar 49 | 50 | -- | Returns the string value for user-info, percent-decoding any characters 51 | -- | that require it. 52 | -- | 53 | -- | ``` purescript 54 | -- | toString (unsafeFromString "foo") = "foo" 55 | -- | toString (unsafeFromString "foo%40bar") = "foo@bar" 56 | -- | ``` 57 | toString :: UserInfo -> NonEmptyString 58 | toString (UserInfo s) = decodeURIComponent' s 59 | 60 | -- | Constructs a user-info value from a string directly - no percent-encoding 61 | -- | will be applied. This is useful when using a custom encoding scheme for 62 | -- | the query, to prevent double-encoding. 63 | unsafeFromString :: NonEmptyString -> UserInfo 64 | unsafeFromString = UserInfo 65 | 66 | -- | Returns the string value for user-info without percent-decoding. Only 67 | -- | "unsafe" in the sense that values this produces may need further decoding, 68 | -- | the name is more for symmetry with the `fromString`/`unsafeFromString` 69 | -- | pairing. 70 | unsafeToString :: UserInfo -> NonEmptyString 71 | unsafeToString (UserInfo s) = s 72 | 73 | -- | A parser for the user-info component of a URI. 74 | parser :: Parser String UserInfo 75 | parser = UserInfo <<< NES.join1With "" <$> NEA.some parse 76 | where 77 | parse :: Parser String NonEmptyString 78 | parse = NES.singleton <$> userInfoChar <|> pctEncoded 79 | 80 | -- | A printer for the user-info component of a URI. 81 | print :: UserInfo -> String 82 | print = NES.toString <<< unsafeToString 83 | 84 | -- | The supported user info characters, excluding percent-encodings. 85 | userInfoChar :: Parser String Char 86 | userInfoChar = unreserved <|> subDelims <|> char ':' 87 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Aff (launchAff_) 7 | import Control.Monad.Reader (runReaderT) 8 | import Test.URI.AbsoluteURI as AbsoluteURI 9 | import Test.URI.Authority as Authority 10 | import Test.URI.Extra.MultiHostPortPair as Extra.MultiHostPortPair 11 | import Test.URI.Extra.QueryPairs as Extra.QueryPairs 12 | import Test.URI.Extra.UserPassInfo as Extra.UserPassInfo 13 | import Test.URI.Fragment as Fragment 14 | import Test.URI.Host as Host 15 | import Test.URI.Path as Path 16 | import Test.URI.Port as Port 17 | import Test.URI.Scheme as Scheme 18 | import Test.URI.URIRef as URIRef 19 | import Test.URI.UserInfo as UserInfo 20 | 21 | main :: Effect Unit 22 | main = launchAff_ $ flip runReaderT 0 do 23 | Scheme.spec 24 | UserInfo.spec 25 | Host.spec 26 | Port.spec 27 | Fragment.spec 28 | Authority.spec 29 | Path.spec 30 | URIRef.spec 31 | AbsoluteURI.spec 32 | Extra.QueryPairs.spec 33 | Extra.MultiHostPortPair.spec 34 | Extra.UserPassInfo.spec 35 | -------------------------------------------------------------------------------- /test/Spec.purs: -------------------------------------------------------------------------------- 1 | module Test.Spec where 2 | 3 | import Prelude 4 | 5 | import Effect.Aff (Aff) 6 | import Effect.Console (log) 7 | import Effect.Class (class MonadEffect, liftEffect) 8 | import Effect.Exception (Error, error) 9 | import Data.Monoid (power, guard) 10 | import Control.Monad.Reader (ReaderT) 11 | import Control.Monad.Reader.Class (ask, local) 12 | import Control.Monad.Error.Class (class MonadThrow, throwError) 13 | import Test.Assert (assertEqual) 14 | 15 | ----------------------------------------------------------------- 16 | -- Provides a similar API to purescript-spec, but without a dependency 17 | 18 | type Spec a = ReaderT Int Aff a 19 | 20 | describe :: String -> Spec Unit -> Spec Unit 21 | describe msg runTest = do 22 | indentation <- ask 23 | let spacing = guard (indentation > 0) " " 24 | liftEffect $ log $ (power ">>" indentation) <> spacing <> msg 25 | local (_ + 1) runTest 26 | 27 | it :: String -> Spec Unit -> Spec Unit 28 | it = describe 29 | 30 | shouldEqual :: forall m a. MonadEffect m => Eq a => Show a => a -> a -> m Unit 31 | shouldEqual actual expected = liftEffect $ assertEqual { actual, expected } 32 | 33 | fail :: forall m. MonadThrow Error m => String -> m Unit 34 | fail = throwError <<< error 35 | -------------------------------------------------------------------------------- /test/URI/AbsoluteURI.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.AbsoluteURI where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.String.NonEmpty (nes) 8 | import Type.Proxy (Proxy(..)) 9 | import Data.These (These(..)) 10 | import Data.Tuple (Tuple(..)) 11 | import Test.Spec (Spec, describe) 12 | import Test.Util (testIso) 13 | import URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port, Query, AbsoluteURI(..), AbsoluteURIOptions, UserInfo) 14 | import URI.AbsoluteURI as AbsoluteURI 15 | import URI.Host.RegName as RegName 16 | import URI.HostPortPair (HostPortPair) 17 | import URI.HostPortPair as HostPortPair 18 | import URI.Path.Segment as PathSegment 19 | import URI.Port as Port 20 | import URI.Query as Query 21 | import URI.Scheme as Scheme 22 | 23 | spec :: Spec Unit 24 | spec = 25 | describe "AbsoluteURI parser/printer" do 26 | testIso 27 | (AbsoluteURI.parser options) 28 | (AbsoluteURI.print options) 29 | "couchbase://localhost/testBucket?password=&docTypeKey=" 30 | ( AbsoluteURI 31 | (Scheme.unsafeFromString "couchbase") 32 | ( HierarchicalPartAuth 33 | ( Authority 34 | Nothing 35 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))))) 36 | ) 37 | (path [ "testBucket" ]) 38 | ) 39 | (Just (Query.unsafeFromString "password=&docTypeKey=")) 40 | ) 41 | 42 | testIso 43 | (AbsoluteURI.parser options) 44 | (AbsoluteURI.print options) 45 | "couchbase://localhost:9999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" 46 | ( AbsoluteURI 47 | (Scheme.unsafeFromString "couchbase") 48 | ( HierarchicalPartAuth 49 | ( Authority 50 | Nothing 51 | (Just (Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))) (Port.unsafeFromInt 9999))) 52 | ) 53 | (path [ "testBucket" ]) 54 | ) 55 | (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20")) 56 | ) 57 | 58 | testIso 59 | (AbsoluteURI.parser options) 60 | (AbsoluteURI.print options) 61 | "foo:/abc/def" 62 | ( AbsoluteURI 63 | (Scheme.unsafeFromString "foo") 64 | ( HierarchicalPartNoAuth 65 | (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "abc")) [ PathSegment.unsafeSegmentFromString "def" ]))))) 66 | ) 67 | Nothing 68 | ) 69 | 70 | testIso 71 | (AbsoluteURI.parser options) 72 | (AbsoluteURI.print options) 73 | "foo:abc/def" 74 | ( AbsoluteURI 75 | (Scheme.unsafeFromString "foo") 76 | ( HierarchicalPartNoAuth 77 | (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "abc")) [ PathSegment.unsafeSegmentFromString "def" ])))) 78 | ) 79 | Nothing 80 | ) 81 | 82 | path :: Array String -> Path 83 | path = Path <<< map PathSegment.unsafeSegmentFromString 84 | 85 | options :: Record (AbsoluteURIOptions UserInfo (HostPortPair Host Port) Path HierPath Query) 86 | options = 87 | { parseUserInfo: pure 88 | , printUserInfo: identity 89 | , parseHosts: HostPortPair.parser pure pure 90 | , printHosts: HostPortPair.print identity identity 91 | , parsePath: pure 92 | , printPath: identity 93 | , parseHierPath: pure 94 | , printHierPath: identity 95 | , parseQuery: pure 96 | , printQuery: identity 97 | } 98 | -------------------------------------------------------------------------------- /test/URI/Authority.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Authority where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.String.NonEmpty (nes) 7 | import Type.Proxy (Proxy(..)) 8 | import Data.These (These(..)) 9 | import Test.Spec (Spec, describe) 10 | import Test.Util (testIso) 11 | import URI.Authority (Authority(..), AuthorityOptions, Host(..), Port, UserInfo) 12 | import URI.Authority as Authority 13 | import URI.Host.RegName as RegName 14 | import URI.HostPortPair (HostPortPair) 15 | import URI.HostPortPair as HostPortPair 16 | import URI.Port as Port 17 | import URI.UserInfo as UserInfo 18 | 19 | spec :: Spec Unit 20 | spec = 21 | describe "Authority parser/printer" do 22 | testIso 23 | (Authority.parser options) 24 | (Authority.print options) 25 | "//localhost" 26 | ( Authority 27 | Nothing 28 | (Just (This (NameAddress (RegName.unsafeFromString (nes (Proxy :: Proxy "localhost")))))) 29 | ) 30 | 31 | testIso 32 | (Authority.parser options) 33 | (Authority.print options) 34 | "//localhost:3000" 35 | ( Authority 36 | Nothing 37 | (Just (Both (NameAddress (RegName.unsafeFromString (nes (Proxy :: Proxy "localhost")))) (Port.unsafeFromInt 3000))) 38 | ) 39 | 40 | testIso 41 | (Authority.parser options) 42 | (Authority.print options) 43 | "//user@localhost:3000" 44 | ( Authority 45 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "user")))) 46 | (Just (Both (NameAddress (RegName.unsafeFromString (nes (Proxy :: Proxy "localhost")))) (Port.unsafeFromInt 3000))) 47 | ) 48 | 49 | testIso 50 | (Authority.parser options) 51 | (Authority.print options) 52 | "//:8000" 53 | (Authority Nothing (Just (That (Port.unsafeFromInt 8000)))) 54 | 55 | options :: Record (AuthorityOptions UserInfo (HostPortPair Host Port)) 56 | options = 57 | { parseUserInfo: pure 58 | , printUserInfo: identity 59 | , parseHosts: HostPortPair.parser pure pure 60 | , printHosts: HostPortPair.print identity identity 61 | } 62 | -------------------------------------------------------------------------------- /test/URI/Extra/MultiHostPortPair.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Extra.MultiHostPortPair where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.String.NonEmpty (nes) 8 | import Type.Proxy (Proxy(..)) 9 | import Data.These (These(..)) 10 | import Test.Spec (Spec, describe) 11 | import Test.Util (testIso) 12 | import URI.Authority (Authority(..), Host(..), Port, UserInfo) 13 | import URI.Authority as Authority 14 | import URI.Extra.MultiHostPortPair (MultiHostPortPair) 15 | import URI.Extra.MultiHostPortPair as MultiHostPortPair 16 | import URI.Host.IPv4Address as IPv4Address 17 | import URI.Host.RegName as RegName 18 | import URI.Path.Segment as PathSegment 19 | import URI.Port as Port 20 | import URI.Query as Query 21 | import URI.Scheme as Scheme 22 | import URI.URIRef (Fragment, HierPath, HierarchicalPart(..), Path(..), Query, RelPath, URI(..), URIRefOptions) 23 | import URI.URIRef as URIRef 24 | import URI.UserInfo as UserInfo 25 | 26 | spec :: Spec Unit 27 | spec = do 28 | describe "Authority+MultiHostPortPair parser/printer" do 29 | testIso 30 | (Authority.parser options) 31 | (Authority.print options) 32 | "//mongo-1,mongo-2" 33 | ( Authority 34 | Nothing 35 | [ This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-1"))) 36 | , This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-2"))) 37 | ] 38 | ) 39 | 40 | testIso 41 | (Authority.parser options) 42 | (Authority.print options) 43 | "//mongo-1:2000,mongo-2:3000" 44 | ( Authority 45 | Nothing 46 | [ Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-1"))) (Port.unsafeFromInt 2000) 47 | , Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-2"))) (Port.unsafeFromInt 3000) 48 | ] 49 | ) 50 | 51 | testIso 52 | (Authority.parser options) 53 | (Authority.print options) 54 | "//mongo-1:2000,mongo-2" 55 | ( Authority 56 | Nothing 57 | [ Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-1"))) (Port.unsafeFromInt 2000) 58 | , This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-2"))) 59 | ] 60 | ) 61 | 62 | testIso 63 | (Authority.parser options) 64 | (Authority.print options) 65 | "//mongo-1,mongo-2:3000" 66 | ( Authority 67 | Nothing 68 | [ This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-1"))) 69 | , Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-2"))) (Port.unsafeFromInt 3000) 70 | ] 71 | ) 72 | 73 | testIso 74 | (Authority.parser options) 75 | (Authority.print options) 76 | "//:2000,:3000" 77 | ( Authority 78 | Nothing 79 | [ That (Port.unsafeFromInt 2000) 80 | , That (Port.unsafeFromInt 3000) 81 | ] 82 | ) 83 | 84 | testIso 85 | (Authority.parser options) 86 | (Authority.print options) 87 | "//user@mongo-1,mongo-2" 88 | ( Authority 89 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "user")))) 90 | [ This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-1"))) 91 | , This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "mongo-2"))) 92 | ] 93 | ) 94 | 95 | describe "URIRef+MultiHostPortPair parser/printer" do 96 | testIso 97 | (URIRef.parser options) 98 | (URIRef.print options) 99 | "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" 100 | ( Left 101 | ( URI 102 | (Scheme.unsafeFromString "mongodb") 103 | ( HierarchicalPartAuth 104 | ( Authority 105 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "foo:bar")))) 106 | [ This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "db1.example.net"))) 107 | , Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "db2.example.net"))) (Port.unsafeFromInt 2500) 108 | ] 109 | ) 110 | (path [ "authdb" ]) 111 | ) 112 | (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) 113 | Nothing 114 | ) 115 | ) 116 | 117 | testIso 118 | (URIRef.parser options) 119 | (URIRef.print options) 120 | "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" 121 | ( Left 122 | ( URI 123 | (Scheme.unsafeFromString "mongodb") 124 | ( HierarchicalPartAuth 125 | ( Authority 126 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "foo:bar")))) 127 | [ Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "db1.example.net"))) (Port.unsafeFromInt 6) 128 | , Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "db2.example.net"))) (Port.unsafeFromInt 2500) 129 | ] 130 | ) 131 | (path [ "authdb" ]) 132 | ) 133 | (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) 134 | Nothing 135 | ) 136 | ) 137 | 138 | testIso 139 | (URIRef.parser options) 140 | (URIRef.print options) 141 | "mongodb://192.168.0.1,192.168.0.2" 142 | ( Left 143 | ( URI 144 | (Scheme.unsafeFromString "mongodb") 145 | ( HierarchicalPartAuth 146 | ( Authority 147 | Nothing 148 | [ This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) 149 | , This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 2)) 150 | ] 151 | ) 152 | (path []) 153 | ) 154 | Nothing 155 | Nothing 156 | ) 157 | ) 158 | 159 | path :: Array String -> Path 160 | path = Path <<< map PathSegment.unsafeSegmentFromString 161 | 162 | options :: Record (URIRefOptions UserInfo (MultiHostPortPair Host Port) Path HierPath RelPath Query Fragment) 163 | options = 164 | { parseUserInfo: pure 165 | , printUserInfo: identity 166 | , parseHosts: MultiHostPortPair.parser pure pure 167 | , printHosts: MultiHostPortPair.print identity identity 168 | , parsePath: pure 169 | , printPath: identity 170 | , parseHierPath: pure 171 | , printHierPath: identity 172 | , parseRelPath: pure 173 | , printRelPath: identity 174 | , parseQuery: pure 175 | , printQuery: identity 176 | , parseFragment: pure 177 | , printFragment: identity 178 | } 179 | -------------------------------------------------------------------------------- /test/URI/Extra/QueryPairs.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Extra.QueryPairs where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Tuple (Tuple(..)) 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Util (forAll, testIso) 9 | import Test.QuickCheck ((===)) 10 | import Test.QuickCheck.Arbitrary (arbitrary) 11 | import URI.Common (wrapParser) 12 | import URI.Extra.QueryPairs as NQP 13 | import URI.Query as Query 14 | 15 | spec :: Spec Unit 16 | spec = do 17 | describe "valueFromString" do 18 | it "should not throw exceptions for any inputs" do 19 | forAll do 20 | unencoded <- arbitrary 21 | pure $ NQP.valueFromString unencoded === NQP.valueFromString unencoded 22 | 23 | describe "QueryPairs printer/parser" do 24 | let parser = wrapParser (NQP.parse pure pure) Query.parser 25 | let printer = Query.print <<< NQP.print identity identity 26 | 27 | testIso parser printer 28 | "?key1=value1&key2=value2&key1=value3" 29 | ( NQP.QueryPairs 30 | [ Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "value1")) 31 | , Tuple (NQP.unsafeKeyFromString "key2") (Just (NQP.unsafeValueFromString "value2")) 32 | , Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "value3")) 33 | ] 34 | ) 35 | 36 | testIso parser printer 37 | "?k%3Dey=value%3D1%3B2" 38 | ( NQP.QueryPairs 39 | [ Tuple (NQP.unsafeKeyFromString "k%3Dey") (Just (NQP.unsafeValueFromString "value%3D1%3B2")) ] 40 | ) 41 | 42 | testIso parser printer 43 | "?k%3Dey=value%3D1%3B2" 44 | ( NQP.QueryPairs 45 | [ Tuple (NQP.keyFromString "k=ey") (Just (NQP.valueFromString "value=1;2")) ] 46 | ) 47 | 48 | testIso parser printer 49 | "?" 50 | (NQP.QueryPairs []) 51 | 52 | testIso parser printer 53 | "?key1=&key2=" 54 | ( NQP.QueryPairs 55 | [ Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "")) 56 | , Tuple (NQP.unsafeKeyFromString "key2") (Just (NQP.unsafeValueFromString "")) 57 | ] 58 | ) 59 | 60 | testIso parser printer 61 | "?key1&key2" 62 | ( NQP.QueryPairs 63 | [ Tuple (NQP.unsafeKeyFromString "key1") Nothing 64 | , Tuple (NQP.unsafeKeyFromString "key2") Nothing 65 | ] 66 | ) 67 | 68 | testIso parser printer 69 | "?key1=foo%3Bbar" 70 | ( NQP.QueryPairs 71 | [ Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "foo%3Bbar")) 72 | ] 73 | ) 74 | 75 | testIso parser printer 76 | "?replicaSet=test&connectTimeoutMS=300000" 77 | ( NQP.QueryPairs 78 | [ Tuple (NQP.unsafeKeyFromString "replicaSet") (Just (NQP.unsafeValueFromString "test")) 79 | , Tuple (NQP.unsafeKeyFromString "connectTimeoutMS") (Just (NQP.unsafeValueFromString "300000")) 80 | ] 81 | ) 82 | 83 | testIso parser printer 84 | "?fred" 85 | ( NQP.QueryPairs 86 | [ Tuple (NQP.unsafeKeyFromString "fred") Nothing ] 87 | ) 88 | 89 | testIso parser printer 90 | "?objectClass?one" 91 | ( NQP.QueryPairs 92 | [ Tuple (NQP.unsafeKeyFromString "objectClass?one") Nothing 93 | ] 94 | ) 95 | 96 | testIso parser printer 97 | "?password=&docTypeKey=" 98 | ( NQP.QueryPairs 99 | [ Tuple (NQP.unsafeKeyFromString "password") (Just (NQP.unsafeValueFromString "")) 100 | , Tuple (NQP.unsafeKeyFromString "docTypeKey") (Just (NQP.unsafeValueFromString "")) 101 | ] 102 | ) 103 | 104 | testIso parser printer 105 | "?password=pass&docTypeKey=type&queryTimeoutSeconds=20" 106 | ( NQP.QueryPairs 107 | [ Tuple (NQP.unsafeKeyFromString "password") (Just (NQP.unsafeValueFromString "pass")) 108 | , Tuple (NQP.unsafeKeyFromString "docTypeKey") (Just (NQP.unsafeValueFromString "type")) 109 | , Tuple (NQP.unsafeKeyFromString "queryTimeoutSeconds") (Just (NQP.unsafeValueFromString "20")) 110 | ] 111 | ) 112 | 113 | testIso parser printer 114 | ("?code=" <> longCode) 115 | ( NQP.QueryPairs 116 | [ Tuple (NQP.unsafeKeyFromString "code") (Just (NQP.unsafeValueFromString longCode)) 117 | ] 118 | ) 119 | where 120 | longCode = "eyJraWRiOiJjcGlTY29yZV8wOTI1MjAxNSNsInZlciI6IjEuMCIsInppcCI6IkRlZmxhdGUiLCJzZXIiOiIxLjAifQ..POoi6BeVmzh85nqw.2DBovxH_VhgEn0KQ67VlAOgPmJYxqJN-R4mrN45jGRL6Z4MiQQxn1xHmrgnvkWZ4zbTaUE8BtPoJw7nke6pLtiQqwo9y7Sf4MkkSuVbEg2b1lfmZ1gOCfRLFzAW5mWQrPEs5Vie4cjnhOZi-EkgQUQVP73apF8yjhKIZlrLdrbJV9ta8yf394rXKHeLUBU19F4tpf7zSKSJBBRfQDyouL4FbReRmnR9UHR6sixkOteNChJDoV0mnrPHPgaxaNpGLx4a1tR9DRdQnaqYUTMR0cbTEoJ1IfObKfPGdftJ2G_rsqfs9xGbmsow5BhAmF4CC9vzHtNvgPt_-N7Tz3mkTxhmX67tNT3YAgsRamduk9j_5h6aiTckh7XwcBhDbgp0PoyEXZ9mXatghLtJRZ-7B72WPKYTZs2jkF1Ir1E950I6sc2m3uw09zaGYFmxjSba-BipPD_lMzyVfIYThF_kHDHNspYb77ilhMuOhVsBkJ_-sQxPf5KdjzSGkLkgPBaZ8cCdgnantGc_DJWfl-NJWKZLNZ6w3j6nCWW4c19wjXrG-h2C8rseudSoLy_IGQSsV-4uQLKwBSRMvfmk7ysLlfBFfHD4z3XGbuyJ2vsEzVOJngl-Ynyiac8nHt8yr7pi3Bvsi9CfsYKzMbxXBreQ3EM0pzOIdnPp5IgdfOMYU0wShE4OVspmP2ppiBcWZdrD55gYNgaHjD0jJWSJR80uPEx7nt2KW3JToXBcb0MxUcDa_2A0EbsOU578NZct4MEJsVDBdfGRC6XB55g7ZNwrYCmlzMeWt2nI_QIZArNM-5dfqjlvL7uvsKQg37gJDpCdNPWV1DVC3FAU1AVwZLeyYLk2CwN4OlGxXWLfxdo6-hgAg6_mS9HXZj05Krb4geV5MiSNCHIx3IPWe_LcXlRaZCjBO8YVipIZkpyh-JQywFl2lexb-t1M1450JozXry6Afd5ek4OrZpAlFI-KDP7y1RbgBoqYloySGGvTYItclFw7gsST42B1D1OWDDWacS9p6C-xl6wDONzRXU3xOBhifLJL6JGboZIadcupYl5AKh18MivIrt5oSd2BaLuMzax9YqSYJ2U8WpYp3QRkLbokhLq_D_whV-0R6zjDHk8t3zGXiRj9JXazTcirf8emYuigMaVOW9m6KcUeHhUM_gn4oATmZ3WfvnVqSSz72j8p_GwRM3P9C_nn1jOAuxA5j66KTpQTgLj7HIkTP-sm30qIe5PwWaWQrbPenI_Zfu03JMqTXiQOCVxSwmkjYbQkWYq7p1-0Ct4Wqwt7cyfMYnDhD8JZauIO2XA5eLuTRJm3ZEYclq0IStGx_HwJSERJtuHHOGQlnEYGxKAyYb8X9jwlHe4WYwQN9Sg7uIYVDUZ5R5k_Ol5KP2jyQLO0m9aRu2-pF05w8GDU52FJnjh2LvvQXkPH2pgY2rx65sss4hqj7B0h--WdFCGpT3cLSKJndJ6XfrF8uKGf_6WvQdcxggBkckeO1pkU9etll-Aq_Dxh6St0PCgegH9Do2QXfY6X0iEnZ5-r4BGmV3HjlFwtcAR5PDv8F71wmuz2GQbZnnQBrgtBIIkILHAAnBiVy-8Tl2QmKlkieEhISrju1fMSNnc5ZQ_vggqpeN47wTzsklY0z6liAfVMsvpoCAJm-g4FroYbVSha33Lc6lUv6jxIhdveidFzKDi8Sh_i8H3XwXI68FzgmSQDzOrZkAcPkoJItq_EROxy4KC-i7KZviZMVefQ0Fktd41fM0ik5LwWl5PgGKoFy_Cy8VsMMMsOurYGBj8YdjDxzz6wqOVbNPcPuLqJHJY9StEtqqhwVCwdfGqVSD_VPn6B_3RTXKQSGt5fCXIJNvY8170HTfyioE-ixPfBErTIny5FLiSokqmrTvCH3l1XfCd2Ee8zoLaUqnzOOOE4467vFVuxZ4CfIQLt6jIxJ0Tb0BOTIBkOELFjEZ0owEiX63eaxRF7f2sst78HN1V1NzEf1WNdbikJmE1TPX1KXNIaF2nEVpfVxVN3aWUu_nNzOUVLEF55dnrTJdgy8wsF7wRtflW1GfFOfA_D2im2dDCg688R3LcVjddpg-VYwuZ7FH00xXWkoy85h9aCX8OnmfahNpuwyBcXkYDx8X4pATt-ZW6XOK7eajZnKJedMrlVFv2Ll7dwnyv74p8fYXF85ilTgRJeE5j7Tkss1gt5zHjihLJq_256DhMKMTFyTa6D_Hp0MH5HqP6SoTE8qzFSvHz_skRtVgmOrtAJ4-ZGfhXuDFhqMTehmmIF9oCirWs7qZHq2stgYoNgmIAyqgCXkvt39YEkaUhnBdt71URQ9XjCPToLSnUmcaFhV2kzoj7PkunTa4saS0ARvDXP_z3mEZ-e9II-ASwfScJV6OqyDABeuKGkxOB_ddUxnXyL1F2K0X1qzi1kJ-TVmLDseN805hl3gqPOvbdh65mAPrDw4713a3LRsOiRfDjDmR3GE3QxyTYrXFGMiGShhuCjZBZKkqw4OJqX9alY9HrwvIk7wcBlXYUcjU5G1qUK0jP8ozRRAiyO8QRVkkI830NAF52RuhxKshkx7gGQaNLU-pQGv8aPCXi2rosYJfhqlqEQ16yhezRAh2591jCLNCcDP-XXIUyrrpWZO3nHvTUfsovFJlGYrwugPulF7PSoNBBuX7rYbLaORdGB8Hi3iFnRo_tJ-kBcH03aNOLWaRO0bLFmJveJjtPsTmIbSr6wKiYxfmROMjrHDI-_ATj7x6pDJUU2IAqauZgAUYZ_ddK1z7N76CkRtXnAj1LmsEULoyVqYjTo6ggKWBnamUEltVWPHuY3IuLsmpda2kdd7--KektSvGct0aJLc84gqQdJeQCeoIQ0pSeYHMwEU61AdZk6a2xQtKZwUOvLbp5DGXgHCqx9H3H0Qj_u-iVcEEgozY3NerPkTr_AsAUGVE1vT4HrUje0sxdE_X4d5CKXafuKd4POHTVs9Y4T7icdMn4rShSnyc4NiFzUyw89-rcf014jm1ll7bQSuRMsvs9x96hvXhC1syoBR3wSt9cRnHQuEPBr48eNwtd7vgmXVPFFRa5vF_Hl8pU0e8tvuCwB2HFO6dMoHAKKlp199goNTv7Y2xF0c1jx0QbuZ0MlcVatwZsBpqbgd6_WJZn4768uKAALHJOIDkNvquq3h8nOzlpmtjNn5cGcfzHuaqwj3qiuVboA14WoJ-FT4vr_enTHO_zoeLZVUmVLR9t36Yc5dg7teuAAn9lfUukHJ1mTbMZaFBtQj6kUHWJKc_T5vHdoVFTTdTex--RQUxc97NnknlPqKOuKOO2ECyYuW8ygt4IcP4iSMWQmdXS74TEdg8I9Qtc42rzYgwb16phKPv1GpXYdCHDl-SXe9EnY2FQJiWBFYTFIOwl4PKmygbaHO2qgYtx4MUsLFiEvfgabxGqP_UBUUlPvp3iWWYvbsNqHD0sS-M9gdwGtS7ejPs9ika2NHKiOjJrJKEPjpkHuY1pdmAu5WhzH2GvXECTKrJRJhxIQoBhLxrBUVDr9iXBdDUoT3NIVuqg56HDjVinD4KG8aba5klnPibYcDtUXgssoE1rEKcfCEN8gR7-Xf20y1hQ8vhC34ayVAUVTVW3V5LoOcdSqcRJR71PiVKjTVRDrP9KdQCUWzsb0toQ950x14yGzk6cI0ZRgiKx-sRjTWlb5c2QzuD22vLGF9mWjGH-4NPhlrasr5PcdXeNmpBEZU_xKEujeuveE7GIzbMfZ-_E45Rlqflcn5ZdIK0-0HMjrZ_sjnuQ.ZjIHxProSKoNwD6Py-8FOQ" 121 | -------------------------------------------------------------------------------- /test/URI/Extra/UserPassInfo.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Extra.UserPassInfo where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.String.NonEmpty (nes) 7 | import Type.Proxy (Proxy(..)) 8 | import Data.These (These(..)) 9 | import Test.Spec (Spec, describe) 10 | import Test.Util (testIso) 11 | import URI.Authority (Authority(..), Host(..), Port) 12 | import URI.Authority as Authority 13 | import URI.Extra.UserPassInfo (UserPassInfo(..)) 14 | import URI.Extra.UserPassInfo as UserPassInfo 15 | import URI.Host.RegName as RegName 16 | import URI.HostPortPair (HostPortPair) 17 | import URI.HostPortPair as HostPortPair 18 | import URI.URIRef (Fragment, HierPath, Path, Query, RelPath, URIRefOptions) 19 | 20 | spec :: Spec Unit 21 | spec = do 22 | describe "Authority+UserPassInfo parser/printer" do 23 | testIso 24 | (Authority.parser options) 25 | (Authority.print options) 26 | "//user@host" 27 | ( Authority 28 | (Just (UserPassInfo { user: nes (Proxy :: Proxy "user"), password: Nothing })) 29 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "host"))))) 30 | ) 31 | 32 | testIso 33 | (Authority.parser options) 34 | (Authority.print options) 35 | "//user:pass@host" 36 | ( Authority 37 | (Just (UserPassInfo { user: nes (Proxy :: Proxy "user"), password: Just (nes (Proxy :: Proxy "pass")) })) 38 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "host"))))) 39 | ) 40 | 41 | testIso 42 | (Authority.parser options) 43 | (Authority.print options) 44 | "//user:pa%3Ass@host" 45 | ( Authority 46 | (Just (UserPassInfo { user: nes (Proxy :: Proxy "user"), password: Just (nes (Proxy :: Proxy "pa:ss")) })) 47 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "host"))))) 48 | ) 49 | 50 | testIso 51 | (Authority.parser options) 52 | (Authority.print options) 53 | "//us%3Aer:pa%3Ass@host" 54 | ( Authority 55 | (Just (UserPassInfo { user: nes (Proxy :: Proxy "us:er"), password: Just (nes (Proxy :: Proxy "pa:ss")) })) 56 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "host"))))) 57 | ) 58 | 59 | testIso 60 | (Authority.parser options) 61 | (Authority.print options) 62 | "//us%3Aer:pa%3Ass@host" 63 | ( Authority 64 | (Just (UserPassInfo { user: nes (Proxy :: Proxy "us:er"), password: Just (nes (Proxy :: Proxy "pa:ss")) })) 65 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "host"))))) 66 | ) 67 | 68 | testIso 69 | (Authority.parser options) 70 | (Authority.print options) 71 | "//user:p%40ss@host" 72 | ( Authority 73 | (Just (UserPassInfo { user: nes (Proxy :: Proxy "user"), password: Just (nes (Proxy :: Proxy "p@ss")) })) 74 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "host"))))) 75 | ) 76 | 77 | options :: Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) 78 | options = 79 | { parseUserInfo: UserPassInfo.parse 80 | , printUserInfo: UserPassInfo.print 81 | , parseHosts: HostPortPair.parser pure pure 82 | , printHosts: HostPortPair.print identity identity 83 | , parsePath: pure 84 | , printPath: identity 85 | , parseHierPath: pure 86 | , printHierPath: identity 87 | , parseRelPath: pure 88 | , printRelPath: identity 89 | , parseQuery: pure 90 | , printQuery: identity 91 | , parseFragment: pure 92 | , printFragment: identity 93 | } 94 | -------------------------------------------------------------------------------- /test/URI/Fragment.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Fragment where 2 | 3 | import Prelude 4 | 5 | import Test.Spec (Spec, describe) 6 | import Test.Util (testIso) 7 | import URI.Fragment as Fragment 8 | 9 | spec :: Spec Unit 10 | spec = 11 | describe "Fragment parser/printer" do 12 | testIso Fragment.parser Fragment.print "#" (Fragment.fromString "") 13 | testIso Fragment.parser Fragment.print "#foo" (Fragment.fromString "foo") 14 | testIso Fragment.parser Fragment.print "#foo%23bar" (Fragment.fromString "foo#bar") 15 | testIso Fragment.parser Fragment.print "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") 16 | -------------------------------------------------------------------------------- /test/URI/Host.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Host where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Data.String.NonEmpty (nes) 7 | import Type.Proxy (Proxy(..)) 8 | import Test.QuickCheck ((===)) 9 | import Test.Spec (Spec, describe, it, shouldEqual) 10 | import Test.Util (forAll, testIso) 11 | import Parsing (runParser) 12 | import URI.Host (Host(..)) 13 | import URI.Host as Host 14 | import URI.Host.Gen as Host.Gen 15 | import URI.Host.IPv4Address as IPv4Address 16 | import URI.Host.IPv6Address as IPv6Address 17 | import URI.Host.RegName as RegName 18 | 19 | spec :: Spec Unit 20 | spec = do 21 | describe "Host parser/printer" do 22 | testIso Host.parser Host.print "localhost" (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))) 23 | testIso Host.parser Host.print "github.com" (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "github.com"))) 24 | testIso Host.parser Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "www.multipart.domain.example.com"))) 25 | testIso Host.parser Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) 26 | testIso Host.parser Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) 27 | 28 | describe "IPv4Address" do 29 | 30 | it "should successfully roundtrip values sent through Host parse/print" do 31 | forAll do 32 | ipv4 <- Host.Gen.genIPv4 33 | let printed = IPv4Address.print ipv4 34 | let parsed = runParser printed Host.parser 35 | pure $ pure (IPv4Address ipv4) === parsed 36 | 37 | it "should not parse 0-lead octets as an IP address" do 38 | shouldEqual 39 | (Right (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "192.168.001.1")))) 40 | (runParser "192.168.001.1" Host.parser) 41 | 42 | describe "NameAddress" do 43 | 44 | it "should uphold toString / fromString property" do 45 | forAll do 46 | regName <- Host.Gen.genRegName 47 | pure $ RegName.fromString (RegName.toString regName) === regName 48 | -------------------------------------------------------------------------------- /test/URI/Path.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Path where 2 | 3 | import Prelude 4 | 5 | import Test.Spec (Spec, describe) 6 | import Test.Util (testIso) 7 | import URI.Path (Path(..)) 8 | import URI.Path as Path 9 | import URI.Path.Segment as PathSegment 10 | 11 | spec :: Spec Unit 12 | spec = 13 | describe "Path parser/printer" do 14 | testIso Path.parser Path.print "/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23" (Path [ PathSegment.segmentFromString "Пациенты# #" ]) 15 | -------------------------------------------------------------------------------- /test/URI/Port.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Port where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Test.QuickCheck ((===)) 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Util (forAll, testIso) 9 | import URI.Port as Port 10 | import URI.Port.Gen as Port.Gen 11 | 12 | spec :: Spec Unit 13 | spec = 14 | describe "Port parser/printer" do 15 | testIso Port.parser Port.print ":0" (Port.unsafeFromInt 0) 16 | testIso Port.parser Port.print ":1234" (Port.unsafeFromInt 1234) 17 | testIso Port.parser Port.print ":63174" (Port.unsafeFromInt 63174) 18 | 19 | it "should uphold toString / fromString property" do 20 | forAll do 21 | port <- Port.Gen.genPort 22 | pure $ Port.fromInt (Port.toInt port) === Just port 23 | -------------------------------------------------------------------------------- /test/URI/Scheme.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.Scheme where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Data.String.NonEmpty as NES 7 | import Test.Spec (Spec, describe, it) 8 | import Test.Util (testIso, equal) 9 | import URI.Scheme as Scheme 10 | 11 | spec :: Spec Unit 12 | spec = do 13 | describe "Scheme parser/printer" do 14 | testIso Scheme.parser Scheme.print "http:" (Scheme.unsafeFromString "http") 15 | testIso Scheme.parser Scheme.print "git+ssh:" (Scheme.unsafeFromString "git+ssh") 16 | describe "Scheme fromString/toString" do 17 | it "http" do 18 | let http = Scheme.unsafeFromString "http" 19 | equal (Just http) $ Scheme.fromString $ NES.toString $ Scheme.toString http 20 | it "git+ssh" do 21 | let git = Scheme.unsafeFromString "git+ssh" 22 | equal (Just git) $ Scheme.fromString $ NES.toString $ Scheme.toString git 23 | -------------------------------------------------------------------------------- /test/URI/URIRef.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.URIRef where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.String.NonEmpty (nes) 8 | import Type.Proxy (Proxy(..)) 9 | import Data.These (These(..)) 10 | import Data.Tuple (Tuple(..)) 11 | import Test.Spec (Spec, describe) 12 | import Test.Util (testIso) 13 | import URI.Fragment as Fragment 14 | import URI.Host.IPv4Address as IPv4Address 15 | import URI.Host.IPv6Address as IPv6Address 16 | import URI.Host.RegName as RegName 17 | import URI.HostPortPair (HostPortPair) 18 | import URI.HostPortPair as HostPortPair 19 | import URI.Path.Segment as PathSegment 20 | import URI.Port as Port 21 | import URI.Query as Query 22 | import URI.Scheme as Scheme 23 | import URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port, Query, RelPath, RelativePart(..), RelativeRef(..), URI(..), URIRefOptions, UserInfo) 24 | import URI.URIRef as URIRef 25 | import URI.UserInfo as UserInfo 26 | 27 | spec :: Spec Unit 28 | spec = 29 | describe "URIRef parser/printer" do 30 | testIso 31 | (URIRef.parser options) 32 | (URIRef.print options) 33 | "sql2:///?q=foo&var.bar=baz" 34 | ( Left 35 | ( URI 36 | (Scheme.unsafeFromString "sql2") 37 | ( HierarchicalPartAuth 38 | (Authority Nothing Nothing) 39 | (path [ "" ]) 40 | ) 41 | (Just (Query.unsafeFromString "q=foo&var.bar=baz")) 42 | Nothing 43 | ) 44 | ) 45 | 46 | testIso 47 | (URIRef.parser options) 48 | (URIRef.print options) 49 | "sql2://?q=foo&var.bar=baz" 50 | ( Left 51 | ( URI 52 | (Scheme.unsafeFromString "sql2") 53 | ( HierarchicalPartAuth 54 | (Authority Nothing Nothing) 55 | (path []) 56 | ) 57 | (Just (Query.unsafeFromString "q=foo&var.bar=baz")) 58 | Nothing 59 | ) 60 | ) 61 | 62 | testIso 63 | (URIRef.parser options) 64 | (URIRef.print options) 65 | "sql2:/?q=foo&var.bar=baz" 66 | ( Left 67 | ( URI 68 | (Scheme.unsafeFromString "sql2") 69 | (HierarchicalPartNoAuth (Just (Left (PathAbsolute Nothing)))) 70 | (Just (Query.unsafeFromString "q=foo&var.bar=baz")) 71 | Nothing 72 | ) 73 | ) 74 | 75 | testIso 76 | (URIRef.parser options) 77 | (URIRef.print options) 78 | "sql2:?q=foo&var.bar=baz" 79 | ( Left 80 | ( URI 81 | (Scheme.unsafeFromString "sql2") 82 | (HierarchicalPartNoAuth Nothing) 83 | (Just (Query.unsafeFromString "q=foo&var.bar=baz")) 84 | Nothing 85 | ) 86 | ) 87 | 88 | testIso 89 | (URIRef.parser options) 90 | (URIRef.print options) 91 | "mongodb://localhost" 92 | ( Left 93 | ( URI 94 | (Scheme.unsafeFromString "mongodb") 95 | ( HierarchicalPartAuth 96 | ( Authority 97 | Nothing 98 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))))) 99 | ) 100 | (path []) 101 | ) 102 | Nothing 103 | Nothing 104 | ) 105 | ) 106 | 107 | testIso 108 | (URIRef.parser options) 109 | (URIRef.print options) 110 | "https://1a.example.com" 111 | ( Left 112 | ( URI 113 | (Scheme.unsafeFromString "https") 114 | ( HierarchicalPartAuth 115 | ( Authority 116 | Nothing 117 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "1a.example.com"))))) 118 | ) 119 | (path []) 120 | ) 121 | Nothing 122 | Nothing 123 | ) 124 | ) 125 | 126 | testIso 127 | (URIRef.parser options) 128 | (URIRef.print options) 129 | "http://en.wikipedia.org/wiki/URI_scheme" 130 | ( Left 131 | ( URI 132 | (Scheme.unsafeFromString "http") 133 | ( HierarchicalPartAuth 134 | ( Authority 135 | Nothing 136 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "en.wikipedia.org"))))) 137 | ) 138 | (path [ "wiki", "URI_scheme" ]) 139 | ) 140 | Nothing 141 | Nothing 142 | ) 143 | ) 144 | 145 | testIso 146 | (URIRef.parser options) 147 | (URIRef.print options) 148 | "mongodb://192.168.0.1" 149 | ( Left 150 | ( URI 151 | (Scheme.unsafeFromString "mongodb") 152 | ( HierarchicalPartAuth 153 | ( Authority 154 | Nothing 155 | (Just (This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)))) 156 | ) 157 | (path []) 158 | ) 159 | Nothing 160 | Nothing 161 | ) 162 | ) 163 | 164 | testIso 165 | (URIRef.parser options) 166 | (URIRef.print options) 167 | "mongodb://sysop:moon@localhost" 168 | ( Left 169 | ( URI 170 | (Scheme.unsafeFromString "mongodb") 171 | ( HierarchicalPartAuth 172 | ( Authority 173 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "sysop:moon")))) 174 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))))) 175 | ) 176 | (path []) 177 | ) 178 | Nothing 179 | Nothing 180 | ) 181 | ) 182 | 183 | testIso 184 | (URIRef.parser options) 185 | (URIRef.print options) 186 | "mongodb://sysop:moon@localhost/" 187 | ( Left 188 | ( URI 189 | (Scheme.unsafeFromString "mongodb") 190 | ( HierarchicalPartAuth 191 | ( Authority 192 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "sysop:moon")))) 193 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))))) 194 | ) 195 | (path [ "" ]) 196 | ) 197 | Nothing 198 | Nothing 199 | ) 200 | ) 201 | 202 | testIso 203 | (URIRef.parser options) 204 | (URIRef.print options) 205 | "mongodb://sysop:moon@localhost/records" 206 | ( Left 207 | ( URI 208 | (Scheme.unsafeFromString "mongodb") 209 | ( HierarchicalPartAuth 210 | ( Authority 211 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "sysop:moon")))) 212 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))))) 213 | ) 214 | (path [ "records" ]) 215 | ) 216 | Nothing 217 | Nothing 218 | ) 219 | ) 220 | 221 | testIso 222 | (URIRef.parser options) 223 | (URIRef.print options) 224 | "mongodb://sysop:moon@localhost/records/etc/" 225 | ( Left 226 | ( URI 227 | (Scheme.unsafeFromString "mongodb") 228 | ( HierarchicalPartAuth 229 | ( Authority 230 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "sysop:moon")))) 231 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))))) 232 | ) 233 | (path [ "records", "etc", "" ]) 234 | ) 235 | Nothing 236 | Nothing 237 | ) 238 | ) 239 | 240 | testIso 241 | (URIRef.parser options) 242 | (URIRef.print options) 243 | "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" 244 | ( Left 245 | ( URI 246 | (Scheme.unsafeFromString "foo") 247 | ( HierarchicalPartAuth 248 | ( Authority 249 | Nothing 250 | (Just (This (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")))) 251 | ) 252 | (path []) 253 | ) 254 | Nothing 255 | Nothing 256 | ) 257 | ) 258 | 259 | testIso 260 | (URIRef.parser options) 261 | (URIRef.print options) 262 | "foo://[FE80::0202:B3FF:FE1E:8329]" 263 | ( Left 264 | ( URI 265 | (Scheme.unsafeFromString "foo") 266 | ( HierarchicalPartAuth 267 | ( Authority 268 | Nothing 269 | (Just (This (IPv6Address (IPv6Address.unsafeFromString "FE80::0202:B3FF:FE1E:8329")))) 270 | ) 271 | (path []) 272 | ) 273 | Nothing 274 | Nothing 275 | ) 276 | ) 277 | 278 | testIso 279 | (URIRef.parser options) 280 | (URIRef.print options) 281 | "foo://[2001:db8::1]:80" 282 | ( Left 283 | ( URI 284 | (Scheme.unsafeFromString "foo") 285 | ( HierarchicalPartAuth 286 | ( Authority 287 | Nothing 288 | (Just (Both (IPv6Address (IPv6Address.unsafeFromString "2001:db8::1")) (Port.unsafeFromInt 80))) 289 | ) 290 | (path []) 291 | ) 292 | Nothing 293 | Nothing 294 | ) 295 | ) 296 | 297 | testIso 298 | (URIRef.parser options) 299 | (URIRef.print options) 300 | "ftp://ftp.is.co.za/rfc/rfc1808.txt" 301 | ( Left 302 | ( URI 303 | (Scheme.unsafeFromString "ftp") 304 | ( HierarchicalPartAuth 305 | ( Authority 306 | Nothing 307 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "ftp.is.co.za"))))) 308 | ) 309 | (path [ "rfc", "rfc1808.txt" ]) 310 | ) 311 | Nothing 312 | Nothing 313 | ) 314 | ) 315 | 316 | testIso 317 | (URIRef.parser options) 318 | (URIRef.print options) 319 | "http://www.ietf.org/rfc/rfc2396.txt" 320 | ( Left 321 | ( URI 322 | (Scheme.unsafeFromString "http") 323 | ( HierarchicalPartAuth 324 | ( Authority 325 | Nothing 326 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "www.ietf.org"))))) 327 | ) 328 | (path [ "rfc", "rfc2396.txt" ]) 329 | ) 330 | Nothing 331 | Nothing 332 | ) 333 | ) 334 | 335 | testIso 336 | (URIRef.parser options) 337 | (URIRef.print options) 338 | "ldap://[2001:db8::7]/c=GB?objectClass?one" 339 | ( Left 340 | ( URI 341 | (Scheme.unsafeFromString "ldap") 342 | ( HierarchicalPartAuth 343 | ( Authority 344 | Nothing 345 | (Just (This (IPv6Address (IPv6Address.unsafeFromString "2001:db8::7")))) 346 | ) 347 | (path [ "c=GB" ]) 348 | ) 349 | (Just (Query.unsafeFromString "objectClass?one")) 350 | Nothing 351 | ) 352 | ) 353 | 354 | testIso 355 | (URIRef.parser options) 356 | (URIRef.print options) 357 | "telnet://192.0.2.16:80/" 358 | ( Left 359 | ( URI 360 | (Scheme.unsafeFromString "telnet") 361 | ( HierarchicalPartAuth 362 | ( Authority 363 | Nothing 364 | (Just (Both (IPv4Address (IPv4Address.unsafeFromInts 192 0 2 16)) (Port.unsafeFromInt 80))) 365 | ) 366 | (path [ "" ]) 367 | ) 368 | Nothing 369 | Nothing 370 | ) 371 | ) 372 | 373 | testIso 374 | (URIRef.parser options) 375 | (URIRef.print options) 376 | "foo://example.com:8042/over/there?name=ferret#nose" 377 | ( Left 378 | ( URI 379 | (Scheme.unsafeFromString "foo") 380 | ( HierarchicalPartAuth 381 | ( Authority 382 | Nothing 383 | (Just (Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "example.com"))) (Port.unsafeFromInt 8042))) 384 | ) 385 | (path [ "over", "there" ]) 386 | ) 387 | (Just (Query.unsafeFromString "name=ferret")) 388 | (Just (Fragment.unsafeFromString "nose")) 389 | ) 390 | ) 391 | 392 | testIso 393 | (URIRef.parser options) 394 | (URIRef.print options) 395 | "foo://example.com:8042/over/there?name=ferret#" 396 | ( Left 397 | ( URI 398 | (Scheme.unsafeFromString "foo") 399 | ( HierarchicalPartAuth 400 | ( Authority 401 | Nothing 402 | (Just (Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "example.com"))) (Port.unsafeFromInt 8042))) 403 | ) 404 | (path [ "over", "there" ]) 405 | ) 406 | (Just (Query.unsafeFromString "name=ferret")) 407 | (Just (Fragment.unsafeFromString "")) 408 | ) 409 | ) 410 | 411 | testIso 412 | (URIRef.parser options) 413 | (URIRef.print options) 414 | "foo://info.example.com?fred" 415 | ( Left 416 | ( URI 417 | (Scheme.unsafeFromString "foo") 418 | ( HierarchicalPartAuth 419 | ( Authority 420 | Nothing 421 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "info.example.com"))))) 422 | ) 423 | (path []) 424 | ) 425 | (Just (Query.unsafeFromString "fred")) 426 | Nothing 427 | ) 428 | ) 429 | 430 | testIso 431 | (URIRef.parser options) 432 | (URIRef.print options) 433 | "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" 434 | ( Left 435 | ( URI 436 | (Scheme.unsafeFromString "ftp") 437 | ( HierarchicalPartAuth 438 | ( Authority 439 | (Just (UserInfo.unsafeFromString (nes (Proxy :: Proxy "cnn.example.com&story=breaking_news")))) 440 | (Just (This (IPv4Address (IPv4Address.unsafeFromInts 10 0 0 1)))) 441 | ) 442 | (path [ "top_story.htm" ]) 443 | ) 444 | Nothing 445 | Nothing 446 | ) 447 | ) 448 | 449 | testIso 450 | (URIRef.parser options) 451 | (URIRef.print options) 452 | "top_story.htm" 453 | ( Right 454 | ( RelativeRef 455 | (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ nes (Proxy :: Proxy "top_story.htm")) []))))) 456 | Nothing 457 | Nothing 458 | ) 459 | ) 460 | 461 | testIso 462 | (URIRef.parser options) 463 | (URIRef.print options) 464 | "../top_story.htm" 465 | ( Right 466 | ( RelativeRef 467 | (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ nes (Proxy :: Proxy "..")) [ PathSegment.unsafeSegmentFromString "top_story.htm" ]))))) 468 | Nothing 469 | Nothing 470 | ) 471 | ) 472 | 473 | testIso 474 | (URIRef.parser options) 475 | (URIRef.print options) 476 | "/top_story.htm" 477 | ( Right 478 | ( RelativeRef 479 | (RelativePartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "top_story.htm")) [])))))) 480 | Nothing 481 | Nothing 482 | ) 483 | ) 484 | 485 | testIso 486 | (URIRef.parser options) 487 | (URIRef.print options) 488 | "/" 489 | ( Right 490 | ( RelativeRef 491 | (RelativePartNoAuth (Just (Left (PathAbsolute Nothing)))) 492 | Nothing 493 | Nothing 494 | ) 495 | ) 496 | 497 | testIso 498 | (URIRef.parser options) 499 | (URIRef.print options) 500 | "" 501 | ( Right 502 | ( RelativeRef 503 | (RelativePartNoAuth Nothing) 504 | Nothing 505 | Nothing 506 | ) 507 | ) 508 | 509 | testIso 510 | (URIRef.parser options) 511 | (URIRef.print options) 512 | "http://www.example.com/some%20invented/url%20with%20spaces.html" 513 | ( Left 514 | ( URI 515 | (Scheme.unsafeFromString "http") 516 | ( HierarchicalPartAuth 517 | (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "www.example.com")))))) 518 | (path [ "some%20invented", "url%20with%20spaces.html" ]) 519 | ) 520 | Nothing 521 | Nothing 522 | ) 523 | ) 524 | 525 | testIso 526 | (URIRef.parser options) 527 | (URIRef.print options) 528 | "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" 529 | ( Left 530 | ( URI 531 | (Scheme.unsafeFromString "http") 532 | ( HierarchicalPartAuth 533 | (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "localhost"))) (Port.unsafeFromInt 53174)))) 534 | (path [ "metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23" ]) 535 | ) 536 | (Just (Query.unsafeFromString "")) 537 | Nothing 538 | ) 539 | ) 540 | 541 | testIso 542 | (URIRef.parser options) 543 | (URIRef.print options) 544 | "news:comp.infosystems.www.servers.unix" 545 | ( Left 546 | ( URI 547 | (Scheme.unsafeFromString "news") 548 | (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "comp.infosystems.www.servers.unix")) []))))) 549 | Nothing 550 | Nothing 551 | ) 552 | ) 553 | 554 | testIso 555 | (URIRef.parser options) 556 | (URIRef.print options) 557 | "tel:+1-816-555-1212" 558 | ( Left 559 | ( URI 560 | (Scheme.unsafeFromString "tel") 561 | (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "+1-816-555-1212")) []))))) 562 | Nothing 563 | Nothing 564 | ) 565 | ) 566 | 567 | testIso 568 | (URIRef.parser options) 569 | (URIRef.print options) 570 | "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" 571 | ( Left 572 | ( URI 573 | (Scheme.unsafeFromString "urn") 574 | (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "oasis:names:specification:docbook:dtd:xml:4.1.2")) []))))) 575 | Nothing 576 | Nothing 577 | ) 578 | ) 579 | 580 | testIso 581 | (URIRef.parser options) 582 | (URIRef.print options) 583 | "mailto:John.Doe@example.com" 584 | ( Left 585 | ( URI 586 | (Scheme.unsafeFromString "mailto") 587 | (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "John.Doe@example.com")) []))))) 588 | Nothing 589 | Nothing 590 | ) 591 | ) 592 | 593 | testIso 594 | (URIRef.parser options) 595 | (URIRef.print options) 596 | "mailto:fred@example.com" 597 | ( Left 598 | ( URI 599 | (Scheme.unsafeFromString "mailto") 600 | (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes (Proxy :: Proxy "fred@example.com")) []))))) 601 | Nothing 602 | Nothing 603 | ) 604 | ) 605 | 606 | testIso 607 | (URIRef.parser options) 608 | (URIRef.print options) 609 | "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" 610 | ( Left 611 | ( URI 612 | (Scheme.unsafeFromString "http") 613 | ( HierarchicalPartAuth 614 | ( Authority 615 | Nothing 616 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "local.slamdata.com"))))) 617 | ) 618 | (path [ "" ]) 619 | ) 620 | (Just (Query.unsafeFromString "")) 621 | (Just (Fragment.unsafeFromString "?sort=asc&q=path%3A%2F&salt=1177214")) 622 | ) 623 | ) 624 | 625 | testIso 626 | (URIRef.parser options) 627 | (URIRef.print options) 628 | "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" 629 | ( Left 630 | ( URI 631 | (Scheme.unsafeFromString "http") 632 | ( HierarchicalPartAuth 633 | ( Authority 634 | Nothing 635 | (Just (This (NameAddress (RegName.unsafeFromString $ nes (Proxy :: Proxy "local.slamdata.com"))))) 636 | ) 637 | (path [ "" ]) 638 | ) 639 | (Just (Query.unsafeFromString "")) 640 | (Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214")) 641 | ) 642 | ) 643 | 644 | path :: Array String -> Path 645 | path = Path <<< map PathSegment.unsafeSegmentFromString 646 | 647 | options :: Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) 648 | options = 649 | { parseUserInfo: pure 650 | , printUserInfo: identity 651 | , parseHosts: HostPortPair.parser pure pure 652 | , printHosts: HostPortPair.print identity identity 653 | , parsePath: pure 654 | , printPath: identity 655 | , parseHierPath: pure 656 | , printHierPath: identity 657 | , parseRelPath: pure 658 | , printRelPath: identity 659 | , parseQuery: pure 660 | , printQuery: identity 661 | , parseFragment: pure 662 | , printFragment: identity 663 | } 664 | -------------------------------------------------------------------------------- /test/URI/UserInfo.purs: -------------------------------------------------------------------------------- 1 | module Test.URI.UserInfo where 2 | 3 | import Prelude 4 | 5 | import Data.String.NonEmpty (nes) 6 | import Type.Proxy (Proxy(..)) 7 | import Test.Spec (Spec, describe) 8 | import Test.Util (testIso) 9 | import URI.UserInfo as UserInfo 10 | 11 | spec :: Spec Unit 12 | spec = 13 | describe "UserInfo parser/printer" do 14 | testIso UserInfo.parser UserInfo.print "user" (UserInfo.fromString (nes (Proxy :: Proxy "user"))) 15 | testIso UserInfo.parser UserInfo.print "spaced%20user" (UserInfo.fromString (nes (Proxy :: Proxy "spaced user"))) 16 | testIso UserInfo.parser UserInfo.print "user:password" (UserInfo.fromString (nes (Proxy :: Proxy "user:password"))) 17 | testIso UserInfo.parser UserInfo.print "spaced%20user:password%25%C2%A3" (UserInfo.fromString (nes (Proxy :: Proxy "spaced user:password%£"))) 18 | testIso UserInfo.parser UserInfo.print "a:b:c" (UserInfo.fromString (nes (Proxy :: Proxy "a:b:c"))) 19 | -------------------------------------------------------------------------------- /test/Util.purs: -------------------------------------------------------------------------------- 1 | module Test.Util where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Effect.Class (liftEffect) 7 | import Test.QuickCheck as QC 8 | import Test.QuickCheck.Gen as QCG 9 | import Test.Spec (Spec, it, fail) 10 | import Parsing (Parser, runParser) 11 | 12 | testPrinter :: forall a. Show a => (a -> String) -> String -> a -> Spec Unit 13 | testPrinter f expected value = 14 | it 15 | ("prints: " <> expected) 16 | (equal expected (f value)) 17 | 18 | testParser :: forall a. Eq a => Show a => Parser String a -> String -> a -> Spec Unit 19 | testParser p value expected = 20 | it 21 | ("parses: " <> value) 22 | (equal (Right expected) (runParser value p)) 23 | 24 | equal :: forall a. Eq a => Show a => a -> a -> Spec Unit 25 | equal expected actual = 26 | when (expected /= actual) do 27 | fail $ 28 | "\nexpected: " 29 | <> show expected 30 | <> "\ngot: " 31 | <> show actual 32 | 33 | testIso :: forall a. Eq a => Show a => Parser String a -> (a -> String) -> String -> a -> Spec Unit 34 | testIso p f value expected = do 35 | testParser p value expected 36 | testPrinter f value expected 37 | 38 | forAll :: forall prop. QC.Testable prop => QCG.Gen prop -> Spec Unit 39 | forAll = quickCheck 40 | 41 | quickCheck :: forall prop. QC.Testable prop => prop -> Spec Unit 42 | quickCheck = liftEffect <<< QC.quickCheck' 100 43 | --------------------------------------------------------------------------------