base64 0.4.2.4 → 2.1
raw patch · 39 files changed
Files
- CHANGELOG.md +57/−0
- LICENSE +1/−1
- MIGRATION-1.0.md +385/−0
- MIGRATION-2.0.md +112/−0
- MIGRATION-2.1.md +109/−0
- README.md +129/−3
- base64.cabal +46/−20
- benchmarks/Base64Bench.hs +88/−94
- benchmarks/simd-native.c +162/−0
- cbits/base64_simd.c +443/−0
- cbits/base64_simd.h +44/−0
- src/Data/Base64/Types.hs +114/−0
- src/Data/Base64/Types/Internal.hs +72/−0
- src/Data/ByteString/Base64.hs +56/−55
- src/Data/ByteString/Base64/Internal.hs +3/−63
- src/Data/ByteString/Base64/Internal/Head.hs +56/−18
- src/Data/ByteString/Base64/Internal/SIMD.hs +46/−0
- src/Data/ByteString/Base64/Internal/Tables.hs +1/−2
- src/Data/ByteString/Base64/Internal/Tail.hs +28/−28
- src/Data/ByteString/Base64/Internal/Utils.hs +1/−1
- src/Data/ByteString/Base64/Internal/W16/Loop.hs +106/−14
- src/Data/ByteString/Base64/Internal/W32/Loop.hs +0/−92
- src/Data/ByteString/Base64/Internal/W64/Loop.hs +48/−10
- src/Data/ByteString/Base64/URL.hs +168/−81
- src/Data/ByteString/Lazy/Base64.hs +67/−64
- src/Data/ByteString/Lazy/Base64/URL.hs +169/−81
- src/Data/ByteString/Short/Base64.hs +60/−49
- src/Data/ByteString/Short/Base64/URL.hs +155/−71
- src/Data/Text/Encoding/Base64.hs +62/−61
- src/Data/Text/Encoding/Base64/Error.hs +3/−4
- src/Data/Text/Encoding/Base64/URL.hs +175/−95
- src/Data/Text/Lazy/Encoding/Base64.hs +68/−57
- src/Data/Text/Lazy/Encoding/Base64/URL.hs +164/−89
- src/Data/Text/Short/Encoding/Base64.hs +63/−57
- src/Data/Text/Short/Encoding/Base64/URL.hs +153/−81
- test/Internal.hs +97/−73
- test/Main.hs +385/−132
- test/Simd.hs +235/−0
- test/simd-native.c +380/−0
CHANGELOG.md view
@@ -1,5 +1,62 @@ # Revision history for base64 +## 2.1++This release completes the typed parser API for URL-safe Base64. It removes+`isBase64Url` and `isValidBase64Url`; see [MIGRATION-2.1.md](MIGRATION-2.1.md)+for replacement examples.++* Adds `parseBase64Padded` and `parseBase64Unpadded` to all six URL-safe+ modules: strict, lazy, and short ByteString and Text. URL Parsers validate the URL alphabet, length, padding policy, and canonical padding bits before returning the original encoded value. Lazy parsers validate+ the whole input and preserve its chunk boundaries; Text parsers do not+ require the decoded payload to be valid UTF-8.+* Removed both URL `Bool` validators in line with the `2.0` work. No one was using them. ++## 2.0++This release removes two public functions. See [MIGRATION-2.0.md](MIGRATION-2.0.md)+for replacement examples and the stricter validation behavior.++* Replace `isBase64` and `isValidBase64` with `parseBase64` in all six+ standard-alphabet modules. The parser returns+ `Either Text (Base64 'StdPadded a)`, preserving the original encoded input+ after checking its alphabet, length, padding, and canonicity.+* For a Boolean check, migrate to `isRight . parseBase64`. This is stricter+ than the old shape-only `isValidBase64` check. URL-specific validators+ are unchanged.+* Remove the predicates without a deprecation period. A source scan of 45+ published direct dependents found no occurrences of either function;+ private projects and other historical versions were not covered.+* Add an optional, manual `simd` flag (off by default) for bundled ARM64 NEON+ and runtime-detected x86-64 AVX2/SSSE3 encoding and strict decoding.+* The SIMD path retains scalar fallbacks, encoding and decoding behavior,+ padding/canonicity checks, and decoding error offsets.+* Add flag-on/off test and benchmark variants, SIMD boundary regressions,+ and native memory checks in CI.++## 1.0.1++* Support GHC 9.6 through 9.14, including `base-4.22`.+* Require GHC 9.6 or later (`base >= 4.18`) and `bytestring >= 0.11`.+* Refresh CI for current stable GHC releases and GitHub Actions; retire the i386 CI job.+* Update maintainer metadata and copyright notices through 2026.+* No changes to the public API.++## 1.0++New epoch time! lots of changes to the API. Please see [MIGRATION-1.0.md](MIGRATION-1.0.md) for more info:++* Add support for GHC 9.x+* Bumped bounds to more modern dependency set+* Introduced `Base64` newtype, located in `Data.Base64.Types`, as well as ADT for associated alphabets.+* Signature for `encodeBase64` has changed so that it produces a `Base64` wrapped value.+* `decodeBase64` and its URLsafe variants now consume a value of type `Base64` and produces a decoded value of the underlying type.+* The *old* `decodeBase64` and its URLsafe variants is now renamed to `decodeBase64Untyped*`.+* Fix for 32-bit systems in which memory barriers were not respected in the encoe loop (see: #56)+* Optimize encode and decode loops to achieve *significant speedup* across the board.++Thanks to everyone who contributed (especially @sofia-m-a!).+ ## 0.4.2.4 * Support for GHC 9.2.x
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2019, Emily Pillmore+Copyright (c) 2019-2026, Emily Pillmore All rights reserved.
+ MIGRATION-1.0.md view
@@ -0,0 +1,385 @@+Migration Guide for 1.0+----++Between the last major version (0.4.2.4) and the current major epoch (1.0), many API-related constructs have changed, and I'd like to justify them here and now so that users may have an immortalized explanation for what is most likely a disruptive change to their code.++## A faster loop++First, I'd like to say that I don't *like* breaking people's code. As an author and maintainer, I try and make sure that any API breakages are justified either by a significant UX improvement, or by a measurable performance increase large enough to warrant such a breakage. As such, I believe both of these criteria are met by the 0.4.x -> 1.0 upgrade: not only is the API safer to use, but the use of type data to establish the provenance of values encoded by this library also allows the performance-sensitive loops to be much cleaner, eschewing error checking where type data suffices. To prove this point, I've benchmarked the library between these last two epochs. The benchmarks say it all (all benchmarks are done on a Thinkpad P15 Gen 2 Intel i9-11950H, 64GB DDR4, Ubuntu 22.04 with GHC 9.6.3 stock, -O2):++In `base64-0.4.2.4`:++```+benchmarking encode/25/base64-bytestring+time 49.97 ns (49.87 ns .. 50.07 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 49.96 ns (49.86 ns .. 50.14 ns)+std dev 440.1 ps (235.9 ps .. 806.9 ps)++benchmarking encode/25/base64+time 34.07 ns (33.62 ns .. 34.56 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 33.88 ns (33.77 ns .. 34.08 ns)+std dev 504.2 ps (268.7 ps .. 773.8 ps)+variance introduced by outliers: 18% (moderately inflated)++benchmarking encode/100/base64-bytestring+time 111.4 ns (110.6 ns .. 112.4 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 111.7 ns (111.3 ns .. 112.3 ns)+std dev 1.787 ns (1.421 ns .. 2.247 ns)+variance introduced by outliers: 19% (moderately inflated)++benchmarking encode/100/base64+time 53.39 ns (53.19 ns .. 53.72 ns)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 54.17 ns (53.60 ns .. 56.40 ns)+std dev 3.163 ns (1.151 ns .. 6.269 ns)+variance introduced by outliers: 78% (severely inflated)++benchmarking encode/1k/base64-bytestring+time 754.3 ns (750.8 ns .. 759.1 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 766.1 ns (761.4 ns .. 771.5 ns)+std dev 17.44 ns (14.17 ns .. 21.34 ns)+variance introduced by outliers: 29% (moderately inflated)++benchmarking encode/1k/base64+time 274.6 ns (273.2 ns .. 275.9 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 276.5 ns (275.4 ns .. 277.6 ns)+std dev 3.863 ns (3.413 ns .. 4.464 ns)+variance introduced by outliers: 14% (moderately inflated)++benchmarking encode/10k/base64-bytestring+time 7.069 μs (7.054 μs .. 7.094 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 7.100 μs (7.088 μs .. 7.114 μs)+std dev 44.37 ns (37.56 ns .. 54.14 ns)++benchmarking encode/10k/base64+time 2.384 μs (2.364 μs .. 2.415 μs)+ 0.999 R² (0.998 R² .. 1.000 R²)+mean 2.370 μs (2.363 μs .. 2.395 μs)+std dev 42.25 ns (12.58 ns .. 86.70 ns)+variance introduced by outliers: 18% (moderately inflated)++benchmarking encode/100k/base64-bytestring+time 70.59 μs (70.26 μs .. 70.84 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 70.11 μs (69.95 μs .. 70.28 μs)+std dev 587.0 ns (508.0 ns .. 684.0 ns)++benchmarking encode/100k/base64+time 23.31 μs (23.22 μs .. 23.42 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 23.59 μs (23.49 μs .. 23.72 μs)+std dev 415.2 ns (343.8 ns .. 509.2 ns)+variance introduced by outliers: 14% (moderately inflated)++benchmarking encode/1mm/base64-bytestring+time 703.6 μs (700.6 μs .. 708.7 μs)+ 0.999 R² (0.997 R² .. 1.000 R²)+mean 703.1 μs (699.8 μs .. 720.0 μs)+std dev 18.82 μs (5.505 μs .. 43.88 μs)+variance introduced by outliers: 17% (moderately inflated)++benchmarking encode/1mm/base64+time 238.4 μs (235.5 μs .. 241.4 μs)+ 0.999 R² (0.998 R² .. 1.000 R²)+mean 234.6 μs (233.4 μs .. 236.5 μs)+std dev 4.771 μs (3.256 μs .. 7.810 μs)+variance introduced by outliers: 13% (moderately inflated)++benchmarking decode/25/base64-bytestring+time 54.36 ns (54.18 ns .. 54.55 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 55.11 ns (54.74 ns .. 55.63 ns)+std dev 1.441 ns (1.090 ns .. 2.068 ns)+variance introduced by outliers: 41% (moderately inflated)++benchmarking decode/25/base64+time 53.04 ns (52.57 ns .. 53.80 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 53.42 ns (53.07 ns .. 53.93 ns)+std dev 1.378 ns (1.061 ns .. 1.774 ns)+variance introduced by outliers: 40% (moderately inflated)++benchmarking decode/100/base64-bytestring+time 145.2 ns (143.8 ns .. 146.9 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 145.3 ns (144.6 ns .. 146.5 ns)+std dev 3.165 ns (2.441 ns .. 4.254 ns)+variance introduced by outliers: 30% (moderately inflated)++benchmarking decode/100/base64+time 140.6 ns (140.0 ns .. 141.2 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 140.6 ns (140.2 ns .. 141.4 ns)+std dev 1.984 ns (1.243 ns .. 3.410 ns)+variance introduced by outliers: 16% (moderately inflated)++benchmarking decode/1k/base64-bytestring+time 1.115 μs (1.112 μs .. 1.118 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.120 μs (1.118 μs .. 1.123 μs)+std dev 8.290 ns (6.907 ns .. 10.42 ns)++benchmarking decode/1k/base64+time 1.109 μs (1.102 μs .. 1.119 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.104 μs (1.102 μs .. 1.108 μs)+std dev 9.031 ns (4.358 ns .. 17.14 ns)++benchmarking decode/10k/base64-bytestring+time 10.86 μs (10.84 μs .. 10.89 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 10.90 μs (10.88 μs .. 10.93 μs)+std dev 93.78 ns (71.73 ns .. 143.6 ns)++benchmarking decode/10k/base64+time 10.68 μs (10.65 μs .. 10.72 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 10.68 μs (10.66 μs .. 10.70 μs)+std dev 51.31 ns (36.41 ns .. 70.46 ns)++benchmarking decode/100k/base64-bytestring+time 108.4 μs (108.0 μs .. 108.8 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 108.1 μs (108.0 μs .. 108.4 μs)+std dev 643.5 ns (450.9 ns .. 1.043 μs)++benchmarking decode/100k/base64+time 106.0 μs (105.9 μs .. 106.2 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 106.1 μs (106.0 μs .. 106.3 μs)+std dev 586.1 ns (405.8 ns .. 932.3 ns)++benchmarking decode/1mm/base64-bytestring+time 1.076 ms (1.074 ms .. 1.079 ms)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.080 ms (1.078 ms .. 1.082 ms)+std dev 6.833 μs (5.938 μs .. 7.717 μs)++benchmarking decode/1mm/base64+time 1.054 ms (1.050 ms .. 1.056 ms)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.051 ms (1.049 ms .. 1.052 ms)+std dev 4.359 μs (3.498 μs .. 5.253 μs)++```++vs in `base64-1.0.0.0`:++```+benchmarking encode/25/base64-bytestring+time 52.04 ns (51.77 ns .. 52.43 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 52.23 ns (52.02 ns .. 52.50 ns)+std dev 790.3 ps (649.7 ps .. 981.1 ps)+variance introduced by outliers: 19% (moderately inflated)++benchmarking encode/25/base64+time 35.88 ns (35.50 ns .. 36.15 ns)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 35.44 ns (35.28 ns .. 35.61 ns)+std dev 609.5 ps (466.8 ps .. 835.9 ps)+variance introduced by outliers: 23% (moderately inflated)++benchmarking encode/100/base64-bytestring+time 116.5 ns (115.6 ns .. 117.5 ns)+ 0.999 R² (0.999 R² .. 0.999 R²)+mean 119.1 ns (117.9 ns .. 120.9 ns)+std dev 4.946 ns (3.674 ns .. 6.871 ns)+variance introduced by outliers: 62% (severely inflated)++benchmarking encode/100/base64+time 54.59 ns (54.15 ns .. 54.97 ns)+ 1.000 R² (0.999 R² .. 1.000 R²)+mean 54.84 ns (54.53 ns .. 55.11 ns)+std dev 967.4 ps (759.0 ps .. 1.233 ns)+variance introduced by outliers: 24% (moderately inflated)++benchmarking encode/1k/base64-bytestring+time 792.6 ns (789.2 ns .. 796.2 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 797.4 ns (794.2 ns .. 801.2 ns)+std dev 12.70 ns (10.10 ns .. 16.66 ns)+variance introduced by outliers: 17% (moderately inflated)++benchmarking encode/1k/base64+time 300.4 ns (296.8 ns .. 304.4 ns)+ 0.998 R² (0.996 R² .. 1.000 R²)+mean 294.8 ns (291.3 ns .. 301.3 ns)+std dev 14.55 ns (9.522 ns .. 25.93 ns)+variance introduced by outliers: 68% (severely inflated)++benchmarking encode/10k/base64-bytestring+time 7.852 μs (7.806 μs .. 7.917 μs)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 7.849 μs (7.810 μs .. 7.923 μs)+std dev 172.2 ns (88.74 ns .. 277.8 ns)+variance introduced by outliers: 23% (moderately inflated)++benchmarking encode/10k/base64+time 2.748 μs (2.724 μs .. 2.773 μs)+ 0.999 R² (0.998 R² .. 1.000 R²)+mean 2.737 μs (2.717 μs .. 2.802 μs)+std dev 108.8 ns (48.74 ns .. 219.4 ns)+variance introduced by outliers: 53% (severely inflated)++benchmarking encode/100k/base64-bytestring+time 81.01 μs (80.45 μs .. 81.98 μs)+ 0.999 R² (0.996 R² .. 1.000 R²)+mean 80.95 μs (80.48 μs .. 82.34 μs)+std dev 2.561 μs (1.019 μs .. 4.866 μs)+variance introduced by outliers: 31% (moderately inflated)++benchmarking encode/100k/base64+time 26.20 μs (26.13 μs .. 26.29 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 26.32 μs (26.25 μs .. 26.40 μs)+std dev 238.5 ns (190.6 ns .. 314.7 ns)++benchmarking encode/1mm/base64-bytestring+time 793.2 μs (791.7 μs .. 794.8 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 795.1 μs (794.0 μs .. 796.2 μs)+std dev 3.646 μs (3.048 μs .. 4.402 μs)++benchmarking encode/1mm/base64+time 266.1 μs (260.7 μs .. 273.8 μs)+ 0.997 R² (0.995 R² .. 1.000 R²)+mean 262.2 μs (260.6 μs .. 265.8 μs)+std dev 7.496 μs (1.432 μs .. 12.40 μs)+variance introduced by outliers: 23% (moderately inflated)++benchmarking decode/25/base64-bytestring+time 59.26 ns (59.18 ns .. 59.35 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 59.31 ns (59.22 ns .. 59.41 ns)+std dev 329.7 ps (270.9 ps .. 416.3 ps)++benchmarking decode/25/base64-typed+time 45.90 ns (45.78 ns .. 46.04 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 45.95 ns (45.88 ns .. 46.04 ns)+std dev 261.9 ps (218.3 ps .. 327.6 ps)++benchmarking decode/25/base64-untyped+time 55.79 ns (55.63 ns .. 56.02 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 55.90 ns (55.77 ns .. 56.06 ns)+std dev 470.0 ps (364.5 ps .. 692.0 ps)++benchmarking decode/100/base64-bytestring+time 153.8 ns (153.4 ns .. 154.2 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 153.6 ns (153.4 ns .. 153.9 ns)+std dev 931.2 ps (780.6 ps .. 1.139 ns)++benchmarking decode/100/base64-typed+time 121.3 ns (120.6 ns .. 122.4 ns)+ 0.999 R² (0.997 R² .. 1.000 R²)+mean 121.5 ns (120.6 ns .. 125.2 ns)+std dev 4.717 ns (1.474 ns .. 10.23 ns)+variance introduced by outliers: 59% (severely inflated)++benchmarking decode/100/base64-untyped+time 153.2 ns (152.9 ns .. 153.5 ns)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 153.3 ns (153.1 ns .. 153.5 ns)+std dev 642.7 ps (538.6 ps .. 804.8 ps)++benchmarking decode/1k/base64-bytestring+time 1.246 μs (1.244 μs .. 1.248 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.247 μs (1.245 μs .. 1.248 μs)+std dev 4.807 ns (3.911 ns .. 5.909 ns)++benchmarking decode/1k/base64-typed+time 909.0 ns (902.6 ns .. 919.9 ns)+ 0.999 R² (0.998 R² .. 1.000 R²)+mean 905.9 ns (902.1 ns .. 917.4 ns)+std dev 19.73 ns (7.516 ns .. 39.01 ns)+variance introduced by outliers: 27% (moderately inflated)++benchmarking decode/1k/base64-untyped+time 1.210 μs (1.192 μs .. 1.226 μs)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 1.222 μs (1.214 μs .. 1.226 μs)+std dev 19.44 ns (10.77 ns .. 29.88 ns)+variance introduced by outliers: 16% (moderately inflated)++benchmarking decode/10k/base64-bytestring+time 11.56 μs (11.53 μs .. 11.59 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 11.49 μs (11.47 μs .. 11.52 μs)+std dev 91.19 ns (77.80 ns .. 110.9 ns)++benchmarking decode/10k/base64-typed+time 8.140 μs (8.126 μs .. 8.157 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 8.141 μs (8.125 μs .. 8.169 μs)+std dev 70.34 ns (47.20 ns .. 119.2 ns)++benchmarking decode/10k/base64-untyped+time 11.25 μs (11.24 μs .. 11.27 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 11.29 μs (11.27 μs .. 11.35 μs)+std dev 102.4 ns (52.23 ns .. 185.3 ns)++benchmarking decode/100k/base64-bytestring+time 114.2 μs (113.9 μs .. 114.6 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 114.5 μs (114.3 μs .. 114.8 μs)+std dev 778.0 ns (644.2 ns .. 997.4 ns)++benchmarking decode/100k/base64-typed+time 80.52 μs (80.37 μs .. 80.68 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 80.56 μs (80.44 μs .. 80.75 μs)+std dev 478.9 ns (347.2 ns .. 750.1 ns)++benchmarking decode/100k/base64-untyped+time 111.0 μs (110.8 μs .. 111.2 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 111.4 μs (111.2 μs .. 111.8 μs)+std dev 836.7 ns (409.8 ns .. 1.471 μs)++benchmarking decode/1mm/base64-bytestring+time 1.125 ms (1.122 ms .. 1.128 ms)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.123 ms (1.121 ms .. 1.124 ms)+std dev 5.065 μs (4.293 μs .. 6.589 μs)++benchmarking decode/1mm/base64-typed+time 804.8 μs (802.3 μs .. 807.7 μs)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 802.7 μs (802.0 μs .. 803.8 μs)+std dev 2.940 μs (1.813 μs .. 4.985 μs)++benchmarking decode/1mm/base64-untyped+time 1.108 ms (1.106 ms .. 1.110 ms)+ 1.000 R² (1.000 R² .. 1.000 R²)+mean 1.108 ms (1.107 ms .. 1.110 ms)+std dev 5.673 μs (4.383 μs .. 7.451 μs)++```++Benchmarks are included in this repo for you to reproduce these results on your own. You can see a parity in the `encode` step between the previous library iterations and the new epoch, with a *marked* improvement in decode speed (up to 25% faster on average between the old and new versions in the optimal case, and up to 40% in the suboptimal case) which justifies the performance aspect to me. Without deferring to pipelining instructions, hex encoding can only get so fast. In the future, this change also opens the library up to an optimal SIMD implementations.++## A sounder api++Second, I do not believe that these changes are unsound or overburdensome to the point that a migration to the new paradigm would be untenable. While it may be inconvenient to unwrap `Base64` types, in the `encode` case (all one must do is call `extractBase64` to extract the value from its wrapper, all caveats implied), and in the case of `decode`, an untyped variant is supplied, and is semantically consistent with the old behavior (the loop is the same). Hence, a migration is fairly easy to sketch out:++```+"encodeBase64'" -> "extractBase64 . encodeBase64'"+"encodeBase64" -> "extractBase64 . encodeBase64"+"decodebase64" -> "decodeBase64Untyped"+"decodeBase64Unpadded" -> "decodeBase64UnpaddedUntyped"+"decodeBase64Padded" -> "decodeBase64PaddedUntyped"+"decodeBase64W*With" -> "decodeBase64*WithUntyped"+```++And that is all. In order to make use of the new loops, one must only use one of the blessed encode functions to generate a wrapped `Base64` value, or call `assertBase64` and proceed with using `decodeBase64` as usual in order to decode. You'll note that an untyped `encodeBase64` is not supplied, and this is due to the fact that it's trivial to extract a `Base64` encoded value once you have it. However, I want to encourage people to use the new API, so I have only supplied a decode with error checking in the untyped case, because sometimes we deal with other people's data and cannot establish provenance. In the encode case, I would rather keep that provenance a part of the API, and the user may opt to strip that data upon sending to others or around their systems. It's not my problem at that point!
+ MIGRATION-2.0.md view
@@ -0,0 +1,112 @@+# Migrating to base64 2.0++For the URL-safe parser migration in 2.1, also see [MIGRATION-2.1.md](MIGRATION-2.1.md).++Version 2.0 replaces the standard-alphabet predicates `isBase64` and+`isValidBase64` with `parseBase64`. The new function checks the encoded input+and returns a typed `Base64` value, or an error explaining why validation+failed. The old predicates are removed without a deprecation period.++The release also adds optional SIMD support. It is off by default, so existing+builds continue to use the scalar implementation.++## Parse externally supplied Base64++Each of these modules exports `parseBase64`, specialized to its string type:++- `Data.ByteString.Base64`+- `Data.ByteString.Lazy.Base64`+- `Data.ByteString.Short.Base64`+- `Data.Text.Encoding.Base64`+- `Data.Text.Lazy.Encoding.Base64`+- `Data.Text.Short.Encoding.Base64`++For example, the strict ByteString signature is:++```haskell+parseBase64 :: ByteString -> Either Text (Base64 'StdPadded ByteString)+```++Use the returned wrapper directly with `decodeBase64` instead of checking a+Boolean and then calling `assertBase64`:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Base64 as B64++-- Right "U3Vu": the result contains the original encoded bytes.+encoded = B64.parseBase64 "U3Vu"++-- Right "Sun": decoding consumes the validated wrapper.+decoded = fmap B64.decodeBase64 encoded++-- Left "non-canonical encoding detected at offset: 2"+rejected = B64.parseBase64 "U3V="+```++Parsing preserves the input, including lazy chunk boundaries, and validates+the whole value before returning `Right`. It checks the alphabet, length,+padding, and unused padding bits. Error messages match `decodeBase64Untyped`.++## Replace Boolean checks++Import `isRight` from `Data.Either` and replace a call to `B64.isBase64 input`+with `isRight (B64.parseBase64 input)`. For a composed predicate, use+`isRight . B64.parseBase64`.++The same replacement is appropriate for `isValidBase64` when you want to check+for a decodable, canonical value. It is stricter than that function's former+alphabet-and-shape check:++| Input | Former `isBase64` | Former `isValidBase64` | `isRight . parseBase64` |+| --- | --- | --- | --- |+| `"U3Vu"` | `True` | `True` | `True` |+| `"U3V"` | `False` | `True` | `False` |+| `"U3V="` | `False` | `True` | `False` |+| `"%"` | `False` | `False` | `False` |+| `""` | `True` | `True` | `True` |++If your application intentionally accepts incomplete or non-canonical input,+keep that policy explicit; `parseBase64` does not reproduce the permissive+behavior of `isValidBase64`.++## Text and URL-safe encodings++The Text parsers validate the Base64 encoding, not the UTF-8 validity of the+decoded payload. For example, `parseBase64 "/w=="` succeeds even though its+decoded byte is not valid UTF-8. Use a ByteString decoder for arbitrary binary+payloads, or `decodeBase64UntypedWith` with a checked text conversion such as+`decodeUtf8'` when you need to report conversion errors.++The URL-specific predicates `isBase64Url` and `isValidBase64Url` retain their+existing names and behavior. The encoding and decoding APIs are unchanged.++## Enable SIMD optionally++Enable the manual Cabal flag for bundled ARM64 NEON or runtime-selected+x86-64 AVX2/SSSE3 kernels:++```sh+cabal build -fsimd+cabal test -fsimd --test-show-details=direct+```++For a project dependency, enable the flag in `cabal.project`:++```cabal+package base64+ flags: +simd+```++Unsupported targets and short inputs fall back to the scalar implementation.+No external C library is required. Padding checks, canonicity checks, and+decoding errors retain their existing behavior; lenient decoding remains+scalar. See the [README](README.md#optional-simd) for benchmark commands.++## Update package bounds++After migrating callers, update dependency bounds to admit 2.0, for example+`base64 >= 2.0 && < 2.1` or `base64 ^>= 2.0`. GHC 9.6 through 9.14 remains+the supported compiler range. Applications migrating from a pre-1.0 release+should also follow [MIGRATION-1.0.md](MIGRATION-1.0.md).
+ MIGRATION-2.1.md view
@@ -0,0 +1,109 @@+# Migrating to base64 2.1++Version 2.1 replaces `isBase64Url` and `isValidBase64Url` with+`parseBase64Padded` and `parseBase64Unpadded`. The parsers validate the encoded+input and return a typed `Base64` value, or an error explaining why validation+failed. The old URL predicates are removed without a deprecation period.++The standard-alphabet `parseBase64` functions introduced in 2.0 are unchanged.+If upgrading from 1.x, also follow [MIGRATION-2.0.md](MIGRATION-2.0.md).+Encoding, decoding, compiler support, and the optional SIMD flag are unchanged.++## Affected modules++Both parsers are available for all six string representations:++- `Data.ByteString.Base64.URL`+- `Data.ByteString.Lazy.Base64.URL`+- `Data.ByteString.Short.Base64.URL`+- `Data.Text.Encoding.Base64.URL`+- `Data.Text.Lazy.Encoding.Base64.URL`+- `Data.Text.Short.Encoding.Base64.URL`++## Parse URL-safe input++Each module specializes these signatures to its string type:++```haskell+parseBase64Padded :: a -> Either Text (Base64 'UrlPadded a)+parseBase64Unpadded :: a -> Either Text (Base64 'UrlUnpadded a)+```++The padded parser requires complete padding when needed. The unpadded parser+rejects padding. Empty input and complete four-character quanta without+padding are valid in both modes.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Base64.URL as B64U++-- Right "PDw_Pj4=", with alphabet UrlPadded.+padded = B64U.parseBase64Padded "PDw_Pj4="++-- Right "PDw_Pj4", with alphabet UrlUnpadded.+unpadded = B64U.parseBase64Unpadded "PDw_Pj4"++-- Both return Right "<<?>>".+decodedPadded = fmap B64U.decodeBase64Padded padded+decodedUnpadded = fmap B64U.decodeBase64Unpadded unpadded+```++Both parsers check the URL-safe alphabet, length, padding, and unused padding+bits. They validate the entire input before returning `Right` and preserve+the original encoded value, including lazy chunk boundaries. Errors match+the corresponding strict ByteString untyped decoder.++The Text parsers validate Base64 independently of the decoded payload's+UTF-8 validity. For example, `parseBase64Padded "_w=="` and+`parseBase64Unpadded "_w"` succeed even though the decoded byte is not valid+UTF-8. Use a ByteString decoder for binary payloads, or an untyped `With`+decoder with a checked conversion such as `decodeUtf8'`.++## Replace Boolean checks++Import `isRight` from `Data.Either`. When a specific padding policy is+required, use `isRight . B64U.parseBase64Padded` or+`isRight . B64U.parseBase64Unpadded`.++To accept either padding policy, replace `isBase64Url input` with:++```haskell+isRight (B64U.parseBase64Padded input)+ || isRight (B64U.parseBase64Unpadded input)+```++The parsers are stricter than the old shape-only `isValidBase64Url` check:++| Input | Padded parser | Unpadded parser |+| --- | --- | --- |+| `""` | Accept | Accept |+| `"Zm9v"` | Accept | Accept |+| `"Zg=="` | Accept | Reject padding |+| `"Zg"` | Require padding | Accept |+| `"Zg="` | Require complete padding | Reject padding |+| `"ZE=="` | Reject noncanonical bits | Reject padding |+| `"ZE"` | Require padding | Reject noncanonical bits |+| `"PDw/"` | Reject standard-alphabet character | Reject standard-alphabet character |++If your application intentionally accepts incomplete or noncanonical input,+keep that policy explicit; the parsers do not reproduce the permissive+behavior of `isValidBase64Url`.++To decode validated input when either padding policy is accepted,+`decodeBase64` consumes both URL alphabet types:++```haskell+decodeEitherPadding input =+ case B64U.parseBase64Padded input of+ Right encoded -> Right (B64U.decodeBase64 encoded)+ Left _ -> fmap B64U.decodeBase64 (B64U.parseBase64Unpadded input)+```++If only decoded bytes are needed, `B64U.decodeBase64Untyped` continues to+accept either padding policy directly.++## Update package bounds++After migrating callers, admit 2.1 with `base64 >= 2.1 && < 2.2` or+`base64 ^>= 2.1`. GHC 9.6 through 9.14 remains the supported compiler range.
README.md view
@@ -1,6 +1,6 @@ # Base64 -+ [](https://hackage.haskell.org/package/base64) Base64 encoding and decodings.@@ -22,7 +22,133 @@ - Better performance than `base64-bytestring` for encode and decode. - Optics for handling more complex structures with Base64 representations via the `base64-lens` package-- Checks for both validity and correctness of Base64 and Base64url encodings+- Parses standard and URL-safe Base64 into validated `Base64` values - Rejects non-canonical encodings that do not roundtrip in other base64 libraries like `ZE==`. -There are no dependencies aside from those bundled with GHC, `text-short`, and the `ghc-byteorder` re-export.+The library supports GHC 9.6 through 9.14. Its dependencies are `base`,+`bytestring`, `deepseq`, `text`, and `text-short`.++Upgrading to 2.1? See the [migration guide](MIGRATION-2.1.md) and+[release notes](CHANGELOG.md#21) for the replacement of the URL-safe Boolean+validators. If upgrading from 1.x, also follow the [2.0 migration guide](MIGRATION-2.0.md)+for the standard-alphabet parsers and optional SIMD support.++### Parsing existing Base64++Use `parseBase64` to validate externally supplied standard Base64 and retain the+encoded value in a typed wrapper:++```haskell+>>> import qualified Data.ByteString.Base64 as B64+>>> :set -XOverloadedStrings+>>> B64.parseBase64 "U3Vu"+Right "U3Vu"+>>> fmap B64.decodeBase64 (B64.parseBase64 "U3Vu")+Right "Sun"+>>> B64.parseBase64 "U3V="+Left "non-canonical encoding detected at offset: 2"+```++Each standard-alphabet module exports `parseBase64 :: a -> Either Text (Base64+'StdPadded a)`, specialized to its string type. Parsing checks the alphabet,+length, padding, and canonical padding bits, then returns the original encoded+input. The Text variants validate Base64 independently of the decoded payload's+UTF-8 validity; use `decodeBase64UntypedWith` to check that conversion.++`parseBase64` replaces `isBase64` and `isValidBase64`. For a Boolean check, use+`isRight . parseBase64` from `Data.Either`. Unlike the old `isValidBase64`, this+rejects missing padding and non-canonical encodings.++Each URL-safe module likewise replaces `isBase64Url` and `isValidBase64Url`+with two parsers:++```haskell+parseBase64Padded :: a -> Either Text (Base64 'UrlPadded a)+parseBase64Unpadded :: a -> Either Text (Base64 'UrlUnpadded a)+```++Choose the parser for the required padding policy. Both preserve the input+and check canonicity; the padded parser requires complete padding when needed,+and the unpadded parser rejects any padding.++```haskell+>>> import qualified Data.ByteString.Base64.URL as B64U+>>> B64U.parseBase64Padded "PDw_Pj4="+Right "PDw_Pj4="+>>> B64U.parseBase64Unpadded "PDw_Pj4"+Right "PDw_Pj4"+>>> fmap B64U.decodeBase64Unpadded (B64U.parseBase64Unpadded "PDw_Pj4")+Right "<<?>>"+```++For a Boolean check that accepts either padding policy, use+`isRight (B64U.parseBase64Padded input) || isRight (B64U.parseBase64Unpadded input)`.+See the [migration guide](MIGRATION-2.1.md#parse-url-safe-input) for typed use.++The complete parser API covers all six string representations:++| Representation | Standard module | URL-safe module |+| --- | --- | --- |+| Strict `ByteString` | `Data.ByteString.Base64` | `Data.ByteString.Base64.URL` |+| Lazy `ByteString` | `Data.ByteString.Lazy.Base64` | `Data.ByteString.Lazy.Base64.URL` |+| `ShortByteString` | `Data.ByteString.Short.Base64` | `Data.ByteString.Short.Base64.URL` |+| Strict `Text` | `Data.Text.Encoding.Base64` | `Data.Text.Encoding.Base64.URL` |+| Lazy `Text` | `Data.Text.Lazy.Encoding.Base64` | `Data.Text.Lazy.Encoding.Base64.URL` |+| `ShortText` | `Data.Text.Short.Encoding.Base64` | `Data.Text.Short.Encoding.Base64.URL` |++Every standard module exports `parseBase64` for `StdPadded`. Every URL-safe+module exports both `parseBase64Padded` for `UrlPadded` and+`parseBase64Unpadded` for `UrlUnpadded`. All 18 combinations validate the whole+input and preserve its encoded representation, including lazy chunk boundaries.+`NonStandard` is a marker for input handled by lenient decoders; it does not+define an alphabet or canonical validation rules.++### Optional SIMD++Enable the manual `simd` Cabal flag to use bundled SIMD kernels for standard+and URL-safe encoding and strict decoding, including the typed decoders:++```sh+cabal build -fsimd+cabal test -fsimd --test-show-details=direct+```++The flag is **off by default**. ARM64 uses NEON; x86-64 selects AVX2 when+the CPU and operating system support it, then SSSE3 on older processors.+Other targets and short inputs use the existing+Haskell loops. No external C library is required. Remainders, padding checks,+canonical-encoding checks, and error messages still use the Haskell code.+Lenient decoding remains scalar.++Test both configurations and compare optimized benchmark builds separately:++```sh+cabal test -f-simd --builddir=dist-scalar --test-show-details=direct+cabal test -fsimd --builddir=dist-simd --test-show-details=direct+cabal bench -f-simd --builddir=dist-scalar -O2 --benchmark-options='--csv scalar.csv'+cabal bench -fsimd --builddir=dist-simd -O2 --benchmark-options='--csv simd.csv'+```++Benchmark names identify the selected flag configuration. The suite covers+standard Base64 and padded/unpadded Base64url, encoding and typed/untyped+decoding, short and large buffers, and sliced inputs. The test suite exercises+block boundaries, scalar tails, slices, invalid input, and wrapper types in+both configurations; CI also runs native memory checks on x86-64 and ARM64,+explicitly requiring AVX2 on Linux x86-64 and checking the SSSE3 and scalar+fallbacks separately.++For native kernel measurements, a standalone benchmark validates every case+against scalar output and checks both alphabets. It times pseudorandom,+cycling, and repeated inputs at two alignments.+It reports the detected backend and writes CSV results:++```sh+cc -O2 -std=c99 -Icbits cbits/base64_simd.c benchmarks/simd-native.c -o base64-native-bench+./base64-native-bench --seconds 0.05 --rounds 5 > native.csv+```++Add `--url` to time the URL alphabet, or `--pattern random` to select one+input distribution. On x86-64, compile a second executable with+`-DHS_BASE64_SIMD_FORCE_SSSE3` to compare the older backend on the same CPU.+These measurements cover native prefixes only; use the Cabal benchmarks above+to include Haskell allocation and scalar tails.
base64.cabal view
@@ -1,31 +1,46 @@ cabal-version: 2.0 name: base64-version: 0.4.2.4-synopsis: A modern RFC 4648-compliant Base64 library+version: 2.1+synopsis: A modern Base64 library description:- RFC 4648-compliant Base64 with an eye towards performance and modernity (additional support for RFC 7049 standards)+ A performant, featureful RFC 4648 and 7049-compliant Base64 implementation homepage: https://github.com/emilypi/base64 bug-reports: https://github.com/emilypi/base64/issues license: BSD3 license-file: LICENSE author: Emily Pillmore-maintainer: emilypi@cohomolo.gy-copyright: (c) 2019-2022 Emily Pillmore+maintainer: Emily Pillmore <emilypi@cohomolo.gy>+copyright: (c) 2019-2026 Emily Pillmore category: Data build-type: Simple extra-doc-files: CHANGELOG.md README.md+ MIGRATION-1.0.md+ MIGRATION-2.0.md+ MIGRATION-2.1.md -tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.2+tested-with: GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1 ++extra-source-files:+ cbits/base64_simd.h+ test/simd-native.c+ benchmarks/simd-native.c++flag simd+ description: Use bundled SIMD kernels where supported, with a scalar fallback+ default: False+ manual: True+ source-repository head type: git location: https://github.com/emilypi/base64.git library exposed-modules:+ Data.Base64.Types Data.ByteString.Base64 Data.ByteString.Base64.URL Data.ByteString.Lazy.Base64@@ -41,45 +56,56 @@ Data.Text.Short.Encoding.Base64.URL other-modules:+ Data.Base64.Types.Internal Data.ByteString.Base64.Internal Data.ByteString.Base64.Internal.Head Data.ByteString.Base64.Internal.Tables Data.ByteString.Base64.Internal.Tail Data.ByteString.Base64.Internal.Utils Data.ByteString.Base64.Internal.W16.Loop- Data.ByteString.Base64.Internal.W32.Loop Data.ByteString.Base64.Internal.W64.Loop + if flag(simd)+ other-modules: Data.ByteString.Base64.Internal.SIMD+ cpp-options: -DBASE64_SIMD+ c-sources: cbits/base64_simd.c+ include-dirs: cbits+ cc-options: -O2 -std=c99+ build-depends:- base >=4.14 && <4.17- , bytestring >=0.10 && <0.12- , deepseq >=1.4.3.0 && <1.5- , text ^>=1.2+ base >=4.18 && <4.23+ , bytestring >=0.11 && <0.13+ , deepseq >=1.4.4.0 && <1.6+ , text >=2.0 && <2.3 , text-short ^>=0.1 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -test-suite tasty+test-suite base64-tests default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test other-modules: Internal+ Simd main-is: Main.hs build-depends:- base >=4.14 && <4.17+ base >=4.18 && <4.23 , base64 , base64-bytestring- , bytestring+ , bytestring >=0.11 , QuickCheck , random-bytestring , tasty , tasty-hunit , tasty-quickcheck- , text+ , text >=2.0 , text-short + if flag(simd)+ cpp-options: -DBASE64_SIMD+ ghc-options: -Wall -threaded -with-rtsopts=-N benchmark bench@@ -88,13 +114,13 @@ hs-source-dirs: benchmarks main-is: Base64Bench.hs build-depends:- base >=4.14 && <4.17+ base >=4.18 && <4.23 , base64 , base64-bytestring- , bytestring+ , bytestring >=0.11 , criterion- , deepseq- , random-bytestring- , text++ if flag(simd)+ cpp-options: -DBASE64_SIMD ghc-options: -Wall -rtsopts
benchmarks/Base64Bench.hs view
@@ -1,103 +1,97 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-module Main-( main-) where-+{-# LANGUAGE PackageImports #-}+-- |+-- Module : Main+-- Copyright : (c) 2019-2026 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- Build once with -f-simd and once with -fsimd to compare the same cases.+-- Sizes describe raw input bytes; sliced inputs also apply to decode buffers.+module Main (main) where -import Criterion import Criterion.Main--import "base64-bytestring" Data.ByteString.Base64 as Bos-import "base64" Data.ByteString.Base64 as B64-import Data.ByteString.Random (random)+import "base64" Data.Base64.Types (Alphabet(StdPadded), assertBase64)+import qualified Data.ByteString as BS+import qualified "base64" Data.ByteString.Base64 as B64+import qualified "base64" Data.ByteString.Base64.URL as B64U+import qualified "base64-bytestring" Data.ByteString.Base64 as Bos+import qualified "base64-bytestring" Data.ByteString.Base64.URL as BosU main :: IO ()-main =- defaultMain- [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->- bgroup "encode"- [ bgroup "25"- [ bench "base64-bytestring" $ whnf Bos.encode bs25- , bench "base64" $ whnf B64.encodeBase64' bs25- ]- , bgroup "100"- [ bench "base64-bytestring" $ whnf Bos.encode bs100- , bench "base64" $ whnf B64.encodeBase64' bs100- ]- , bgroup "1k"- [ bench "base64-bytestring" $ whnf Bos.encode bs1k- , bench "base64" $ whnf B64.encodeBase64' bs1k- ]- , bgroup "10k"- [ bench "base64-bytestring" $ whnf Bos.encode bs10k- , bench "base64" $ whnf B64.encodeBase64' bs10k- ]- , bgroup "100k"- [ bench "base64-bytestring" $ whnf Bos.encode bs100k- , bench "base64" $ whnf B64.encodeBase64' bs100k- ]- , bgroup "1mm"- [ bench "base64-bytestring" $ whnf Bos.encode bs1mm- , bench "base64" $ whnf B64.encodeBase64' bs1mm- ]- ]- , env bs' $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->- bgroup "decode"- [ bgroup "25"- [ bench "base64-bytestring" $ whnf Bos.decode bs25- , bench "base64" $ whnf B64.decodeBase64 bs25- ]- , bgroup "100"- [ bench "base64-bytestring" $ whnf Bos.decode bs100- , bench "base64" $ whnf B64.decodeBase64 bs100- ]- , bgroup "1k"- [ bench "base64-bytestring" $ whnf Bos.decode bs1k- , bench "base64" $ whnf B64.decodeBase64 bs1k- ]- , bgroup "10k"- [ bench "base64-bytestring" $ whnf Bos.decode bs10k- , bench "base64" $ whnf B64.decodeBase64 bs10k- ]- , bgroup "100k"- [ bench "base64-bytestring" $ whnf Bos.decode bs100k- , bench "base64" $ whnf B64.decodeBase64 bs100k- ]- , bgroup "1mm"- [ bench "base64-bytestring" $ whnf Bos.decode bs1mm- , bench "base64" $ whnf B64.decodeBase64 bs1mm- ]+main = defaultMain+ [ bgroup implementation+ [ bgroup (show size)+ [ env (inputs size offset) $ \ ~(raw, std, url, unpadded) ->+ bgroup ("offset-" ++ show offset)+ [ bgroup "standard"+ [ bgroup "encode"+ [ bench "base64-bytestring" $ nf Bos.encode raw+ , bench "base64" $ nf B64.encodeBase64' raw+ ]+ , bgroup "decode"+ [ bench "base64-bytestring" $ nf Bos.decode std+ , bench "base64-typed" $+ nf (B64.decodeBase64 . assertBase64 @'StdPadded) std+ , bench "base64-untyped" $ nf B64.decodeBase64Untyped std+ ]+ ]+ , bgroup "url-padded"+ [ bgroup "encode"+ [ bench "base64-bytestring" $ nf BosU.encode raw+ , bench "base64" $ nf B64U.encodeBase64' raw+ ]+ , bgroup "decode"+ [ bench "base64-bytestring" $ nf BosU.decodePadded url+ , bench "base64-typed" $+ nf (B64U.decodeBase64Padded . assertBase64) url+ , bench "base64-untyped" $ nf B64U.decodeBase64PaddedUntyped url+ ]+ ]+ , bgroup "url-unpadded"+ [ bgroup "encode"+ [ bench "base64-bytestring" $ nf BosU.encodeUnpadded raw+ , bench "base64" $ nf B64U.encodeBase64Unpadded' raw+ ]+ , bgroup "decode"+ [ bench "base64-bytestring" $ nf BosU.decodeUnpadded unpadded+ , bench "base64-typed" $+ nf (B64U.decodeBase64Unpadded . assertBase64) unpadded+ , bench "base64-untyped" $+ nf B64U.decodeBase64UnpaddedUntyped unpadded+ ]+ ]+ ]+ | offset <- [0, 1]+ ]+ | size <- [11, 12, 24, 32, 48, 64, 128, 4096, 1048576] ]- ]- where- bs = do- a <- random 25- b <- random 100- c <- random 1000- d <- random 10000- e <- random 100000- f <- random 1000000- return (a,b,c,d,e,f)+ ] - bs' = do- a <- B64.encodeBase64' <$> random 25- b <- B64.encodeBase64' <$> random 100- c <- B64.encodeBase64' <$> random 1000- d <- B64.encodeBase64' <$> random 10000- e <- B64.encodeBase64' <$> random 100000- f <- B64.encodeBase64' <$> random 1000000- return (a,b,c,d,e,f)+implementation :: String+#ifdef BASE64_SIMD+implementation = "simd"+#else+implementation = "scalar"+#endif++-- Criterion forces this environment before timing. The exact same deterministic+-- data is used for both flag settings, and encoding is excluded from decoding+-- measurements. Reference encodings supply the known-valid typed inputs.+inputs :: Int -> Int -> IO (BS.ByteString, BS.ByteString, BS.ByteString, BS.ByteString)+inputs size offset = pure+ ( sliced raw+ , sliced (Bos.encode raw)+ , sliced (BosU.encode raw)+ , sliced (BosU.encodeUnpadded raw)+ )+ where+ raw = BS.pack (take size (cycle [0 .. 255]))+ sliced bytes = BS.take (BS.length bytes) . BS.drop offset $+ BS.replicate offset 0xe5 <> bytes <> BS.replicate 32 0xff
+ benchmarks/simd-native.c view
@@ -0,0 +1,162 @@+/* Copyright (c) 2026, Emily Pillmore. BSD-3-Clause; see LICENSE. */+/* Standalone native-prefix timing; no full codec is used in timed regions.+ * Build: cc -O2 -std=c99 -Icbits benchmarks/simd-native.c cbits/base64_simd.c -o simd-native-bench+ * Every case is validated against independent scalar bytes before timing.+ */+#define _POSIX_C_SOURCE 200809L+#include <stdio.h>+#include <stdlib.h>+#include <stdint.h>+#include <string.h>+#include <time.h>+#include "base64_simd.h"++typedef size_t (*prefix_fn)(const uint8_t *, size_t, uint8_t *, const uint8_t *);+struct variant { const char *name; prefix_fn encode; prefix_fn decode; };+static const struct variant variants[] = {+ {"native", hs_base64_simd_encode, hs_base64_simd_decode}+};+#define COUNT (sizeof(variants) / sizeof(variants[0]))+static const uint8_t alphabets[2][65] = {+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"+};+static volatile size_t sink;++static void require(int condition, const char *message)+{+ if (!condition) { fprintf(stderr, "%s\n", message); exit(1); }+}+static double now(void)+{+ struct timespec t;+ require(clock_gettime(CLOCK_MONOTONIC, &t) == 0, "clock_gettime failed");+ return (double)t.tv_sec + (double)t.tv_nsec * 1e-9;+}+static void fixture(uint8_t *p, size_t len, unsigned kind)+{+ uint64_t state = UINT64_C(0x243f6a8885a308d3);+ for (size_t i = 0; i < len; i++) {+ state ^= state << 13; state ^= state >> 7; state ^= state << 17;+ p[i] = kind == 0 ? (uint8_t)state : kind == 1 ? (uint8_t)i : 90;+ }+}+static void reference_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet)+{+ for (size_t i = 0; i + 2 < len; i += 3) {+ const uint32_t n = (uint32_t)src[i] << 16 | (uint32_t)src[i + 1] << 8 | src[i + 2];+ *dst++ = alphabet[n >> 18]; *dst++ = alphabet[(n >> 12) & 63];+ *dst++ = alphabet[(n >> 6) & 63]; *dst++ = alphabet[n & 63];+ }+}+static double timed(prefix_fn fn, const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table, size_t iterations)+{+ size_t total = 0;+ const double start = now();+ for (size_t i = 0; i < iterations; i++) total += fn(src, len, dst, table);+ const double elapsed = now() - start;+ sink += total + dst[0];+ return elapsed;+}+static size_t calibrate(prefix_fn fn, const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table, double target)+{+ size_t iterations = 1;+ double elapsed;+ do {+ elapsed = timed(fn, src, len, dst, table, iterations);+ if (elapsed < 0.003) iterations *= 2;+ } while (elapsed < 0.003);+ return (size_t)((double)iterations * target / elapsed) + 1;+}+int main(int argc, char **argv)+{+ double seconds = 0.02;+ unsigned rounds = 3, timed_alphabet = 0;+ const char *only_pattern = NULL;+ const size_t sizes[] = {128, 4096, 1048576};+ const char *patterns[] = {"random", "cycle256", "repeated"};+ for (int i = 1; i < argc; i++) {+ if (strcmp(argv[i], "--seconds") == 0 && i + 1 < argc) seconds = strtod(argv[++i], NULL);+ else if (strcmp(argv[i], "--rounds") == 0 && i + 1 < argc) rounds = (unsigned)strtoul(argv[++i], NULL, 10);+ else if (strcmp(argv[i], "--pattern") == 0 && i + 1 < argc) only_pattern = argv[++i];+ else if (strcmp(argv[i], "--url") == 0) timed_alphabet = 1;+ else { fprintf(stderr, "usage: %s [--seconds 0.02] [--rounds 3] [--url] [--pattern random|cycle256|repeated]\n", argv[0]); return 1; }+ }+ require(seconds >= 0.001 && seconds <= 10 && rounds > 0 && rounds <= 50, "invalid timing options");+ if (only_pattern) {+ int found = 0;+ for (size_t i = 0; i < 3; i++) found |= strcmp(only_pattern, patterns[i]) == 0;+ require(found, "unknown --pattern (use random, cycle256, or repeated)");+ }+ const int backend = hs_base64_simd_backend();+ fprintf(stderr, "native backend=%d (0 scalar, 1 SSSE3, 2 NEON, 3 AVX2)\n", backend);+ require(backend != 0, "no native SIMD backend is available to time");++ puts("variant,operation,alphabet,data,raw_bytes,input_bytes,consumed,offset,round,iterations,ns_per_call,input_gib_per_second");+ for (unsigned kind = 0; kind < 3; kind++) {+ if (only_pattern && strcmp(only_pattern, patterns[kind]) != 0) continue;+ for (size_t n = 0; n < sizeof(sizes) / sizeof(sizes[0]); n++) {+ const size_t len = sizes[n], encoded_len = len / 3 * 4 + 4;+ for (size_t offset = 0; offset <= 1; offset++) {+ uint8_t *raw_base = malloc(len + 2), *encoded_base = malloc(encoded_len + 2);+ uint8_t *output_base = malloc(encoded_len + 34), *reference = malloc(encoded_len);+ require(raw_base && encoded_base && output_base && reference, "allocation failed");+ uint8_t *raw = raw_base + offset, *encoded = encoded_base + offset;+ uint8_t *output = output_base + offset;+ fixture(raw, len, kind);+ /* Validate both alphabets even if timing only one. */+ for (unsigned alphabet = 0; alphabet < 2; alphabet++) {+ uint8_t table[256];+ memset(table, 255, sizeof(table));+ for (size_t j = 0; j < 64; j++) table[alphabets[alphabet][j]] = (uint8_t)j;+ table['='] = 64;+ reference_encode(raw, len, encoded, alphabets[alphabet]);+ memcpy(reference, encoded, encoded_len - 4);+ memcpy(encoded + encoded_len - 4, "AAAA", 4);+ for (unsigned operation = 0; operation < 2; operation++) {+ const uint8_t *src = operation ? encoded : raw;+ const uint8_t *lookup = operation ? table : alphabets[alphabet];+ const size_t input_len = operation ? encoded_len : len;+ const uint8_t *expected = operation ? raw : reference;+ size_t consumed[COUNT] = {0}, iterations[COUNT] = {0};+ for (size_t v = 0; v < COUNT; v++) {+ prefix_fn fn = operation ? variants[v].decode : variants[v].encode;+ memset(output_base, 0xa5, encoded_len + 34);+ consumed[v] = fn(src, input_len, output, lookup);+ const size_t written = operation ? consumed[v] / 4 * 3 : consumed[v] / 3 * 4;+ require(consumed[v] <= input_len && consumed[v] % (operation ? 4 : 3) == 0,+ "invalid prefix return");+ require(!operation || input_len - consumed[v] >= 4, "final quartet consumed");+ require(memcmp(output, expected, written) == 0, "incorrect prefix bytes");+ for (size_t j = 0; j < offset; j++) require(output_base[j] == 0xa5, "leading canary changed");+ for (size_t j = written; j < encoded_len + 32; j++) require(output[j] == 0xa5, "trailing canary changed");+ if (alphabet == timed_alphabet && consumed[v] != 0)+ iterations[v] = calibrate(fn, src, input_len, output, lookup, seconds);+ }+ if (alphabet != timed_alphabet) continue;+ for (unsigned round = 0; round < rounds; round++) {+ /* Rotate implementation order to limit drift bias. */+ for (size_t order = 0; order < COUNT; order++) {+ const size_t v = (order + round) % COUNT;+ if (consumed[v] == 0) continue;+ prefix_fn fn = operation ? variants[v].decode : variants[v].encode;+ const double elapsed = timed(fn, src, input_len, output, lookup, iterations[v]);+ const double ns = elapsed * 1e9 / iterations[v];+ printf("%s,%s,%s,%s,%zu,%zu,%zu,%zu,%u,%zu,%.6f,%.6f\n",+ variants[v].name, operation ? "decode" : "encode", alphabet ? "url" : "standard",+ patterns[kind], len, input_len, consumed[v], offset, round, iterations[v], ns,+ consumed[v] / ns * 1e9 / 1073741824.0);+ }+ }+ }+ }+ free(reference); free(output_base); free(encoded_base); free(raw_base);+ }+ }+ }+ fprintf(stderr, "validated both alphabets; checksum=%zu\n", sink);+ return 0;+}
+ cbits/base64_simd.c view
@@ -0,0 +1,443 @@+/* Copyright (c) 2026, Emily Pillmore. BSD-3-Clause; see LICENSE. */++#include <string.h>++#include "base64_simd.h"++/*+ * These are original prefix kernels. No external SIMD library is required.+ * Target-specific instructions are confined to their implementation below;+ * x86 builds need no global ISA flags, and dispatch has no mutable state.+ * HS_BASE64_SIMD_FORCE_SCALAR exercises the unsupported-target fallback.+ * HS_BASE64_SIMD_FORCE_SSSE3 caps x86 dispatch for testing older processors.+ */+#if !defined(HS_BASE64_SIMD_FORCE_SCALAR)+#if defined(__aarch64__) && defined(__ARM_NEON) && \+ (defined(__GNUC__) || defined(__clang__))+#define HS_BASE64_NEON 1+#include <arm_neon.h>+#elif defined(__x86_64__) && (defined(__GNUC__) || defined(__clang__))+#define HS_BASE64_SSSE3 1+#include <immintrin.h>+#define HS_BASE64_TARGET_SSSE3 __attribute__((target("ssse3")))+#if !defined(HS_BASE64_SIMD_FORCE_SSSE3)+#define HS_BASE64_AVX2 1+#define HS_BASE64_TARGET_AVX2 __attribute__((target("avx2")))+#endif+#endif+#endif++#if defined(HS_BASE64_NEON) || defined(HS_BASE64_SSSE3)+/*+ * Nibble-table classification, following the lookup approach used by Klomp+ * and simdutf. These masks are derived directly from our two alphabets:+ * bit h in valid_lo[l] says that byte (h << 4) | l is a valid character.+ * valid_hi[h] selects that bit for h = 2..7, and is zero otherwise.+ * Their intersection is nonzero exactly for an alphabet character, including+ * neither padding nor bytes >= 128. Rows are standard Base64, then Base64url.+ */+static const uint8_t hs_base64_valid_lo[2][16] = {+ {0xa8, 0xf8, 0xf8, 0xf8, 0xf8, 0xf8, 0xf8, 0xf8,+ 0xf8, 0xf8, 0xf0, 0x54, 0x50, 0x50, 0x50, 0x54},+ {0xa8, 0xf8, 0xf8, 0xf8, 0xf8, 0xf8, 0xf8, 0xf8,+ 0xf8, 0xf8, 0xf0, 0x50, 0x50, 0x54, 0x50, 0x70}+};+static const uint8_t hs_base64_valid_hi[16] = {+ 0, 0, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0, 0, 0, 0, 0, 0, 0, 0+};++/*+ * Add these offsets modulo 256 to ASCII to obtain its sextet. The only+ * exception in each alphabet is its last character: '/' needs -3 after the+ * '+' offset; '_' needs +33 after the uppercase offset. Invalid lanes are+ * checked separately, so their translated values are never stored.+ */+static const uint8_t hs_base64_offsets[2][16] = {+ {0, 0, 62 - '+', 52 - '0', 256 - 'A', 256 - 'A',+ 256 + 26 - 'a', 256 + 26 - 'a', 0, 0, 0, 0, 0, 0, 0, 0},+ {0, 0, 62 - '-', 52 - '0', 256 - 'A', 256 - 'A',+ 256 + 26 - 'a', 256 + 26 - 'a', 0, 0, 0, 0, 0, 0, 0, 0}+};+#endif++#if defined(HS_BASE64_NEON)++static size_t hs_base64_neon_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet)+{+ size_t consumed = 0;+ uint8x16x4_t lookup;+ const uint8x16_t mask = vdupq_n_u8(63);++ if (len < 48) {+ return 0;+ }+ lookup.val[0] = vld1q_u8(alphabet);+ lookup.val[1] = vld1q_u8(alphabet + 16);+ lookup.val[2] = vld1q_u8(alphabet + 32);+ lookup.val[3] = vld1q_u8(alphabet + 48);++ while (len - consumed >= 48) {+ /* Deinterleave sixteen triples without reading beyond their 48 bytes a la Klomp */+ const uint8x16x3_t input = vld3q_u8(src + consumed);+ uint8x16x4_t output;+ const uint8x16_t a = vshrq_n_u8(input.val[0], 2);+ const uint8x16_t b = vandq_u8(mask, vorrq_u8(vshlq_n_u8(input.val[0], 4),+ vshrq_n_u8(input.val[1], 4)));+ const uint8x16_t c = vandq_u8(mask, vorrq_u8(vshlq_n_u8(input.val[1], 2),+ vshrq_n_u8(input.val[2], 6)));+ const uint8x16_t d = vandq_u8(mask, input.val[2]);+ output.val[0] = vqtbl4q_u8(lookup, a);+ output.val[1] = vqtbl4q_u8(lookup, b);+ output.val[2] = vqtbl4q_u8(lookup, c);+ output.val[3] = vqtbl4q_u8(lookup, d);+ vst4q_u8(dst, output);+ consumed += 48;+ dst += 64;+ }+ return consumed;+}++static inline uint8x16_t hs_base64_neon_sextets(uint8x16_t input,+ uint8x16_t valid_lo, uint8x16_t valid_hi, uint8x16_t offsets,+ uint8x16_t last_char, uint8x16_t last_adjustment, uint8x16_t *valid)+{+ const uint8x16_t lo = vandq_u8(input, vdupq_n_u8(15));+ const uint8x16_t hi = vshrq_n_u8(input, 4);+ const uint8x16_t adjustment = vandq_u8(vceqq_u8(input, last_char), last_adjustment);++ *valid = vandq_u8(vqtbl1q_u8(valid_lo, lo), vqtbl1q_u8(valid_hi, hi));+ return vaddq_u8(input, vaddq_u8(vqtbl1q_u8(offsets, hi), adjustment));+}++static size_t hs_base64_neon_decode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table)+{+ size_t consumed = 0;++ if (len < 68) {+ return 0;+ }+ const int is_url = table['-'] == 62;+ const uint8x16_t valid_lo = vld1q_u8(hs_base64_valid_lo[is_url]);+ const uint8x16_t valid_hi = vld1q_u8(hs_base64_valid_hi);+ const uint8x16_t offsets = vld1q_u8(hs_base64_offsets[is_url]);+ const uint8x16_t last_char = vdupq_n_u8(is_url ? '_' : '/');+ const uint8x16_t last_adjustment = vdupq_n_u8((uint8_t)(is_url ? 33 : -3));++ /* Always reserve the last quartet for Haskell's padding/canonical checks not ala Klomp */+ while (len - consumed >= 68) {+ const uint8x16x4_t input = vld4q_u8(src + consumed);+ uint8x16_t valid_a, valid_b, valid_c, valid_d;+ const uint8x16_t a = hs_base64_neon_sextets(input.val[0], valid_lo, valid_hi,+ offsets, last_char, last_adjustment, &valid_a);+ const uint8x16_t b = hs_base64_neon_sextets(input.val[1], valid_lo, valid_hi,+ offsets, last_char, last_adjustment, &valid_b);+ const uint8x16_t c = hs_base64_neon_sextets(input.val[2], valid_lo, valid_hi,+ offsets, last_char, last_adjustment, &valid_c);+ const uint8x16_t d = hs_base64_neon_sextets(input.val[3], valid_lo, valid_hi,+ offsets, last_char, last_adjustment, &valid_d);+ const uint8x16_t valid = vminq_u8(vminq_u8(valid_a, valid_b),+ vminq_u8(valid_c, valid_d));+ uint8x16x3_t output;++ if (vminvq_u8(valid) == 0) {+ break;+ }+ output.val[0] = vorrq_u8(vshlq_n_u8(a, 2), vshrq_n_u8(b, 4));+ output.val[1] = vorrq_u8(vshlq_n_u8(b, 4), vshrq_n_u8(c, 2));+ output.val[2] = vorrq_u8(vshlq_n_u8(c, 6), d);+ vst3q_u8(dst, output);+ consumed += 64;+ dst += 48;+ }+ return consumed;+}++#elif defined(HS_BASE64_SSSE3)++HS_BASE64_TARGET_SSSE3+static size_t hs_base64_ssse3_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet)+{+ size_t consumed = 0;+ __m128i lookup[4];+ const __m128i gather = _mm_setr_epi8(2, 1, 0, -1, 5, 4, 3, -1,+ 8, 7, 6, -1, 11, 10, 9, -1);++ if (len < 12) {+ return 0;+ }+ for (size_t i = 0; i < 4; i++) {+ lookup[i] = _mm_loadu_si128((const __m128i *)(alphabet + i * 16));+ }++ while (len - consumed >= 12) {+ __m128i input = _mm_setzero_si128();+ __m128i indices;+ __m128i high;+ __m128i output = _mm_setzero_si128();++ /* memcpy expresses a 12-byte load, including at the buffer boundary. */+ memcpy(&input, src + consumed, 12);+ input = _mm_shuffle_epi8(input, gather);+ /* Each 32-bit lane is now a big-endian 24-bit input triple. */+ indices = _mm_and_si128(_mm_srli_epi32(input, 18), _mm_set1_epi32(0x0000003f));+ indices = _mm_or_si128(indices,+ _mm_and_si128(_mm_srli_epi32(input, 4), _mm_set1_epi32(0x00003f00)));+ indices = _mm_or_si128(indices,+ _mm_and_si128(_mm_slli_epi32(input, 10), _mm_set1_epi32(0x003f0000)));+ indices = _mm_or_si128(indices,+ _mm_and_si128(_mm_slli_epi32(input, 24), _mm_set1_epi32(0x3f000000)));+ high = _mm_and_si128(indices, _mm_set1_epi8(0x30));+ for (size_t i = 0; i < 4; i++) {+ const __m128i matches = _mm_cmpeq_epi8(high, _mm_set1_epi8((char)(i * 16)));+ output = _mm_or_si128(output,+ _mm_and_si128(matches, _mm_shuffle_epi8(lookup[i], indices)));+ }+ _mm_storeu_si128((__m128i *)dst, output);+ consumed += 12;+ dst += 16;+ }+ return consumed;+}++HS_BASE64_TARGET_SSSE3+static size_t hs_base64_ssse3_decode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table)+{+ size_t consumed = 0;+ const __m128i scatter = _mm_setr_epi8(2, 1, 0, 6, 5, 4, 10, 9,+ 8, 14, 13, 12, -1, -1, -1, -1);++ if (len < 20) {+ return 0;+ }+ const int is_url = table['-'] == 62;+ const __m128i valid_lo = _mm_loadu_si128((const __m128i *)hs_base64_valid_lo[is_url]);+ const __m128i valid_hi = _mm_loadu_si128((const __m128i *)hs_base64_valid_hi);+ const __m128i offsets = _mm_loadu_si128((const __m128i *)hs_base64_offsets[is_url]);+ const __m128i last_char = _mm_set1_epi8(is_url ? '_' : '/');+ const __m128i last_adjustment = _mm_set1_epi8(is_url ? 33 : -3);+ const __m128i nibble_mask = _mm_set1_epi8(15);++ while (len - consumed >= 20) {+ const __m128i input = _mm_loadu_si128((const __m128i *)(src + consumed));+ const __m128i lo = _mm_and_si128(input, nibble_mask);+ const __m128i hi = _mm_and_si128(_mm_srli_epi16(input, 4), nibble_mask);+ const __m128i valid = _mm_and_si128(_mm_shuffle_epi8(valid_lo, lo),+ _mm_shuffle_epi8(valid_hi, hi));+ const __m128i adjustment = _mm_and_si128(_mm_cmpeq_epi8(input, last_char),+ last_adjustment);+ __m128i value;+ __m128i output;++ if (_mm_movemask_epi8(_mm_cmpeq_epi8(valid, _mm_setzero_si128())) != 0) {+ break;+ }+ value = _mm_add_epi8(input,+ _mm_add_epi8(_mm_shuffle_epi8(offsets, hi), adjustment));++ /* Adjacent sextets become 12-bit pairs, then 24-bit triples. */+ output = _mm_maddubs_epi16(value, _mm_set1_epi32(0x01400140));+ output = _mm_madd_epi16(output, _mm_set1_epi32(0x00011000));+ output = _mm_shuffle_epi8(output, scatter);+ /* A 16-byte store would overwrite Haskell's uncommitted suffix. */+ memcpy(dst, &output, 12);+ consumed += 16;+ dst += 12;+ }+ return consumed;+}++#if defined(HS_BASE64_AVX2)++HS_BASE64_TARGET_AVX2+static inline __m128i hs_base64_avx2_load12(const uint8_t *src)+{+ int64_t first;+ int32_t last;+ memcpy(&first, src, sizeof(first));+ memcpy(&last, src + 8, sizeof(last));+ return _mm_insert_epi32(_mm_cvtsi64_si128(first), last, 2);+}++HS_BASE64_TARGET_AVX2+static inline void hs_base64_avx2_store12(uint8_t *dst, __m128i value)+{+ const int64_t first = _mm_cvtsi128_si64(value);+ const int32_t last = _mm_extract_epi32(value, 2);+ memcpy(dst, &first, sizeof(first));+ memcpy(dst + 8, &last, sizeof(last));+}++HS_BASE64_TARGET_AVX2+static size_t hs_base64_avx2_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet)+{+ size_t consumed = 0;+ __m256i lookup[4];+ const __m256i gather = _mm256_broadcastsi128_si256(+ _mm_setr_epi8(2, 1, 0, -1, 5, 4, 3, -1, 8, 7, 6, -1, 11, 10, 9, -1));++ if (len < 24) {+ return 0;+ }+ for (size_t i = 0; i < 4; i++) {+ lookup[i] = _mm256_broadcastsi128_si256(+ _mm_loadu_si128((const __m128i *)(alphabet + i * 16)));+ }++ while (len - consumed >= 24) {+ const __m128i first = hs_base64_avx2_load12(src + consumed);+ const __m128i second = hs_base64_avx2_load12(src + consumed + 12);+ __m256i input;+ __m256i indices;+ __m256i high;+ __m256i output = _mm256_setzero_si256();++ /* Each 128-bit lane receives exactly four triples; neither load is wide. */+ input = _mm256_inserti128_si256(_mm256_castsi128_si256(first), second, 1);+ input = _mm256_shuffle_epi8(input, gather);+ indices = _mm256_and_si256(_mm256_srli_epi32(input, 18),+ _mm256_set1_epi32(0x0000003f));+ indices = _mm256_or_si256(indices,+ _mm256_and_si256(_mm256_srli_epi32(input, 4), _mm256_set1_epi32(0x00003f00)));+ indices = _mm256_or_si256(indices,+ _mm256_and_si256(_mm256_slli_epi32(input, 10), _mm256_set1_epi32(0x003f0000)));+ indices = _mm256_or_si256(indices,+ _mm256_and_si256(_mm256_slli_epi32(input, 24), _mm256_set1_epi32(0x3f000000)));+ high = _mm256_and_si256(indices, _mm256_set1_epi8(0x30));+ for (size_t i = 0; i < 4; i++) {+ const __m256i matches = _mm256_cmpeq_epi8(high, _mm256_set1_epi8((char)(i * 16)));+ output = _mm256_or_si256(output,+ _mm256_and_si256(matches, _mm256_shuffle_epi8(lookup[i], indices)));+ }+ _mm256_storeu_si256((__m256i *)dst, output);+ consumed += 24;+ dst += 32;+ }+ return consumed;+}++HS_BASE64_TARGET_AVX2+static size_t hs_base64_avx2_decode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table)+{+ size_t consumed = 0;+ const __m256i scatter = _mm256_broadcastsi128_si256(+ _mm_setr_epi8(2, 1, 0, 6, 5, 4, 10, 9, 8, 14, 13, 12, -1, -1, -1, -1));++ if (len < 36) {+ return 0;+ }+ const int is_url = table['-'] == 62;+ const __m256i valid_lo = _mm256_broadcastsi128_si256(+ _mm_loadu_si128((const __m128i *)hs_base64_valid_lo[is_url]));+ const __m256i valid_hi = _mm256_broadcastsi128_si256(+ _mm_loadu_si128((const __m128i *)hs_base64_valid_hi));+ const __m256i offsets = _mm256_broadcastsi128_si256(+ _mm_loadu_si128((const __m128i *)hs_base64_offsets[is_url]));+ const __m256i last_char = _mm256_set1_epi8(is_url ? '_' : '/');+ const __m256i last_adjustment = _mm256_set1_epi8(is_url ? 33 : -3);+ const __m256i nibble_mask = _mm256_set1_epi8(15);++ while (len - consumed >= 36) {+ const __m256i input = _mm256_loadu_si256((const __m256i *)(src + consumed));+ const __m256i lo = _mm256_and_si256(input, nibble_mask);+ const __m256i hi = _mm256_and_si256(_mm256_srli_epi16(input, 4), nibble_mask);+ const __m256i valid = _mm256_and_si256(_mm256_shuffle_epi8(valid_lo, lo),+ _mm256_shuffle_epi8(valid_hi, hi));+ const __m256i adjustment = _mm256_and_si256(_mm256_cmpeq_epi8(input, last_char),+ last_adjustment);+ __m256i value;+ __m256i output;+ __m128i first;+ __m128i second;++ /* Validate both lanes before committing any bytes from this block. */+ if (_mm256_movemask_epi8(_mm256_cmpeq_epi8(valid, _mm256_setzero_si256())) != 0) {+ break;+ }+ value = _mm256_add_epi8(input,+ _mm256_add_epi8(_mm256_shuffle_epi8(offsets, hi), adjustment));+ output = _mm256_maddubs_epi16(value, _mm256_set1_epi32(0x01400140));+ output = _mm256_madd_epi16(output, _mm256_set1_epi32(0x00011000));+ output = _mm256_shuffle_epi8(output, scatter);+ first = _mm256_castsi256_si128(output);+ second = _mm256_extracti128_si256(output, 1);+ /* Store exactly 24 bytes, with no gaps or overlapping speculative bytes. */+ hs_base64_avx2_store12(dst, first);+ hs_base64_avx2_store12(dst + 12, second);+ consumed += 32;+ dst += 24;+ }+ return consumed;+}++#endif /* HS_BASE64_AVX2 */++#endif++int hs_base64_simd_backend(void)+{+#if defined(HS_BASE64_NEON)+ return 2;+#elif defined(HS_BASE64_SSSE3)+#if defined(HS_BASE64_AVX2)+ /* The compiler's CPU query also checks OS support for the AVX register state. */+ if (__builtin_cpu_supports("avx2")) {+ return 3;+ }+#endif+ return __builtin_cpu_supports("ssse3") ? 1 : 0;+#else+ return 0;+#endif+}++size_t hs_base64_simd_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet)+{+#if defined(HS_BASE64_NEON)+ return hs_base64_neon_encode(src, len, dst, alphabet);+#elif defined(HS_BASE64_SSSE3)+ const int backend = hs_base64_simd_backend();+#if defined(HS_BASE64_AVX2)+ if (backend == 3) {+ return hs_base64_avx2_encode(src, len, dst, alphabet);+ }+#endif+ if (backend == 1) {+ return hs_base64_ssse3_encode(src, len, dst, alphabet);+ }+#endif+ (void)src;+ (void)len;+ (void)dst;+ (void)alphabet;+ return 0;+}++size_t hs_base64_simd_decode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table)+{+#if defined(HS_BASE64_NEON)+ return hs_base64_neon_decode(src, len, dst, table);+#elif defined(HS_BASE64_SSSE3)+ const int backend = hs_base64_simd_backend();+#if defined(HS_BASE64_AVX2)+ if (backend == 3) {+ return hs_base64_avx2_decode(src, len, dst, table);+ }+#endif+ if (backend == 1) {+ return hs_base64_ssse3_decode(src, len, dst, table);+ }+#endif+ (void)src;+ (void)len;+ (void)dst;+ (void)table;+ return 0;+}
+ cbits/base64_simd.h view
@@ -0,0 +1,44 @@+/* Copyright (c) 2026, Emily Pillmore. BSD-3-Clause; see LICENSE. */++#ifndef HS_BASE64_SIMD_H+#define HS_BASE64_SIMD_H++#include <stddef.h>+#include <stdint.h>++#ifdef __cplusplus+extern "C" {+#endif++/*+ * Process a prefix only; the Haskell implementation handles the remaining+ * bytes, padding, and error reporting. Source and destination must not overlap.+ * Source loads remain inside len; destination stores cover only the produced+ * prefix. Alphabet/table pointers must identify the complete tables below.+ *+ * Encode returns a multiple of 3 and writes exactly (result / 3) * 4 bytes.+ * Alphabet points to the existing 64-byte standard or URL alphabet.+ *+ * Decode returns a multiple of 4, leaves at least the final 4 source bytes,+ * and writes exactly (result / 4) * 3 bytes. A vector block containing an+ * invalid byte or padding is left completely untouched. Table points to the+ * existing 256-byte decoding table: table['-'] == 62 selects URL decoding.+ *+ * Unsupported targets return zero without reading or writing any buffers.+ */+size_t hs_base64_simd_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet);+size_t hs_base64_simd_decode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table);++/*+ * 0: scalar fallback; 1: x86-64 SSSE3; 2: ARM64 NEON; 3: x86-64 AVX2.+ * x86 features are detected at runtime; AVX2 is preferred when supported.+ */+int hs_base64_simd_backend(void);++#ifdef __cplusplus+}+#endif++#endif /* HS_BASE64_SIMD_H */
+ src/Data/Base64/Types.hs view
@@ -0,0 +1,114 @@+{-# language DataKinds #-}+{-# language PolyKinds #-}+{-# language RankNTypes #-}+{-# language TypeFamilies #-}+{-# language UndecidableInstances #-}+-- |+-- Module : Data.ByteString.Base64.Types+-- Copyright : (c) 2019-2026 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable+--+-- This module contains the 'Base64' type definition, 'Alphabet'+-- datatype, alphabet constraints, and various quality of life+-- combinators for working with 'Base64'-wrapped data.+--+module Data.Base64.Types+( Alphabet(..)+, type Base64+, assertBase64+, extractBase64+, coerceBase64+, type UrlAlphabet+, type StdAlphabet+, type NonStandardAlphabet+) where+++import Data.Base64.Types.Internal (Alphabet(..), Base64(..))+import Data.Coerce (coerce)+import Data.Kind++import GHC.TypeLits+++-- | Assert the provenance of a value encoded in a particular+-- base64 alphabet.+--+-- For untrusted input, use @parseBase64@ for standard Base64, or+-- @parseBase64Padded@ / @parseBase64Unpadded@ for Base64url, in the+-- corresponding ByteString or Text module to validate it first.+--+-- /Warning/: This is a blind assertion that a particular+-- value is base64 encoded in some alphabet. If you are not+-- sure of the provenance of the value, you may experience+-- odd behavior when attempting to decode. Use at your own+-- risk. If I see any issues logged on this project from+-- negligent use of this or 'coerceBase64', I will+-- smite you.+--+assertBase64 :: forall k a. a -> Base64 k a+assertBase64 = Base64++-- | Forget the provenance of a base64-encoded value.+--+extractBase64 :: Base64 k a -> a+extractBase64 (Base64 a) = a++-- | Coerce the alphabet of a base64-encoded bytestring+--+-- /Warning/: This is a blind assertion that a particular+-- value is base64 encoded in some alphabet. If you are not+-- sure of the provenance of the value, you may experience+-- odd behavior when attempting to decode. Use at your own+-- risk. If I see any issues logged on this project from+-- negligent use of this or 'assertBase64', I will+-- smite you.+--+coerceBase64 :: forall j k a. Base64 k a -> Base64 j a+coerceBase64 = coerce++-- | The type family of Url-safe alphabets+--+-- This type family defines the union of compatible Url-safe base64 types.+-- To write a function that is parametric over such types, issue a+-- constraint like `forall k. UrlAlphabet k`.+--+type family UrlAlphabet k :: Constraint where+ UrlAlphabet 'UrlPadded = ()+ UrlAlphabet 'UrlUnpadded = ()+ UrlAlphabet _ = TypeError+ ( 'Text "Cannot prove base64 value is encoded using the url-safe \+ \alphabet. Please re-encode using the url-safe encoders, or use \+ \a lenient decoder for the url-safe alphabet instead."+ )++-- | The type family of standard alphabets+--+-- This type family defines the union of compatible standard+-- alphabet base64 types+--+type family StdAlphabet k :: Constraint where+ StdAlphabet 'StdPadded = ()+ StdAlphabet _ = TypeError+ ( 'Text "Cannot prove base64 value is encoded using the std \+ \alphabet. Please re-encode using the std encoders, or use \+ \a lenient decoder for the std alphabet instead."+ )++-- | The type family of non-standard alphabets+--+-- Only untyped variants of encodeBase64/decodeBase64 can interact with this+-- type family, in addition to assertion\/coercion\/extraction of+-- these types of values.+--+type family NonStandardAlphabet k :: Constraint where+ NonStandardAlphabet 'NonStandard = ()+ NonStandardAlphabet _ = TypeError+ ( 'Text "Cannot prove base64 value is encoded using a non-standard \+ \alphabet. Please re-encode and assert/coerce the alphabet, \+ \and use a lenient decoder."+ )
+ src/Data/Base64/Types/Internal.hs view
@@ -0,0 +1,72 @@+{-# language DataKinds #-}+{-# language RankNTypes #-}+{-# language TypeFamilies #-}+-- |+-- Module : Data.ByteString.Base64.Types.Internal+-- Copyright : (c) 2019-2026 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable+--+-- This module contains the 'Base64' newtype, 'Alphabet'+-- datatype, and associated instances for 'Base64'.+--+module Data.Base64.Types.Internal+( Alphabet(..)+, Base64(..)+) where+++import Control.DeepSeq (NFData, rnf)++-- | The different kinds of supported Base64 encodings. This library supports the encodings defined in +-- [RFC 4648](https://datatracker.ietf.org/doc/html/rfc4648) and [RFC 7049](https://datatracker.ietf.org/doc/html/rfc7049).+--+-- [RFC 2045](https://www.ietf.org/rfc/rfc2045.txt) defines a separate Base64 encoding for MIME, which is not supported.+-- This format requires a newline at least every 76 encoded characters, which works around+-- limitations of older email programs that could not handle long lines.+-- Be aware that other languages, such as Ruby, encode the RFC 2045 version+-- by default. To decode their ouput, remove all newlines before decoding.+data Alphabet+ = StdPadded+ -- ^ Standard base64 according to [RFC 4648 §4](https://datatracker.ietf.org/doc/html/rfc4648#section-4)+ -- Padding is inserted when needed and required by the standard parser and decoder.+ | UrlPadded+ -- ^ URL-safe base64 according to [RFC 4648 §5](https://datatracker.ietf.org/doc/html/rfc4648#section-5) aka base64url.+ -- Padding is inserted when needed and required by the padded parser and decoder.+ | UrlUnpadded+ -- ^ URL-safe base64 according to [RFC 4648 §5](https://datatracker.ietf.org/doc/html/rfc4648#section-5) aka base64url+ -- Padding is never inserted and is rejected by the unpadded parser and decoder.+ | NonStandard+ -- ^ Any non-standard, non RFC 4648-compliant base64 encoding.+ -- Can only be decoded using lenient decoders.+ -- This marker does not define an alphabet or canonical validation rules.++-- | Wraps a value, asserting that it is or is intended to be+-- in a particular kind of Base64 encoding use 'extractBase64'+-- to extract the value, and 'assertBase64' to tag a value+-- as base64-encoded+--+newtype Base64 (k :: Alphabet) a = Base64 a++instance forall k. Functor (Base64 k) where+ fmap f (Base64 a) = Base64 (f a)++instance forall k a. (Eq a) => Eq (Base64 k a) where+ Base64 a == Base64 b = a == b++instance forall k. Applicative (Base64 k) where+ pure = Base64+ Base64 f <*> Base64 a = Base64 (f a)++instance forall k. Monad (Base64 k) where+ return = pure+ Base64 a >>= k = k a++instance forall k a. (Show a) => Show (Base64 k a) where+ show (Base64 a) = show a++instance forall k a. NFData a => NFData (Base64 k a) where+ rnf (Base64 a) = rnf a
src/Data/ByteString/Base64.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Base64--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -21,23 +21,29 @@ , encodeBase64' -- * Decoding , decodeBase64+, decodeBase64Untyped , decodeBase64Lenient- -- * Validation-, isBase64-, isValidBase64+ -- * Parsing+, parseBase64 ) where +import Data.Base64.Types import Data.ByteString.Internal (ByteString(..))-import Data.ByteString.Base64.Internal import Data.ByteString.Base64.Internal.Head import Data.ByteString.Base64.Internal.Tables-import Data.Either (isRight) import Data.Text (Text) import qualified Data.Text.Encoding as T import System.IO.Unsafe +-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+-- -- | Encode a 'ByteString' value as Base64 'Text' with padding. --@@ -48,8 +54,8 @@ -- >>> encodeBase64 "Sun" -- "U3Vu" ---encodeBase64 :: ByteString -> Text-encodeBase64 = T.decodeUtf8 . encodeBase64'+encodeBase64 :: ByteString -> Base64 'StdPadded Text+encodeBase64 = fmap T.decodeUtf8 . encodeBase64' {-# inline encodeBase64 #-} -- | Encode a 'ByteString' value as a Base64 'ByteString' value with padding.@@ -61,8 +67,8 @@ -- >>> encodeBase64' "Sun" -- "U3Vu" ---encodeBase64' :: ByteString -> ByteString-encodeBase64' = encodeBase64_ base64Table+encodeBase64' :: ByteString -> Base64 'StdPadded ByteString+encodeBase64' = assertBase64 . encodeBase64_ base64Table {-# inline encodeBase64' #-} -- | Decode a padded Base64-encoded 'ByteString' value.@@ -71,26 +77,39 @@ -- -- === __Examples__: ----- >>> decodeBase64 "U3Vu"+-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"+-- "Sun"+--+decodeBase64 :: StdAlphabet k => Base64 k ByteString -> ByteString+decodeBase64 = decodeBase64Typed_ decodeB64Table+{-# inline decodeBase64 #-}++-- | Decode a padded untyped Base64-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Untyped "U3Vu" -- Right "Sun" ----- >>> decodeBase64 "U3V"+-- >>> decodeBase64Untyped "U3V" -- Left "Base64-encoded bytestring requires padding" ----- >>> decodebase64 "U3V="+-- >>> decodeBase64Untyped "U3V=" -- Left "non-canonical encoding detected at offset: 2" ---decodeBase64 :: ByteString -> Either Text ByteString-decodeBase64 bs@(PS _ _ !l)- | l == 0 = Right bs+decodeBase64Untyped :: ByteString -> Either Text ByteString+decodeBase64Untyped bs@(PS _ _ !l)+ | l == 0 = Right mempty | r == 1 = Left "Base64-encoded bytestring has invalid size" | r /= 0 = Left "Base64-encoded bytestring requires padding" | otherwise = unsafeDupablePerformIO $ decodeBase64_ decodeB64Table bs where !r = l `rem` 4-{-# inline decodeBase64 #-}+{-# inline decodeBase64Untyped #-} --- | Leniently decode an unpadded Base64-encoded 'ByteString' value. This function+-- | Leniently decode an untyped Base64-encoded 'ByteString' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -104,54 +123,36 @@ -- >>> decodeBase64Lenient "U3V" -- "Su" ----- >>> decodebase64Lenient "U3V="+-- >>> decodeBase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ByteString -> ByteString decodeBase64Lenient = decodeBase64Lenient_ decodeB64Table {-# inline decodeBase64Lenient #-} --- | Tell whether a 'ByteString' value is base64 encoded.+-- | Parse a canonical, padded Base64-encoded 'ByteString' value. ----- This function will also detect non-canonical encodings such as @ZE==@, which are--- externally valid Base64url-encoded values, but are internally inconsistent "impossible"--- values.+-- Checks the alphabet, length, padding, and unused padding bits. On success,+-- returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isBase64 "U3Vu"--- True------ >>> isBase64 "U3V"--- False------ >>> isBase64 "U3V="--- False----isBase64 :: ByteString -> Bool-isBase64 bs = isValidBase64 bs && isRight (decodeBase64 bs)-{-# inline isBase64 #-}---- | Tell whether a 'ByteString' value is a valid Base64 format.------ This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ByteString' value, use 'isBase64'.------ === __Examples__:+-- >>> parseBase64 "U3Vu"+-- Right "U3Vu" ----- >>> isValidBase64 "U3Vu"--- True+-- >>> fmap decodeBase64 (parseBase64 "U3Vu")+-- Right "Sun" ----- >>> isValidBase64 "U3V"--- True+-- >>> parseBase64 "U3V"+-- Left "Base64-encoded bytestring requires padding" ----- >>> isValidBase64 "U3V="--- True+-- >>> parseBase64 "U3V="+-- Left "non-canonical encoding detected at offset: 2" ----- >>> isValidBase64 "%"--- False+-- @since 2.0 ---isValidBase64 :: ByteString -> Bool-isValidBase64 = validateBase64 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"-{-# inline isValidBase64 #-}+parseBase64 :: ByteString -> Either Text (Base64 'StdPadded ByteString)+parseBase64 bs = assertBase64 bs <$ decodeBase64Untyped bs+{-# INLINE parseBase64 #-}
src/Data/ByteString/Base64/Internal.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -17,9 +12,7 @@ -- processes and tables. -- module Data.ByteString.Base64.Internal-( validateBase64-, validateBase64Url-, validateLastPad+( validateLastPad ) where @@ -27,61 +20,8 @@ import Data.ByteString.Internal import Data.Text (Text) -import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable- import System.IO.Unsafe --- | Given a bytestring, check to see that it conforms to a given alphabet----validateBase64 :: ByteString -> ByteString -> Bool-validateBase64 !alphabet (PS !fp !off !l) =- accursedUnutterablePerformIO $ withForeignPtr fp $ \p ->- go (plusPtr p off) (plusPtr p (l + off))- where- go !p !end- | p == end = return True- | otherwise = do- w <- peek p-- let f a- | a == 0x3d, plusPtr p 1 == end = True- | a == 0x3d, plusPtr p 2 == end = True- | a == 0x3d = False- | otherwise = BS.elem a alphabet-- if f w then go (plusPtr p 1) end else return False-{-# INLINE validateBase64 #-}--validateBase64Url :: ByteString -> ByteString -> Bool-validateBase64Url !alphabet bs@(PS _ _ l)- | l == 0 = True- | r == 0 = f bs- | r == 2 = f (BS.append bs "==")- | r == 3 = f (BS.append bs "=")- | otherwise = False-- where- r = l `rem` 4-- f (PS fp o n) = accursedUnutterablePerformIO $- withForeignPtr fp $ \p -> go (plusPtr p o) (plusPtr p (n + o))-- go !p !end- | p == end = return True- | otherwise = do- w <- peek p-- let check a- | a == 0x3d, plusPtr p 1 == end = True- | a == 0x3d, plusPtr p 2 == end = True- | a == 0x3d = False- | otherwise = BS.elem a alphabet-- if check w then go (plusPtr p 1) end else return False-{-# INLINE validateBase64Url #-}- -- | This function checks that the last char of a bytestring is '=' -- and, if true, fails with a message or completes some io action. --@@ -106,7 +46,7 @@ :: ByteString -> IO (Either Text ByteString) -> Either Text ByteString-validateLastPad !bs io+validateLastPad bs io | BS.last bs == 0x3d = Left "Base64-encoded bytestring has invalid padding" | otherwise = unsafeDupablePerformIO io {-# INLINE validateLastPad #-}
src/Data/ByteString/Base64/Internal/Head.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.Head--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -17,19 +16,16 @@ ( encodeBase64_ , encodeBase64Nopad_ , decodeBase64_+, decodeBase64Typed_ , decodeBase64Lenient_ ) where -#include "MachDeps.h"-+import Data.Base64.Types.Internal import Data.ByteString.Base64.Internal.Tail import Data.ByteString.Base64.Internal.Utils-#if WORD_SIZE_IN_BITS == 32-import Data.ByteString.Base64.Internal.W32.Loop-#elif WORD_SIZE_IN_BITS >= 64 import Data.ByteString.Base64.Internal.W64.Loop-#else-import Data.ByteString.Base64.Internal.W16.Loop+#ifdef BASE64_SIMD+import Data.ByteString.Base64.Internal.SIMD #endif import Data.ByteString.Internal import Data.Text (Text)@@ -40,7 +36,7 @@ import GHC.ForeignPtr import GHC.Word -import System.IO.Unsafe+import System.IO.Unsafe ( unsafeDupablePerformIO ) encodeBase64_ :: EncodingTable -> ByteString -> ByteString@@ -51,12 +47,17 @@ withForeignPtr sfp $ \sptr -> withForeignPtr efp $ \eptr -> do let !end = plusPtr sptr (soff + slen)+#ifdef BASE64_SIMD+ consumed <- encodePrefix (plusPtr sptr soff) slen dptr aptr+#else+ let consumed = 0+#endif innerLoop eptr- (castPtr (plusPtr sptr soff))- (castPtr dptr)+ (castPtr (plusPtr sptr (soff + consumed)))+ (castPtr (plusPtr dptr ((consumed `quot` 3) * 4))) end- (loopTail dfp aptr dptr (castPtr end))+ (loopTail dfp dptr aptr (castPtr end)) where !dlen = 4 * ((slen + 2) `div` 3) @@ -68,10 +69,15 @@ withForeignPtr efp $ \etable -> withForeignPtr sfp $ \sptr -> do let !end = plusPtr sptr (soff + slen)+#ifdef BASE64_SIMD+ consumed <- encodePrefix (plusPtr sptr soff) slen dptr aptr+#else+ let consumed = 0+#endif innerLoop etable- (castPtr (plusPtr sptr soff))- (castPtr dptr)+ (castPtr (plusPtr sptr (soff + consumed)))+ (castPtr (plusPtr dptr ((consumed `quot` 3) * 4))) end (loopTailNoPad dfp aptr dptr (castPtr end)) where@@ -97,12 +103,44 @@ dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> do let !end = plusPtr sptr (soff + slen)- decodeLoop dtable- (plusPtr sptr soff)- dptr end dfp+#ifdef BASE64_SIMD+ consumed <- decodePrefix (plusPtr sptr soff) slen dptr dtable+ decodeLoopFrom dtable (plusPtr sptr soff) dptr end dfp consumed+#else+ decodeLoop dtable (plusPtr sptr soff) dptr end dfp+#endif where !dlen = (slen `quot` 4) * 3 {-# inline decodeBase64_ #-}++-- | The main decode function for typed base64 values.+--+-- This loop is separate from 'decodeBase64_' due to the fact that+-- when taking a 'Base64' value from this library, the existence+-- of the wrapper is a witness to the well-formedness of the underlying value,+-- and so we can eschew error checking in the decode loop.+--+decodeBase64Typed_+ :: ForeignPtr Word8+ -> Base64 k ByteString+ -> ByteString+decodeBase64Typed_ !dtfp (Base64 (PS sfp soff slen))+ | slen == 0 = mempty+ | otherwise = unsafeDupablePerformIO $+ withForeignPtr dtfp $ \dtable ->+ withForeignPtr sfp $ \sptr -> do+ dfp <- mallocPlainForeignPtrBytes dlen+ withForeignPtr dfp $ \dptr -> do+ let !end = plusPtr sptr (soff + slen)+#ifdef BASE64_SIMD+ consumed <- decodePrefix (plusPtr sptr soff) slen dptr dtable+ decodeLoopNoErrorFrom dtable (plusPtr sptr soff) dptr end dfp consumed+#else+ decodeLoopNoError dtable (plusPtr sptr soff) dptr end dfp+#endif+ where+ !dlen = (slen `quot` 4) * 3+{-# inline decodeBase64Typed_ #-} decodeBase64Lenient_ :: ForeignPtr Word8 -> ByteString -> ByteString decodeBase64Lenient_ !dtfp (PS !sfp !soff !slen) = unsafeDupablePerformIO $
+ src/Data/ByteString/Base64/Internal/SIMD.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- |+-- Module : Data.ByteString.Base64.Internal.SIMD+-- Copyright : (c) 2026 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- Note: Buffers must remain alive for the duration+-- of each call, using @withForeignPtr@. The decoder leaves the+-- final quanta and stops before invalid blocks so scalar code retains all+-- padding checks and error reporting, with canonicity checks *preserved*. +--+-- Why not do something like Alfred Klomp's `fastbase64`? Because we can do better!+module Data.ByteString.Base64.Internal.SIMD+( encodePrefix+, decodePrefix+) where++import Foreign.C.Types (CSize(..))+import Foreign.Ptr (Ptr)+import Data.Word (Word8)++foreign import ccall unsafe "hs_base64_simd_encode"+ c_encodePrefix :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr Word8 -> IO CSize++foreign import ccall unsafe "hs_base64_simd_decode"+ c_decodePrefix :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr Word8 -> IO CSize++-- | Encode a prefix; return the number of input bytes consumed (multiple of 3).+-- Short inputs avoid the foreign-call and runtime-dispatch overhead.+encodePrefix :: Ptr Word8 -> Int -> Ptr Word8 -> Ptr Word8 -> IO Int+encodePrefix src len dst alphabet+ | len < 96 = pure 0+ | otherwise = fromIntegral <$> c_encodePrefix src (fromIntegral len) dst alphabet+{-# INLINE encodePrefix #-}++-- | Decode a prefix; return the number of input bytes consumed (multiple of 4).+-- The original source and destination pointers are retained by the caller.+decodePrefix :: Ptr Word8 -> Int -> Ptr Word8 -> Ptr Word8 -> IO Int+decodePrefix src len dst table+ | len < 128 = pure 0+ | otherwise = fromIntegral <$> c_decodePrefix src (fromIntegral len) dst table+{-# INLINE decodePrefix #-}
src/Data/ByteString/Base64/Internal/Tables.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.Tables--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>
src/Data/ByteString/Base64/Internal/Tail.hs view
@@ -1,9 +1,8 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} -- |--- Module : Data.ByteString.Base64.Internal.W32.Loop--- Copyright : (c) 2019-2020 Emily Pillmore+-- Module : Data.ByteString.Base64.Internal.Tail+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -39,35 +38,36 @@ -> Ptr Word8 -> Ptr Word8 -> IO ByteString-loopTail !dfp (Ptr !alpha) !dptr !end !src !dst- | src == end = return (PS dfp 0 (minusPtr dst dptr))- | plusPtr src 1 == end = do- !x <- peek @Word8 src+loopTail !dfp !dptr (Ptr !alpha) !end !sptr_ !dptr_ = go sptr_ dptr_+ where+ go src dst+ | src == end =+ pure $ PS dfp 0 (dst `minusPtr` dptr)+ | otherwise = do+ !x <- peek @Word8 src+ let !a = unsafeShiftR x 2+ !carry0 = unsafeShiftL (x .&. 0x03) 4 - let !a = unsafeShiftR (x .&. 0xfc) 2- !b = unsafeShiftL (x .&. 0x03) 4+ -- poke first 6 bits+ poke @Word8 dst $ aix a alpha - poke @Word8 dst (aix a alpha)- poke @Word8 (plusPtr dst 1) (aix b alpha)- poke @Word8 (plusPtr dst 2) 0x3d- poke @Word8 (plusPtr dst 3) 0x3d- return (PS dfp 0 (4 + minusPtr dst dptr))+ if src `plusPtr` 1 == end then do+ -- if no other bytes, poke carry bits+ poke @Word8 (dst `plusPtr` 1) $ aix carry0 alpha+ poke @Word8 (dst `plusPtr` 2) 0x3d+ poke @Word8 (dst `plusPtr` 3) 0x3d - | otherwise = do- !x <- peek @Word8 src- !y <- peek @Word8 (plusPtr src 1)+ else do+ !y <- peek @Word8 $ src `plusPtr` 1 - let !a = unsafeShiftR (x .&. 0xfc) 2- !b = unsafeShiftL (x .&. 0x03) 4+ let !b = carry0 .|. unsafeShiftR (y .&. 0xf0) 4+ !carry1 = unsafeShiftL (y .&. 0x0f) 2 - let !c = unsafeShiftR (y .&. 0xf0) 4 .|. b- !d = unsafeShiftL (y .&. 0x0f) 2+ poke @Word8 (dst `plusPtr` 1) $ aix b alpha+ poke @Word8 (dst `plusPtr` 2) $ aix carry1 alpha+ poke @Word8 (dst `plusPtr` 3) 0x3d - poke @Word8 dst (aix a alpha)- poke @Word8 (plusPtr dst 1) (aix c alpha)- poke @Word8 (plusPtr dst 2) (aix d alpha)- poke @Word8 (plusPtr dst 3) 0x3d- return (PS dfp 0 (4 + minusPtr dst dptr))+ pure $ PS dfp 0 (4 + minusPtr dst dptr) {-# inline loopTail #-} -- | Finalize a bytestring by filling out the remaining bits@@ -91,7 +91,7 @@ poke @Word8 dst (aix a alpha) poke @Word8 (plusPtr dst 1) (aix b alpha)- return (PS dfp 0 (2 + (minusPtr dst dptr)))+ return (PS dfp 0 (2 + minusPtr dst dptr)) | otherwise = do !x <- peek @Word8 src !y <- peek @Word8 (plusPtr src 1)@@ -105,5 +105,5 @@ poke @Word8 dst (aix a alpha) poke @Word8 (plusPtr dst 1) (aix c alpha) poke @Word8 (plusPtr dst 2) (aix d alpha)- return (PS dfp 0 (3 + (minusPtr dst dptr)))+ return (PS dfp 0 (3 + minusPtr dst dptr)) {-# inline loopTailNoPad #-}
src/Data/ByteString/Base64/Internal/Utils.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE MagicHash #-} -- | -- Module : Data.ByteString.Base64.Internal--- Copyright : (c) 2019-2022 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>
src/Data/ByteString/Base64/Internal/W16/Loop.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.W16.Loop--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -15,10 +15,12 @@ module Data.ByteString.Base64.Internal.W16.Loop ( innerLoop , decodeLoop+, decodeLoopFrom+, decodeLoopNoError+, decodeLoopNoErrorFrom , lenientLoop ) where - import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base64.Internal.Utils@@ -53,7 +55,7 @@ !j <- w32 <$> peek (plusPtr src 1) !k <- w32 <$> peek (plusPtr src 2) - let !w = (unsafeShiftL i 16) .|. (unsafeShiftL j 8) .|. k+ let !w = unsafeShiftL i 16 .|. unsafeShiftL j 8 .|. k !x <- peekElemOff etable (fromIntegral (unsafeShiftR w 12)) !y <- peekElemOff etable (fromIntegral (w .&. 0xfff))@@ -74,16 +76,32 @@ -> Ptr Word8 -> ForeignPtr Word8 -> IO (Either Text ByteString)-decodeLoop !dtable !sptr !dptr !end !dfp = go dptr sptr+decodeLoop dtable sptr dptr end dfp =+ decodeLoopFrom dtable sptr dptr end dfp 0+{-# INLINE decodeLoop #-}++-- | Resume after a validated prefix while retaining the original pointers+-- for error offsets and the total output length. The consumed input length+-- must be a multiple of four and leave at least the final quartet.+decodeLoopFrom+ :: Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> ForeignPtr Word8+ -> Int+ -> IO (Either Text ByteString)+decodeLoopFrom !dtable !sptr !dptr !end !dfp !consumed =+ go (plusPtr dptr ((consumed `quot` 4) * 3)) (plusPtr sptr consumed) where err :: Ptr Word8 -> IO (Either Text ByteString) err p = return . Left . T.pack- $ "invalid character at offset: "+ $ "invalid base64 encoding near offset: " ++ show (p `minusPtr` sptr) padErr :: Ptr Word8 -> IO (Either Text ByteString) padErr p = return . Left . T.pack- $ "invalid padding at offset: "+ $ "invalid padding near offset: " ++ show (p `minusPtr` sptr) canonErr :: Ptr Word8 -> IO (Either Text ByteString)@@ -127,9 +145,9 @@ | d == 0xff = err (plusPtr src 3) | otherwise = do - let !w = ((unsafeShiftL a 18)- .|. (unsafeShiftL b 12)- .|. (unsafeShiftL c 6)+ let !w = (unsafeShiftL a 18+ .|. unsafeShiftL b 12+ .|. unsafeShiftL c 6 .|. d) :: Word32 poke @Word8 dst (fromIntegral (unsafeShiftR w 16))@@ -150,9 +168,9 @@ | c == 0xff = err (plusPtr src 2) | d == 0xff = err (plusPtr src 3) | otherwise = do- let !w = ((unsafeShiftL a 18)- .|. (unsafeShiftL b 12)- .|. (unsafeShiftL c 6)+ let !w = (unsafeShiftL a 18+ .|. unsafeShiftL b 12+ .|. unsafeShiftL c 6 .|. d) :: Word32 poke @Word8 dst (fromIntegral (unsafeShiftR w 16))@@ -172,8 +190,82 @@ poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8)) poke @Word8 (plusPtr dst 2) (fromIntegral w) return $ Right $ PS dfp 0 (3 + (dst `minusPtr` dptr))-{-# inline decodeLoop #-}+{-# INLINE decodeLoopFrom #-} +decodeLoopNoError+ :: Ptr Word8+ -- ^ decode lookup table+ -> Ptr Word8+ -- ^ src pointer+ -> Ptr Word8+ -- ^ dst pointer+ -> Ptr Word8+ -> ForeignPtr Word8+ -> IO ByteString+decodeLoopNoError dtable sptr dptr end dfp =+ decodeLoopNoErrorFrom dtable sptr dptr end dfp 0+{-# INLINE decodeLoopNoError #-}++-- | Typed counterpart of 'decodeLoopFrom', with the same prefix contract.+decodeLoopNoErrorFrom+ :: Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> ForeignPtr Word8+ -> Int+ -> IO ByteString+decodeLoopNoErrorFrom !dtable !sptr !dptr !end !dfp !consumed =+ go (plusPtr dptr ((consumed `quot` 4) * 3)) (plusPtr sptr consumed)+ where+ look :: Ptr Word8 -> IO Word32+ look !p = do+ !i <- peek p+ !v <- peekByteOff @Word8 dtable (fromIntegral i)+ pure $ fromIntegral v++ go !dst !src+ | plusPtr src 4 >= end = do+ a <- look src+ b <- look (src `plusPtr` 1)+ c <- look (src `plusPtr` 2)+ d <- look (src `plusPtr` 3)++ let !w = (unsafeShiftL a 18+ .|. unsafeShiftL b 12+ .|. unsafeShiftL c 6+ .|. d) :: Word32++ poke @Word8 dst (fromIntegral (unsafeShiftR w 16))++ if c == 0x63 && d == 0x63 then+ pure $ PS dfp 0 (1 + (dst `minusPtr` dptr))+ else if d == 0x63 then do+ poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8))+ pure $ PS dfp 0 (2 + (dst `minusPtr` dptr))+ else do+ poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8))+ poke @Word8 (plusPtr dst 2) (fromIntegral w)+ pure $ PS dfp 0 (3 + (dst `minusPtr` dptr))++ | otherwise = do+ a <- look src+ b <- look (src `plusPtr` 1)+ c <- look (src `plusPtr` 2)+ d <- look (src `plusPtr` 3)++ let !w = (unsafeShiftL a 18+ .|. unsafeShiftL b 12+ .|. unsafeShiftL c 6+ .|. d) :: Word32++ poke @Word8 dst (fromIntegral (unsafeShiftR w 16))+ poke @Word8 (plusPtr dst 1) (fromIntegral (unsafeShiftR w 8))+ poke @Word8 (plusPtr dst 2) (fromIntegral w)+ go (plusPtr dst 3) (plusPtr src 4)+{-# INLINE decodeLoopNoErrorFrom #-}++ lenientLoop :: Ptr Word8 -- ^ decode lookup table@@ -215,7 +307,7 @@ | otherwise -> look False bp $ \cp c -> look False cp $ \dp d -> do- let !w = (unsafeShiftL a 18) .|. (unsafeShiftL b 12) .|. (unsafeShiftL c 6) .|. d+ let !w = unsafeShiftL a 18 .|. unsafeShiftL b 12 .|. unsafeShiftL c 6 .|. d poke @Word8 dst (fromIntegral (unsafeShiftR w 16)) if c == 0x63
− src/Data/ByteString/Base64/Internal/W32/Loop.hs
@@ -1,92 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE TypeApplications #-}--- |--- Module : Data.ByteString.Base64.Internal.W32.Loop--- Copyright : (c) 2019-2020 Emily Pillmore--- License : BSD-style------ Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable------ 'Word32'-optimized inner loop----module Data.ByteString.Base64.Internal.W32.Loop-( innerLoop-, decodeLoop-, lenientLoop-) where---import Data.Bits-import Data.ByteString.Internal-import Data.ByteString.Base64.Internal.Utils-import qualified Data.ByteString.Base64.Internal.W16.Loop as W16-import Data.Text (Text)--import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable--import GHC.Word----- | Encoding inner loop. Packs 3 bytes from src pointer into--- the first 6 bytes of 4 'Word8''s (using the encoding table,--- as 2 'Word12''s ), writing these to the dst pointer.----innerLoop- :: Ptr Word16- -> Ptr Word32- -> Ptr Word32- -> Ptr Word32- -> (Ptr Word8 -> Ptr Word8 -> IO ByteString)- -> IO ByteString-innerLoop !etable !sptr !dptr !end finish = go sptr dptr- where- go !src !dst- | plusPtr src 3 >= end =- W16.innerLoop etable (castPtr src) (castPtr dst) (castPtr end) finish- | otherwise = do- !w <- peekWord32BE src-- let !a = unsafeShiftR w 20- !b = unsafeShiftR w 8-- !x <- w32_16 <$> peekElemOff etable (fromIntegral a)- !y <- w32_16 <$> peekElemOff etable (fromIntegral b)-- let !z = x .|. (unsafeShiftL y 16)- poke dst (fromIntegral z)-- go (plusPtr src 3) (plusPtr dst 4)- {-# INLINE go #-}-{-# INLINE innerLoop #-}--decodeLoop- :: Ptr Word8- -> Ptr Word8- -- ^ src pointer- -> Ptr Word8- -- ^ dst pointer- -> Ptr Word8- -- ^ end of src ptr- -> ForeignPtr Word8- -> IO (Either Text ByteString)-decodeLoop = W16.decodeLoop-{-# INLINE decodeLoop #-}--lenientLoop- :: Ptr Word8- -- ^ decode lookup table- -> Ptr Word8- -- ^ src pointer- -> Ptr Word8- -- ^ dst pointer- -> Ptr Word8- -- ^ end of src ptr- -> ForeignPtr Word8- -- ^ dst foreign ptr (for consing bs)- -> IO ByteString-lenientLoop = W16.lenientLoop
src/Data/ByteString/Base64/Internal/W64/Loop.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE TypeApplications #-} -- | -- Module : Data.ByteString.Base64.Internal.W64.Loop--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -15,6 +13,9 @@ module Data.ByteString.Base64.Internal.W64.Loop ( innerLoop , decodeLoop+, decodeLoopFrom+, decodeLoopNoError+, decodeLoopNoErrorFrom , lenientLoop ) where @@ -51,10 +52,10 @@ | otherwise = do !t <- peekWord64BE src - let !a = (unsafeShiftR t 52) .&. 0xfff- !b = (unsafeShiftR t 40) .&. 0xfff- !c = (unsafeShiftR t 28) .&. 0xfff- !d = (unsafeShiftR t 16) .&. 0xfff+ let !a = unsafeShiftR t 52 .&. 0xfff+ !b = unsafeShiftR t 40 .&. 0xfff+ !c = unsafeShiftR t 28 .&. 0xfff+ !d = unsafeShiftR t 16 .&. 0xfff !w <- w64_16 <$> peekElemOff etable (fromIntegral a) !x <- w64_16 <$> peekElemOff etable (fromIntegral b)@@ -62,9 +63,9 @@ !z <- w64_16 <$> peekElemOff etable (fromIntegral d) let !xx = w- .|. (unsafeShiftL x 16)- .|. (unsafeShiftL y 32)- .|. (unsafeShiftL z 48)+ .|. unsafeShiftL x 16+ .|. unsafeShiftL y 32+ .|. unsafeShiftL z 48 poke dst (fromIntegral xx) @@ -85,6 +86,43 @@ -> IO (Either Text ByteString) decodeLoop = W16.decodeLoop {-# inline decodeLoop #-}++decodeLoopFrom+ :: Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> ForeignPtr Word8+ -> Int+ -> IO (Either Text ByteString)+decodeLoopFrom = W16.decodeLoopFrom+{-# INLINE decodeLoopFrom #-}++decodeLoopNoError+ :: Ptr Word8+ -- ^ decode lookup table+ -> Ptr Word8+ -- ^ src pointer+ -> Ptr Word8+ -- ^ dst pointer+ -> Ptr Word8+ -- ^ end of src ptr+ -> ForeignPtr Word8+ -- ^ dst foreign ptr (for consing bs)+ -> IO ByteString+decodeLoopNoError = W16.decodeLoopNoError+{-# inline decodeLoopNoError #-}++decodeLoopNoErrorFrom+ :: Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> Ptr Word8+ -> ForeignPtr Word8+ -> Int+ -> IO ByteString+decodeLoopNoErrorFrom = W16.decodeLoopNoErrorFrom+{-# INLINE decodeLoopNoErrorFrom #-} lenientLoop :: Ptr Word8
src/Data/ByteString/Base64/URL.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.ByteString.Base64.URL--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -11,7 +12,7 @@ -- Portability : non-portable -- -- This module contains 'Data.ByteString.ByteString'-valued combinators for--- implementing the RFC 4648 specification of the Base64url+-- implementing the RFC 4648 specification of the url-safe Base64 (Base64url) -- encoding format. This includes strictly padded/unpadded and lenient decoding -- variants, as well as internal and external validation for canonicity. --@@ -23,27 +24,40 @@ , encodeBase64Unpadded' -- * Decoding , decodeBase64+, decodeBase64Untyped , decodeBase64Unpadded+, decodeBase64UnpaddedUntyped , decodeBase64Padded+, decodeBase64PaddedUntyped , decodeBase64Lenient- -- * Validation-, isBase64Url-, isValidBase64Url+ -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where +import Data.Base64.Types+import Data.Base64.Types.Internal+ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base64.Internal import Data.ByteString.Base64.Internal.Head import Data.ByteString.Base64.Internal.Tables-import Data.Either (isRight) import Data.Text (Text) import qualified Data.Text.Encoding as T import System.IO.Unsafe +-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'ByteString' value as a Base64url 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -53,8 +67,8 @@ -- >>> encodeBase64 "<<?>>" -- "PDw_Pj4=" ---encodeBase64 :: ByteString -> Text-encodeBase64 = T.decodeUtf8 . encodeBase64'+encodeBase64 :: ByteString -> Base64 'UrlPadded Text+encodeBase64 = fmap T.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ByteString' as a Base64url 'ByteString' value with padding.@@ -66,41 +80,69 @@ -- >>> encodeBase64' "<<?>>" -- "PDw_Pj4=" ---encodeBase64' :: ByteString -> ByteString-encodeBase64' = encodeBase64_ base64UrlTable+encodeBase64' :: ByteString -> Base64 'UrlPadded ByteString+encodeBase64' = assertBase64 . encodeBase64_ base64UrlTable --- | Decode a padded Base64url encoded 'ByteString' value. If its length is not a multiple+-- | Decode a Base64url encoded 'ByteString' value, either padded or unpadded.+-- The correct decoding function is dispatched based on the existence of padding.+--+-- For typed values:+-- - If a padded value is required, use 'decodeBase64Padded'+-- - If an unpadded value is required, use 'decodeBase64Unpadded'+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64+ :: UrlAlphabet k+ => Base64 k ByteString+ -> ByteString+decodeBase64 b64@(Base64 bs)+ | not $ BS.null bs, BS.last bs == 0x3d = decodeBase64Padded $ coerceBase64 b64+ | otherwise = decodeBase64Unpadded $ coerceBase64 b64+{-# inline decodeBase64 #-}++-- | Decode an untyped Base64url encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as Base64url-encoded values are optionally padded. ----- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'.+-- For a decoder that fails to decode untyped values of incorrect size:+-- - If a padded value is required, use 'decodeBase64PaddedUntyped'+-- - If an unpadded value is required, use 'decodeBase64UnpaddedUntyped' -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "PDw_Pj4="+-- >>> decodeBase64Untyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64 "PDw_Pj4"+-- >>> decodeBase64Untyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64 "PDw-Pg="+-- >>> decodeBase64Untyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ----- >>> decodeBase64 "PDw-Pg"+-- >>> decodeBase64Untyped "PDw-Pg" -- Right "<<>>" ---decodeBase64 :: ByteString -> Either Text ByteString-decodeBase64 bs@(PS _ _ !l)- | l == 0 = Right bs- | r == 0 = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable bs- | r == 2 = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable (BS.append bs "==")- | r == 3 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable (BS.append bs "=")- | otherwise = Left "Base64-encoded bytestring has invalid size"+decodeBase64Untyped :: ByteString -> Either Text ByteString+decodeBase64Untyped bs@(PS _ _ !l)+ | l == 0 = Right mempty+ | r == 0 = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable bs+ | r == 2 = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable $ BS.append bs "=="+ | r == 3 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable $ BS.append bs "="+ | otherwise = Left "Base64-encoded bytestring has invalid size" where !r = l `rem` 4-{-# INLINE decodeBase64 #-}+{-# INLINE decodeBase64Untyped #-} -- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding@@ -113,8 +155,8 @@ -- >>> encodeBase64Unpadded "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded :: ByteString -> Text-encodeBase64Unpadded = T.decodeUtf8 . encodeBase64Unpadded'+encodeBase64Unpadded :: ByteString -> Base64 'UrlUnpadded Text+encodeBase64Unpadded = fmap T.decodeUtf8 . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} -- | Encode a 'ByteString' value as Base64url without padding. Note that for Base64url,@@ -128,65 +170,96 @@ -- >>> encodeBase64Unpadded' "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded' :: ByteString -> ByteString-encodeBase64Unpadded' = encodeBase64Nopad_ base64UrlTable+encodeBase64Unpadded' :: ByteString -> Base64 'UrlUnpadded ByteString+encodeBase64Unpadded' = assertBase64 . encodeBase64Nopad_ base64UrlTable -- | Decode an unpadded Base64url-encoded 'ByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. ----- In general, unless unpadded Base64url is explicitly required, it is--- safer to call 'decodeBase64'.--- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Unpadded "PDw_Pj4"--- Right "<<?>>"------ >>> decodeBase64Unpadded "PDw_Pj4="--- Left "Base64-encoded bytestring has invalid padding"+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>" ---decodeBase64Unpadded :: ByteString -> Either Text ByteString-decodeBase64Unpadded bs@(PS _ _ !l)- | l == 0 = Right bs- | r == 0 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable bs- | r == 2 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable (BS.append bs "==")- | r == 3 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable (BS.append bs "=")- | otherwise = Left "Base64-encoded bytestring has invalid size"+decodeBase64Unpadded :: Base64 'UrlUnpadded ByteString -> ByteString+decodeBase64Unpadded b64@(Base64 (PS _ _ !l))+ | r == 2 = decodeBase64Padded $ coerceBase64 $ (`BS.append` "==") <$> b64+ | r == 3 = decodeBase64Padded $ coerceBase64 $ (`BS.append` "=") <$> b64+ | otherwise = decodeBase64Padded $ coerceBase64 b64 where !r = l `rem` 4-{-# INLINE decodeBase64Unpadded #-} --- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are+-- | Decode a padded, untyped Base64url-encoded 'ByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base64url is explicitly required, it is--- safer to call 'decodeBase64'.+-- safer to call 'decodeBase64Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Padded "PDw_Pj4="+-- >>> decodeBase64PaddedUntyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64Padded "PDw_Pj4"--- Left "Base64-encoded bytestring requires padding"----decodeBase64Padded :: ByteString -> Either Text ByteString-decodeBase64Padded bs@(PS _ _ !l)- | l == 0 = Right bs+decodeBase64PaddedUntyped :: ByteString -> Either Text ByteString+decodeBase64PaddedUntyped bs@(PS _ _ !l)+ | l == 0 = Right mempty | r == 1 = Left "Base64-encoded bytestring has invalid size" | r /= 0 = Left "Base64-encoded bytestring requires padding" | otherwise = unsafeDupablePerformIO $ decodeBase64_ decodeB64UrlTable bs where !r = l `rem` 4+{-# INLINE decodeBase64PaddedUntyped #-}++-- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are+-- required to be correctly padded, and will be validated prior to decoding+-- to confirm.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Padded $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+decodeBase64Padded :: Base64 'UrlPadded ByteString -> ByteString+decodeBase64Padded = decodeBase64Typed_ decodeB64UrlTable {-# INLINE decodeBase64Padded #-} --- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function+-- | Decode an unpadded, untyped Base64url-encoded 'ByteString' value. Input strings are+-- required to be unpadded, and will undergo validation prior to decoding to+-- confirm.+--+-- In general, unless unpadded Base64url is explicitly required, it is+-- safer to call 'decodeBase64Untyped'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4"+-- Right "<<?>>"+--+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding"+--+decodeBase64UnpaddedUntyped :: ByteString -> Either Text ByteString+decodeBase64UnpaddedUntyped bs@(PS _ _ !l)+ | l == 0 = Right mempty+ | r == 0 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable bs+ | r == 2 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable $ BS.append bs "=="+ | r == 3 = validateLastPad bs $ decodeBase64_ decodeB64UrlTable $ BS.append bs "="+ | otherwise = Left "Base64-encoded bytestring has invalid size"+ where+ !r = l `rem` 4+{-# INLINE decodeBase64UnpaddedUntyped #-}++-- | Leniently decode an unpadded, untyped Base64url-encoded 'ByteString'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -204,44 +277,58 @@ decodeBase64Lenient = decodeBase64Lenient_ decodeB64UrlTable {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ByteString' is encoded in padded /or/ unpadded Base64url format.+-- | Parse a canonical, padded Base64url-encoded 'ByteString' value. ----- This function will also detect non-canonical encodings such as @ZE==@, which are--- externally valid Base64url-encoded values, but are internally inconsistent "impossible"--- values.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ByteString -> Bool-isBase64Url bs = isValidBase64Url bs && isRight (decodeBase64 bs)-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ByteString -> Either Text (Base64 'UrlPadded ByteString)+parseBase64Padded bs = assertBase64 bs <$ decodeBase64PaddedUntyped bs+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'ByteString' is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ByteString' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ByteString' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ByteString -> Bool-isValidBase64Url = validateBase64Url "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ByteString -> Either Text (Base64 'UrlUnpadded ByteString)+parseBase64Unpadded bs = assertBase64 bs <$ decodeBase64UnpaddedUntyped bs+{-# INLINE parseBase64Unpadded #-}
src/Data/ByteString/Lazy/Base64.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.ByteString.Lazy.Base64--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -20,25 +20,32 @@ , encodeBase64' -- * Decoding , decodeBase64+, decodeBase64Untyped , decodeBase64Lenient- -- * Validation-, isBase64-, isValidBase64+ -- * Parsing+, parseBase64 ) where -import Prelude hiding (all, elem)-+import Data.Base64.Types import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Base64.Internal.Utils (reChunkN)-import Data.ByteString.Lazy (elem, fromChunks, toChunks)+import Data.ByteString.Lazy (fromChunks, toChunks)+import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Internal (ByteString(..))-import Data.Either (isRight) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'ByteString' value as Base64 'Text' with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>@@ -48,8 +55,8 @@ -- >>> encodeBase64 "Sun" -- "U3Vu" ---encodeBase64 :: ByteString -> TL.Text-encodeBase64 = TL.decodeUtf8 . encodeBase64'+encodeBase64 :: ByteString -> Base64 'StdPadded TL.Text+encodeBase64 = fmap TL.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ByteString' value as a Base64 'ByteString' value with padding.@@ -61,9 +68,10 @@ -- >>> encodeBase64' "Sun" -- "U3Vu" ---encodeBase64' :: ByteString -> ByteString-encodeBase64' = fromChunks- . fmap B64.encodeBase64'+encodeBase64' :: ByteString -> Base64 'StdPadded ByteString+encodeBase64' = assertBase64+ . fromChunks+ . fmap (extractBase64 . B64.encodeBase64') . reChunkN 3 . toChunks {-# INLINE encodeBase64' #-}@@ -74,21 +82,37 @@ -- -- === __Examples__: ----- >>> decodeBase64 "U3Vu"+-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"+-- "Sun"+--+decodeBase64 :: StdAlphabet k => Base64 k ByteString -> ByteString+decodeBase64 = fromChunks+ . pure+ . B64.decodeBase64+ . fmap (BS.concat . toChunks)+{-# INLINE decodeBase64 #-}++-- | Decode a padded untyped Base64-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Untyped "U3Vu" -- Right "Sun" ----- >>> decodeBase64 "U3V"+-- >>> decodeBase64Untyped "U3V" -- Left "Base64-encoded bytestring requires padding" ----- >>> decodebase64 "U3V="+-- >>> decodeBase64Untyped "U3V=" -- Left "non-canonical encoding detected at offset: 2" ---decodeBase64 :: ByteString -> Either T.Text ByteString-decodeBase64 = fmap (fromChunks . (:[]))- . B64.decodeBase64+decodeBase64Untyped :: ByteString -> Either T.Text ByteString+decodeBase64Untyped = fmap (fromChunks . pure)+ . B64.decodeBase64Untyped . BS.concat . toChunks-{-# INLINE decodeBase64 #-}+{-# inline decodeBase64Untyped #-} -- | Leniently decode an unpadded Base64-encoded 'ByteString' value. This function -- will not generate parse errors. If input data contains padding chars,@@ -104,64 +128,43 @@ -- >>> decodeBase64Lenient "U3V" -- "Su" ----- >>> decodebase64Lenient "U3V="+-- >>> decodeBase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ByteString -> ByteString decodeBase64Lenient = fromChunks . fmap B64.decodeBase64Lenient . reChunkN 4- . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="))+ . fmap (BS.filter (`BL.elem` "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=")) . toChunks {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ByteString' value is base64 encoded.------ This function will also detect non-canonical encodings such as @ZE==@, which are--- externally valid Base64url-encoded values, but are internally inconsistent "impossible"--- values.------ === __Examples__:------ >>> isBase64 "U3Vu"--- True------ >>> isBase64 "U3V"--- False------ >>> isBase64 "U3V="--- False+-- | Parse a canonical, padded Base64-encoded 'ByteString' value. ---isBase64 :: ByteString -> Bool-isBase64 bs = isValidBase64 bs && isRight (decodeBase64 bs)-{-# INLINE isBase64 #-}---- | Tell whether a 'ByteString' value is a valid Base64 format.+-- Checks the alphabet, length, padding, and unused padding bits. On success,+-- returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.+-- The input is neither decoded nor normalized in the returned value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ByteString' value, use 'isBase64'.+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result. -- -- === __Examples__: ----- >>> isValidBase64 "U3Vu"--- True+-- >>> parseBase64 "U3Vu"+-- Right "U3Vu" ----- >>> isValidBase64 "U3V"--- True+-- >>> fmap decodeBase64 (parseBase64 "U3Vu")+-- Right "Sun" ----- >>> isValidBase64 "U3V="--- True+-- >>> parseBase64 "U3V"+-- Left "Base64-encoded bytestring requires padding" ----- >>> isValidBase64 "%"--- False+-- >>> parseBase64 "U3V="+-- Left "non-canonical encoding detected at offset: 2" ---isValidBase64 :: ByteString -> Bool-isValidBase64 = go . toChunks- where- go [] = True- go [c] = B64.isValidBase64 c- go (c:cs) = -- note the lack of padding char- BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") c- && go cs-{-# INLINE isValidBase64 #-}+-- @since 2.0+--+parseBase64 :: ByteString -> Either T.Text (Base64 'StdPadded ByteString)+parseBase64 bs = assertBase64 bs <$ B64.parseBase64 (BS.concat $ toChunks bs)+{-# INLINE parseBase64 #-}
src/Data/ByteString/Lazy/Base64/URL.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.ByteString.Lazy.Base64.URL--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -23,28 +23,38 @@ , encodeBase64Unpadded' -- * Decoding , decodeBase64+, decodeBase64Untyped , decodeBase64Unpadded+, decodeBase64UnpaddedUntyped , decodeBase64Padded+, decodeBase64PaddedUntyped , decodeBase64Lenient- -- * Validation-, isBase64Url-, isValidBase64Url+ -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where -import Prelude hiding (all, elem)-+import Data.Base64.Types import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Base64.Internal.Utils (reChunkN)-import Data.ByteString.Lazy (elem, fromChunks, toChunks)+import Data.ByteString.Lazy (fromChunks, toChunks)+import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Internal (ByteString(..))-import Data.Either (isRight) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'ByteString' value as a Base64url 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -54,8 +64,8 @@ -- >>> encodeBase64 "<<?>>" -- "PDw_Pj4=" ---encodeBase64 :: ByteString -> TL.Text-encodeBase64 = TL.decodeUtf8 . encodeBase64'+encodeBase64 :: ByteString -> Base64 'UrlPadded TL.Text+encodeBase64 = fmap TL.decodeUtf8 . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ByteString' as a Base64url 'ByteString' value with padding.@@ -67,44 +77,74 @@ -- >>> encodeBase64' "<<?>>" -- "PDw_Pj4=" ---encodeBase64' :: ByteString -> ByteString-encodeBase64' = fromChunks- . fmap B64U.encodeBase64'+encodeBase64' :: ByteString -> Base64 'UrlPadded ByteString+encodeBase64' = assertBase64 . fromChunks+ . fmap (extractBase64 . B64U.encodeBase64') . reChunkN 3 . toChunks +-- | Decode a Base64url encoded 'ByteString' value, either padded or unpadded.+-- The correct decoding function is dispatched based on the existence of padding.+--+-- For typed values:+-- - If a padded value is required, use 'decodeBase64Padded'+-- - If an unpadded value is required, use 'decodeBase64Unpadded'+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw-Pg"+-- "<<>>"+--+decodeBase64+ :: UrlAlphabet k+ => Base64 k ByteString+ -> ByteString+decodeBase64 = fromChunks+ . pure+ . B64U.decodeBase64+ . fmap (BS.concat . toChunks)+{-# INLINE decodeBase64 #-}+ -- | Decode a padded Base64url encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as Base64url-encoded values are optionally padded. ----- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'.+-- For a decoder that fails to decode untyped values of incorrect size:+-- - If a padded value is required, use 'decodeBase64PaddedUntyped'+-- - If an unpadded value is required, use 'decodeBase64UnpaddedUntyped' -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "PDw_Pj4="+-- >>> decodeBase64Untyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64 "PDw_Pj4"+-- >>> decodeBase64Untyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64 "PDw-Pg="+-- >>> decodeBase64Untyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ----- >>> decodeBase64 "PDw-Pg"+-- >>> decodeBase64Untyped "PDw-Pg" -- Right "<<>>" ---decodeBase64 :: ByteString -> Either T.Text ByteString-decodeBase64 = fmap (fromChunks . (:[]))- . B64U.decodeBase64+decodeBase64Untyped :: ByteString -> Either T.Text ByteString+decodeBase64Untyped = fmap (fromChunks . pure)+ . B64U.decodeBase64Untyped . BS.concat . toChunks-{-# INLINE decodeBase64 #-}+{-# INLINE decodeBase64Untyped #-} --- | Encode a 'ByteString' value as Base64url 'Text' without padding. Note that for Base64url,--- padding is optional. If you call this function, you will simply be encoding--- as Base64url and stripping padding chars from the output.+-- | Encode a 'ByteString' value as Base64url 'Text' without padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -113,13 +153,11 @@ -- >>> encodeBase64Unpadded "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded :: ByteString -> TL.Text-encodeBase64Unpadded = TL.decodeUtf8 . encodeBase64Unpadded'+encodeBase64Unpadded :: ByteString -> Base64 'UrlUnpadded TL.Text+encodeBase64Unpadded = fmap TL.decodeUtf8 . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} --- | Encode a 'ByteString' value as Base64url without padding. Note that for Base64url,--- padding is optional. If you call this function, you will simply be encoding--- as Base64url and stripping padding chars from the output.+-- | Encode a 'ByteString' value as Base64url without padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -128,37 +166,69 @@ -- >>> encodeBase64Unpadded' "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded' :: ByteString -> ByteString-encodeBase64Unpadded' = fromChunks- . fmap B64U.encodeBase64Unpadded'+encodeBase64Unpadded' :: ByteString -> Base64 'UrlUnpadded ByteString+encodeBase64Unpadded' = assertBase64+ . fromChunks+ . fmap (extractBase64 . B64U.encodeBase64Unpadded') . reChunkN 3 . toChunks --- | Decode an unpadded Base64url-encoded 'ByteString' value. Input strings are+-- | Decode an unpadded Base64url-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64Unpadded :: Base64 'UrlUnpadded ByteString -> ByteString+decodeBase64Unpadded = fromChunks+ . pure+ . B64U.decodeBase64Unpadded+ . fmap (BS.concat . toChunks)++-- | Decode an unpadded, untyped Base64url-encoded 'ByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. -- -- In general, unless unpadded Base64url is explicitly required, it is--- safer to call 'decodeBase64'.+-- safer to call 'decodeBase64Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Unpadded "PDw_Pj4"+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64Unpadded "PDw_Pj4="+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" ---decodeBase64Unpadded :: ByteString -> Either T.Text ByteString-decodeBase64Unpadded = fmap (fromChunks . (:[]))- . B64U.decodeBase64Unpadded+decodeBase64UnpaddedUntyped :: ByteString -> Either T.Text ByteString+decodeBase64UnpaddedUntyped = fmap (fromChunks . (:[]))+ . B64U.decodeBase64UnpaddedUntyped . BS.concat . toChunks-{-# INLINE decodeBase64Unpadded #-}+{-# INLINE decodeBase64UnpaddedUntyped #-} --- | Decode a padded Base64url-encoded 'ByteString' value. Input strings are+-- | Decode a padded Base64url-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64Padded :: Base64 'UrlPadded ByteString -> ByteString+decodeBase64Padded = fromChunks+ . pure+ . B64U.decodeBase64Padded+ . fmap (BS.concat . toChunks)+{-# inline decodeBase64Padded #-}++-- | Decode a padded, untyped Base64url-encoded 'ByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. --@@ -169,20 +239,20 @@ -- -- === __Examples__: ----- >>> decodeBase64Padded "PDw_Pj4="+-- >>> decodeBase64PaddedUntyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64Padded "PDw_Pj4"+-- >>> decodeBase64PaddedUntyped "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" ---decodeBase64Padded :: ByteString -> Either T.Text ByteString-decodeBase64Padded = fmap (fromChunks . (:[]))- . B64U.decodeBase64Padded+decodeBase64PaddedUntyped :: ByteString -> Either T.Text ByteString+decodeBase64PaddedUntyped = fmap (fromChunks . (:[]))+ . B64U.decodeBase64PaddedUntyped . BS.concat . toChunks-{-# INLINE decodeBase64Padded #-}+{-# INLINE decodeBase64PaddedUntyped #-} --- | Leniently decode an unpadded Base64url-encoded 'ByteString'. This function+-- | Leniently decode an unpadded, untyped Base64url-encoded 'ByteString'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -200,50 +270,68 @@ decodeBase64Lenient = fromChunks . fmap B64U.decodeBase64Lenient . reChunkN 4- . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_="))+ . fmap (BS.filter (`BL.elem` "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_=")) . toChunks {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ByteString' is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'ByteString' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ByteString -> Bool-isBase64Url bs = isValidBase64Url bs && isRight (decodeBase64 bs)-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ByteString -> Either T.Text (Base64 'UrlPadded ByteString)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (BS.concat $ toChunks bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'ByteString' is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ByteString' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ByteString' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ByteString -> Bool-isValidBase64Url = go . toChunks- where- go [] = True- go [c] = B64U.isValidBase64Url c- go (c:cs) = -- note the lack of padding char- BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") c- && go cs-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ByteString -> Either T.Text (Base64 'UrlUnpadded ByteString)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (BS.concat $ toChunks bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/ByteString/Short/Base64.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.ByteString.Short.Base64--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,19 +19,28 @@ , encodeBase64' -- * Decoding , decodeBase64+, decodeBase64Untyped , decodeBase64Lenient- -- * Validation-, isBase64-, isValidBase64+ -- * Parsing+, parseBase64 ) where -+import Data.Base64.Types import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Short (ShortByteString, fromShort, toShort) import Data.Text (Text) import Data.Text.Short (ShortText) import Data.Text.Short.Unsafe (fromShortByteStringUnsafe) +-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--++ -- | Encode a 'ShortByteString' value as Base64 'ShortText' with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>@@ -41,8 +50,8 @@ -- >>> encodeBase64 "Sun" -- "U3Vu" ---encodeBase64 :: ShortByteString -> ShortText-encodeBase64 = fromShortByteStringUnsafe . encodeBase64'+encodeBase64 :: ShortByteString -> Base64 'StdPadded ShortText+encodeBase64 = fmap fromShortByteStringUnsafe . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ShortByteString' value as a Base64 'ShortByteString' value with padding.@@ -54,8 +63,8 @@ -- >>> encodeBase64' "Sun" -- "U3Vu" ---encodeBase64' :: ShortByteString -> ShortByteString-encodeBase64' = toShort . B64.encodeBase64' . fromShort+encodeBase64' :: ShortByteString -> Base64 'StdPadded ShortByteString+encodeBase64' = fmap toShort . B64.encodeBase64' . fromShort {-# INLINE encodeBase64' #-} -- | Decode a padded Base64-encoded 'ShortByteString' value.@@ -64,18 +73,34 @@ -- -- === __Examples__: ----- >>> decodeBase64 "U3Vu"+-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"+-- "Sun"+--+decodeBase64+ :: StdAlphabet k+ => Base64 k ShortByteString+ -> ShortByteString+decodeBase64 = toShort . B64.decodeBase64 . fmap fromShort+{-# INLINE decodeBase64 #-}++-- | Decode a padded Base64-encoded 'ShortByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Untyped "U3Vu" -- Right "Sun" ----- >>> decodeBase64 "U3V"+-- >>> decodeBase64Untyped "U3V" -- Left "Base64-encoded bytestring requires padding" ----- >>> decodebase64 "U3V="+-- >>> decodeBase64Untyped "U3V=" -- Left "non-canonical encoding detected at offset: 2" ---decodeBase64 :: ShortByteString -> Either Text ShortByteString-decodeBase64 = fmap toShort . B64.decodeBase64 . fromShort-{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: ShortByteString -> Either Text ShortByteString+decodeBase64Untyped = fmap toShort . B64.decodeBase64Untyped . fromShort+{-# inline decodeBase64Untyped #-} -- | Leniently decode an unpadded Base64-encoded 'ShortByteString' value. This function -- will not generate parse errors. If input data contains padding chars,@@ -91,50 +116,36 @@ -- >>> decodeBase64Lenient "U3V" -- "Su" ----- >>> decodebase64Lenient "U3V="+-- >>> decodeBase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ShortByteString -> ShortByteString decodeBase64Lenient = toShort . B64.decodeBase64Lenient . fromShort {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ShortByteString' value is base64 encoded.------ === __Examples__:------ >>> isBase64 "U3Vu"--- True------ >>> isBase64 "U3V"--- False------ >>> isBase64 "U3V="--- False----isBase64 :: ShortByteString -> Bool-isBase64 = B64.isBase64 . fromShort-{-# INLINE isBase64 #-}---- | Tell whether a 'ShortByteString' value is a valid Base64 format.+-- | Parse a canonical, padded Base64-encoded 'ShortByteString' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ShortByteString' value, use 'isBase64'.+-- Checks the alphabet, length, padding, and unused padding bits. On success,+-- returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isValidBase64 "U3Vu"--- True+-- >>> parseBase64 "U3Vu"+-- Right "U3Vu" ----- >>> isValidBase64 "U3V"--- True+-- >>> fmap decodeBase64 (parseBase64 "U3Vu")+-- Right "Sun" ----- >>> isValidBase64 "U3V="--- True+-- >>> parseBase64 "U3V"+-- Left "Base64-encoded bytestring requires padding" ----- >>> isValidBase64 "%"--- False+-- >>> parseBase64 "U3V="+-- Left "non-canonical encoding detected at offset: 2" ---isValidBase64 :: ShortByteString -> Bool-isValidBase64 = B64.isValidBase64 . fromShort-{-# INLINE isValidBase64 #-}+-- @since 2.0+--+parseBase64 :: ShortByteString -> Either Text (Base64 'StdPadded ShortByteString)+parseBase64 bs = assertBase64 bs <$ B64.parseBase64 (fromShort bs)+{-# INLINE parseBase64 #-}
src/Data/ByteString/Short/Base64/URL.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.ByteString.Short.Base64.URL--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -21,21 +21,35 @@ , encodeBase64Unpadded' -- * Decoding , decodeBase64+, decodeBase64Untyped , decodeBase64Unpadded+, decodeBase64UnpaddedUntyped , decodeBase64Padded+, decodeBase64PaddedUntyped , decodeBase64Lenient- -- * Validation-, isBase64Url-, isValidBase64Url+ -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where +import Data.Base64.Types+ import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Short (ShortByteString, fromShort, toShort) import Data.Text (Text) import Data.Text.Short (ShortText) import Data.Text.Short.Unsafe (fromShortByteStringUnsafe) ++-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'ShortByteString' value as a Base64url 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -45,8 +59,8 @@ -- >>> encodeBase64 "<<?>>" -- "PDw_Pj4=" ---encodeBase64 :: ShortByteString -> ShortText-encodeBase64 = fromShortByteStringUnsafe . encodeBase64'+encodeBase64 :: ShortByteString -> Base64 'UrlPadded ShortText+encodeBase64 = fmap fromShortByteStringUnsafe . encodeBase64' {-# INLINE encodeBase64 #-} -- | Encode a 'ShortByteString' as a Base64url 'ShortByteString' value with padding.@@ -58,39 +72,61 @@ -- >>> encodeBase64' "<<?>>" -- "PDw_Pj4=" ---encodeBase64' :: ShortByteString -> ShortByteString-encodeBase64' = toShort . B64U.encodeBase64' . fromShort+encodeBase64' :: ShortByteString -> Base64 'UrlPadded ShortByteString+encodeBase64' = fmap toShort . B64U.encodeBase64' . fromShort --- | Decode a padded Base64url encoded 'ShortByteString' value. If its length is not a multiple+-- | Decode a Base64url encoded 'ShortByteString' value, either padded or unpadded.+-- The correct decoding function is dispatched based on the existence of padding.+--+-- For typed values:+-- - If a padded value is required, use 'decodeBase64Padded'+-- - If an unpadded value is required, use 'decodeBase64Unpadded'+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64+ :: UrlAlphabet k+ => Base64 k ShortByteString+ -> ShortByteString+decodeBase64 = toShort . B64U.decodeBase64 . fmap fromShort++-- | Decode an untyped Base64url encoded 'ByteString' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as Base64url-encoded values are optionally padded. ----- For a decoder that fails on unpadded input of incorrect size, use 'decodeBase64Unpadded'.+-- For a decoder that fails to decode untyped values of incorrect size:+-- - If a padded value is required, use 'decodeBase64PaddedUntyped'+-- - If an unpadded value is required, use 'decodeBase64UnpaddedUntyped' -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "PDw_Pj4="+-- >>> decodeBase64Untyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64 "PDw_Pj4"+-- >>> decodeBase64Untyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64 "PDw-Pg="+-- >>> decodeBase64Untyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ----- >>> decodeBase64 "PDw-Pg"+-- >>> decodeBase64Untyped "PDw-Pg" -- Right "<<>>" ---decodeBase64 :: ShortByteString -> Either Text ShortByteString-decodeBase64 = fmap toShort . B64U.decodeBase64 . fromShort--{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: ShortByteString -> Either Text ShortByteString+decodeBase64Untyped = fmap toShort . B64U.decodeBase64Untyped . fromShort+{-# inline decodeBase64Untyped #-} --- | Encode a 'ShortByteString' value as Base64url 'Text' without padding. Note that for Base64url,--- padding is optional. If you call this function, you will simply be encoding--- as Base64url and stripping padding chars from the output.+-- | Encode a 'ShortByteString' value as Base64url 'Text' without padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -99,13 +135,11 @@ -- >>> encodeBase64Unpadded "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded :: ShortByteString -> ShortText-encodeBase64Unpadded = fromShortByteStringUnsafe . encodeBase64Unpadded'+encodeBase64Unpadded :: ShortByteString -> Base64 'UrlUnpadded ShortText+encodeBase64Unpadded = fmap fromShortByteStringUnsafe . encodeBase64Unpadded' {-# INLINE encodeBase64Unpadded #-} --- | Encode a 'ShortByteString' value as Base64url without padding. Note that for Base64url,--- padding is optional. If you call this function, you will simply be encoding--- as Base64url and stripping padding chars from the output.+-- | Encode a 'ShortByteString' value as Base64url without padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -114,13 +148,27 @@ -- >>> encodeBase64Unpadded' "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded' :: ShortByteString -> ShortByteString-encodeBase64Unpadded' = toShort . B64U.encodeBase64Unpadded' . fromShort+encodeBase64Unpadded' :: ShortByteString -> Base64 'UrlUnpadded ShortByteString+encodeBase64Unpadded' = fmap toShort . B64U.encodeBase64Unpadded' . fromShort --- | Decode an unpadded Base64url-encoded 'ShortByteString' value. Input strings are--- required to be unpadded, and will undergo validation prior to decoding to--- confirm.+-- | Decode an unpadded Base64url-encoded 'ShortByteString' value. --+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64Unpadded :: Base64 'UrlUnpadded ShortByteString -> ShortByteString+decodeBase64Unpadded = toShort . B64U.decodeBase64Unpadded . fmap fromShort+{-# INLINE decodeBase64Unpadded #-}++-- | Decode an unpadded, untyped Base64url encoded 'ByteString' value.+-- If its length is not a multiple of 4, then padding chars will be added+-- to fill out the input to a multiple of 4 for safe decoding as+-- Base64url-encoded values are optionally padded.+-- -- In general, unless unpadded Base64url is explicitly required, it is -- safer to call 'decodeBase64'. --@@ -128,38 +176,56 @@ -- -- === __Examples__: ----- >>> decodeBase64Unpadded "PDw_Pj4"+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64Unpadded "PDw_Pj4="+-- >>> decodeBase64UnpaddedUntyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ---decodeBase64Unpadded :: ShortByteString -> Either Text ShortByteString-decodeBase64Unpadded = fmap toShort . B64U.decodeBase64Unpadded . fromShort-{-# INLINE decodeBase64Unpadded #-}+-- >>> decodeBase64UnpaddedUntyped "PDw-Pg"+-- Right "<<>>"+--+decodeBase64UnpaddedUntyped :: ShortByteString -> Either Text ShortByteString+decodeBase64UnpaddedUntyped = fmap toShort+ . B64U.decodeBase64UnpaddedUntyped+ . fromShort+{-# inline decodeBase64UnpaddedUntyped #-} --- | Decode a padded Base64url-encoded 'ShortByteString' value. Input strings are--- required to be correctly padded, and will be validated prior to decoding--- to confirm.+-- | Decode a padded Base64url-encoded 'ShortByteString' value. ----- In general, unless padded Base64url is explicitly required, it is--- safer to call 'decodeBase64'.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Padded $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+decodeBase64Padded :: Base64 'UrlPadded ShortByteString -> ShortByteString+decodeBase64Padded = toShort . B64U.decodeBase64Padded . fmap fromShort+{-# INLINE decodeBase64Padded #-}++-- | Decode a padded, untyped Base64url encoded 'ByteString' value.+--+-- For a decoder that fails on unpadded input of incorrect size,+-- use 'decodeBase64UnpaddedUntyped'.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Padded "PDw_Pj4="+-- >>> decodeBase64PaddedUntyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64Padded "PDw_Pj4"+-- >>> decodeBase64PaddedUntyped "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" ---decodeBase64Padded :: ShortByteString -> Either Text ShortByteString-decodeBase64Padded = fmap toShort . B64U.decodeBase64Padded . fromShort-{-# INLINE decodeBase64Padded #-}+decodeBase64PaddedUntyped :: ShortByteString -> Either Text ShortByteString+decodeBase64PaddedUntyped = fmap toShort+ . B64U.decodeBase64PaddedUntyped+ . fromShort+{-# inline decodeBase64PaddedUntyped #-} --- | Leniently decode an unpadded Base64url-encoded 'ShortByteString'. This function+-- | Leniently decode an unpadded, untyped Base64url-encoded 'ShortByteString'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -177,40 +243,58 @@ decodeBase64Lenient = toShort . B64U.decodeBase64Lenient . fromShort {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ShortByteString' is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'ShortByteString' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ShortByteString -> Bool-isBase64Url = B64U.isBase64Url . fromShort-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ShortByteString -> Either Text (Base64 'UrlPadded ShortByteString)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (fromShort bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'ShortByteString' is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ShortByteString' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ShortByteString' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. -- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ShortByteString -> Bool-isValidBase64Url = B64U.isValidBase64Url . fromShort-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ShortByteString -> Either Text (Base64 'UrlUnpadded ShortByteString)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (fromShort bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/Text/Encoding/Base64.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.Text.Encoding.Base64--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,14 +18,15 @@ encodeBase64 -- * Decoding , decodeBase64-, decodeBase64With+, decodeBase64Untyped+, decodeBase64UntypedWith , decodeBase64Lenient- -- * Validation-, isBase64-, isValidBase64+ -- * Parsing+, parseBase64 ) where +import Data.Base64.Types import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base64 as B64@@ -34,6 +35,14 @@ import qualified Data.Text.Encoding as T import Data.Text.Encoding.Base64.Error +-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'Text' value in Base64 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>@@ -43,36 +52,39 @@ -- >>> encodeBase64 "Sun" -- "U3Vu" ---encodeBase64 :: Text -> Text+encodeBase64 :: Text -> Base64 'StdPadded Text encodeBase64 = B64.encodeBase64 . T.encodeUtf8 {-# INLINE encodeBase64 #-} -- | Decode a padded Base64-encoded 'Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`--- and pass in a custom decode function.--- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "U3Vu"--- Right "Sun"+-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"+-- "Sun" ----- >>> decodeBase64 "U3V"--- Left "Base64-encoded bytestring requires padding"+decodeBase64 :: StdAlphabet k => Base64 k Text -> Text+decodeBase64 = T.decodeUtf8 . B64.decodeBase64 . fmap T.encodeUtf8+{-# INLINE decodeBase64 #-}++-- | Decode a padded, untyped Base64-encoded 'Text' value. ----- >>> decodebase64 "U3V="--- Left "non-canonical encoding detected at offset: 2"+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> ---decodeBase64 :: Text -> Either Text Text-decodeBase64 = fmap T.decodeLatin1 . B64.decodeBase64 . T.encodeUtf8-{-# INLINE decodeBase64 #-}+-- === __Examples__:+--+-- >>> decodeBase64Untyped "U3Vu"+-- Right "Sun"+--+decodeBase64Untyped :: Text -> Either Text Text+decodeBase64Untyped = fmap T.decodeUtf8+ . B64.decodeBase64Untyped+ . T.encodeUtf8+{-# INLINE decodeBase64Untyped #-} --- | Attempt to decode a 'Text' value as Base64, converting from+-- | Attempt to decode an untyped 'Text' value as Base64, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -81,22 +93,22 @@ -- === __Example__: -- -- @--- 'decodeBase64With' 'T.decodeUtf8''+-- 'decodeBase64UntypedWith' 'T.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ ---decodeBase64With+decodeBase64UntypedWith :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text-decodeBase64With f t = case B64.decodeBase64 t of+decodeBase64UntypedWith f t = case B64.decodeBase64Untyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64With #-}+{-# INLINE decodeBase64UntypedWith #-} --- | Leniently decode a Base64-encoded 'Text' value. This function+-- | Leniently decode an untyped Base64-encoded 'Text' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -110,52 +122,41 @@ -- >>> decodeBase64Lenient "U3V" -- "Su" ----- >>> decodebase64Lenient "U3V="+-- >>> decodeBase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: Text -> Text-decodeBase64Lenient = T.decodeLatin1+decodeBase64Lenient = T.decodeUtf8 . B64.decodeBase64Lenient . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'Text' value is Base64-encoded.------ === __Examples__:------ >>> isBase64 "U3Vu"--- True------ >>> isBase64 "U3V"--- False------ >>> isBase64 "U3V="--- False+-- | Parse a canonical, padded Base64-encoded 'Text' value. ---isBase64 :: Text -> Bool-isBase64 = B64.isBase64 . T.encodeUtf8-{-# INLINE isBase64 #-}---- | Tell whether a 'Text' value is a valid Base64 format.+-- Checks the alphabet, length, padding, and unused padding bits. On success,+-- returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.+-- The input is neither decoded nor normalized in the returned value. ----- This will not tell you whether or not this is a correct Base64 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'Text' value, use 'isBase64'.+-- This validates the Base64 encoding, not the UTF-8 validity of the decoded+-- bytes. Use 'decodeBase64UntypedWith' to check the decoded text encoding. -- -- === __Examples__: ----- >>> isValidBase64 "U3Vu"--- True+-- >>> parseBase64 "U3Vu"+-- Right "U3Vu" ----- >>> isValidBase64 "U3V"--- True+-- >>> fmap decodeBase64 (parseBase64 "U3Vu")+-- Right "Sun" ----- >>> isValidBase64 "U3V="--- True+-- >>> parseBase64 "U3V"+-- Left "Base64-encoded bytestring requires padding" ----- >>> isValidBase64 "%"--- False+-- >>> parseBase64 "U3V="+-- Left "non-canonical encoding detected at offset: 2" ---isValidBase64 :: Text -> Bool-isValidBase64 = B64.isValidBase64 . T.encodeUtf8-{-# INLINE isValidBase64 #-}+-- @since 2.0+--+parseBase64 :: Text -> Either Text (Base64 'StdPadded Text)+parseBase64 bs = assertBase64 bs <$ B64.parseBase64 (T.encodeUtf8 bs)+{-# INLINE parseBase64 #-}
src/Data/Text/Encoding/Base64/Error.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base64.Error--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -30,10 +29,10 @@ -- unicode exceptions caught in the unicode decoding process. -- data Base64Error e- = DecodeError Text+ = DecodeError !Text -- ^ The error associated with decoding failure -- as a result of the Base64 decoding process- | ConversionError e+ | ConversionError !e -- ^ The error associated with the decoding failure -- as a result of the conversion process deriving
src/Data/Text/Encoding/Base64/URL.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.Text.Encoding.Base64.URL--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,18 +19,23 @@ , encodeBase64Unpadded -- * Decoding , decodeBase64-, decodeBase64With+, decodeBase64Untyped+, decodeBase64UntypedWith , decodeBase64Unpadded-, decodeBase64UnpaddedWith+, decodeBase64UnpaddedUntyped+, decodeBase64UnpaddedUntypedWith , decodeBase64Padded-, decodeBase64PaddedWith+, decodeBase64PaddedUntyped+, decodeBase64PaddedUntypedWith , decodeBase64Lenient- -- * Validation-, isBase64Url-, isValidBase64Url+ -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where +import Data.Base64.Types+ import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base64.URL as B64U@@ -39,6 +44,15 @@ import qualified Data.Text.Encoding as T import Data.Text.Encoding.Base64.Error ++-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'Text' value in Base64url with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -48,43 +62,62 @@ -- >>> encodeBase64 "<<?>>" -- "PDw_Pj4=" ---encodeBase64 :: Text -> Text+encodeBase64 :: Text -> Base64 'UrlPadded Text encodeBase64 = B64U.encodeBase64 . T.encodeUtf8 {-# INLINE encodeBase64 #-} --- | Decode a padded Base64url-encoded 'Text' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base64url encodings are optionally padded.+-- | Decode a Base64url encoded 'Text' value, either padded or unpadded.+-- The correct decoding function is dispatched based on the existence of padding. ----- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded'+-- For typed values:+-- - If a padded value is required, use 'decodeBase64Padded'+-- - If an unpadded value is required, use 'decodeBase64Unpadded' ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64 :: UrlAlphabet k => Base64 k Text -> Text+decodeBase64 = T.decodeUtf8 . B64U.decodeBase64 . fmap T.encodeUtf8+{-# INLINE decodeBase64 #-}++-- | Decode an untyped Base64url encoded 'Text' value. If its length is not a multiple+-- of 4, then padding chars will be added to fill out the input to a multiple of+-- 4 for safe decoding as Base64url-encoded values are optionally padded.+--+-- For a decoder that fails to decode untyped values of incorrect size:+-- - If a padded value is required, use 'decodeBase64PaddedUntyped'+-- - If an unpadded value is required, use 'decodeBase64UnpaddedUntyped'+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "PDw_Pj4="+-- >>> decodeBase64Untyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64 "PDw_Pj4"+-- >>> decodeBase64Untyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64 "PDw-Pg="+-- >>> decodeBase64Untyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ----- >>> decodeBase64 "PDw-Pg"+-- >>> decodeBase64Untyped "PDw-Pg" -- Right "<<>>" ---decodeBase64 :: Text -> Either Text Text-decodeBase64 = fmap T.decodeLatin1 . B64U.decodeBase64 . T.encodeUtf8-{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: Text -> Either Text Text+decodeBase64Untyped = fmap T.decodeUtf8+ . B64U.decodeBase64Untyped+ . T.encodeUtf8+{-# inline decodeBase64Untyped #-} --- | Attempt to decode a 'ByteString' value as Base64url, converting from+-- | Attempt to decode an untyped 'ByteString' value as Base64url, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -93,24 +126,22 @@ -- === __Examples__: -- -- @--- 'decodeBase64With' 'T.decodeUtf8''+-- 'decodeBase64UntypedWith' 'T.decodeUtf8'' -- :: 'Text' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ ---decodeBase64With+decodeBase64UntypedWith :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text-decodeBase64With f t = case B64U.decodeBase64 t of+decodeBase64UntypedWith f t = case B64U.decodeBase64Untyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64With #-}+{-# INLINE decodeBase64UntypedWith #-} --- | Encode a 'Text' value in Base64url without padding. Note that for Base64url,--- padding is optional. If you call this function, you will simply be encoding--- as Base64url and stripping padding chars from the output.+-- | Encode a 'Text' value in Base64url without padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -119,35 +150,52 @@ -- >>> encodeBase64Unpadded "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded :: Text -> Text+encodeBase64Unpadded :: Text -> Base64 'UrlUnpadded Text encodeBase64Unpadded = B64U.encodeBase64Unpadded . T.encodeUtf8 {-# INLINE encodeBase64Unpadded #-} -- | Decode an unpadded Base64url encoded 'Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to--- 'decodeBase64UnpaddedWith' and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64Unpadded :: Base64 'UrlUnpadded Text -> Text+decodeBase64Unpadded = T.decodeUtf8+ . B64U.decodeBase64Unpadded+ . fmap T.encodeUtf8+{-# INLINE decodeBase64Unpadded #-}++-- | Decode a unpadded, untyped Base64url-encoded 'Text' value. If its length is not a multiple+-- of 4, then padding chars will be added to fill out the input to a multiple of+-- 4 for safe decoding as base64url encodings are optionally padded.+--+-- For a decoder that fails on unpadded input, use 'decodeBase64PaddedUntyped'+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Unpadded "PDw_Pj4"+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64Unpadded "PDw_Pj4="+-- >>> decodeBase64UnpaddedUntyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ---decodeBase64Unpadded :: Text -> Either Text Text-decodeBase64Unpadded = fmap T.decodeLatin1- . B64U.decodeBase64Unpadded- . T.encodeUtf8-{-# INLINE decodeBase64Unpadded #-}+-- >>> decodeBase64UnpaddedUntyped "PDw-Pg"+-- Right "<<>>"+--+decodeBase64UnpaddedUntyped :: Text -> Either Text Text+decodeBase64UnpaddedUntyped = fmap T.decodeUtf8+ . B64U.decodeBase64UnpaddedUntyped+ . T.encodeUtf8+{-# inline decodeBase64UnpaddedUntyped #-} --- | Attempt to decode an unpadded 'ByteString' value as Base64url, converting from++-- | Attempt to decode an untyped, unpadded 'ByteString' value as Base64url, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -156,46 +204,54 @@ -- === __Example__: -- -- @--- 'decodeBase64UnpaddedWith' 'T.decodeUtf8''+-- 'decodeBase64UnpaddedUntypedWith' 'T.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ ---decodeBase64UnpaddedWith+decodeBase64UnpaddedUntypedWith :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text-decodeBase64UnpaddedWith f t = case B64U.decodeBase64Unpadded t of+decodeBase64UnpaddedUntypedWith f t = case B64U.decodeBase64UnpaddedUntyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64UnpaddedWith #-}+{-# INLINE decodeBase64UnpaddedUntypedWith #-} --- | Decode an padded Base64url encoded 'Text' value+-- | Decode a padded Base64url encoded 'Text' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to 'decodeBase64PaddedWith'--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Padded $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+decodeBase64Padded :: Base64 'UrlPadded Text -> Text+decodeBase64Padded = T.decodeUtf8+ . B64U.decodeBase64Padded+ . fmap T.encodeUtf8+{-# INLINE decodeBase64Padded #-}++-- | Decode an untyped, padded Base64url encoded 'Text' value+--+-- For a decoder that fails on padded input, use 'decodeBase64UnpaddedUntyped'+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Padded "PDw_Pj4="+-- >>> decodeBase64PaddedUntyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64Padded "PDw_Pj4"--- Left "Base64-encoded bytestring requires padding"----decodeBase64Padded :: Text -> Either Text Text-decodeBase64Padded = fmap T.decodeLatin1- . B64U.decodeBase64Padded- . T.encodeUtf8-{-# INLINE decodeBase64Padded #-}+decodeBase64PaddedUntyped :: Text -> Either Text Text+decodeBase64PaddedUntyped = fmap T.decodeUtf8+ . B64U.decodeBase64PaddedUntyped+ . T.encodeUtf8+{-# inline decodeBase64PaddedUntyped #-} --- | Attempt to decode a padded 'ByteString' value as Base64url, converting from+-- | Attempt to decode a padded, untyped 'ByteString' value as Base64url, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -208,18 +264,18 @@ -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ ---decodeBase64PaddedWith+decodeBase64PaddedUntypedWith :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) Text-decodeBase64PaddedWith f t = case B64U.decodeBase64Padded t of+decodeBase64PaddedUntypedWith f t = case B64U.decodeBase64PaddedUntyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64PaddedWith #-}+{-# INLINE decodeBase64PaddedUntypedWith #-} --- | Leniently decode an unpadded Base64url-encoded 'Text'. This function+-- | Leniently decode an untyped Base64url-encoded 'Text'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -234,45 +290,69 @@ -- "<<?>>" -- decodeBase64Lenient :: Text -> Text-decodeBase64Lenient = T.decodeLatin1+decodeBase64Lenient = T.decodeUtf8 . B64U.decodeBase64Lenient . T.encodeUtf8 {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'Text' value is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'Text' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: Text -> Bool-isBase64Url = B64U.isBase64Url . T.encodeUtf8-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: Text -> Either Text (Base64 'UrlPadded Text)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (T.encodeUtf8 bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'Text' value is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'Text' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'Text' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: Text -> Bool-isValidBase64Url = B64U.isValidBase64Url . T.encodeUtf8-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: Text -> Either Text (Base64 'UrlUnpadded Text)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (T.encodeUtf8 bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/Text/Lazy/Encoding/Base64.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.Text.Lazy.Encoding.Base64--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,14 +18,16 @@ encodeBase64 -- * Decoding , decodeBase64-, decodeBase64With+, decodeBase64Untyped+, decodeBase64UntypedWith , decodeBase64Lenient- -- * Validation-, isBase64-, isValidBase64+ -- * Parsing+, parseBase64 ) where +import Data.Base64.Types+ import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Base64 as BL64@@ -35,6 +37,16 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +++-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'TL.Text' value in Base64 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>@@ -44,7 +56,7 @@ -- >>> encodeBase64 "Sun" -- "U3Vu" ---encodeBase64 :: TL.Text -> TL.Text+encodeBase64 :: TL.Text -> Base64 'StdPadded TL.Text encodeBase64 = BL64.encodeBase64 . TL.encodeUtf8 {-# INLINE encodeBase64 #-} @@ -52,26 +64,33 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`--- and pass in a custom decode function.+-- === __Examples__: --+-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"+-- "Sun"+--+decodeBase64 :: StdAlphabet k => Base64 k TL.Text -> TL.Text+decodeBase64 = TL.decodeUtf8 . BL64.decodeBase64 . fmap TL.encodeUtf8+{-# INLINE decodeBase64 #-}++-- | Decode a padded, untyped Base64-encoded 'TL.Text' value+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+-- -- === __Examples__: ----- >>> decodeBase64 "U3Vu"+-- >>> decodeBase64Untyped "U3Vu" -- Right "Sun" ----- >>> decodeBase64 "U3V"+-- >>> decodeBase64Untyped "U3V" -- Left "Base64-encoded bytestring requires padding" ----- >>> decodebase64 "U3V="+-- >>> decodeBase64Untyped "U3V=" -- Left "non-canonical encoding detected at offset: 2" ---decodeBase64 :: TL.Text -> Either T.Text TL.Text-decodeBase64 = fmap TL.decodeLatin1 . BL64.decodeBase64 . TL.encodeUtf8-{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: TL.Text -> Either T.Text TL.Text+decodeBase64Untyped = fmap TL.decodeUtf8 . BL64.decodeBase64Untyped . TL.encodeUtf8+{-# INLINE decodeBase64Untyped #-} -- | Attempt to decode a 'ByteString' value as Base64, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -82,22 +101,22 @@ -- === __Example__: -- -- @--- 'decodeBase64With' 'TL.decodeUtf8''+-- 'decodeBase64UntypedWith' 'TL.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text' -- @ ---decodeBase64With+decodeBase64UntypedWith :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text-decodeBase64With f t = case BL64.decodeBase64 t of+decodeBase64UntypedWith f t = case BL64.decodeBase64Untyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64With #-}+{-# INLINE decodeBase64UntypedWith #-} --- | Leniently decode a Base64-encoded 'TL.Text' value. This function+-- | Leniently decode an untyped Base64-encoded 'TL.Text' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -111,52 +130,44 @@ -- >>> decodeBase64Lenient "U3V" -- "Su" ----- >>> decodebase64Lenient "U3V="+-- >>> decodeBase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: TL.Text -> TL.Text-decodeBase64Lenient = TL.decodeLatin1- . BL64.decodeBase64Lenient- . TL.encodeUtf8+decodeBase64Lenient = TL.decodeUtf8+ . BL64.decodeBase64Lenient+ . TL.encodeUtf8 {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'TL.Text' value is Base64-encoded.------ === __Examples__:------ >>> isBase64 "U3Vu"--- True------ >>> isBase64 "U3V"--- False+-- | Parse a canonical, padded Base64-encoded 'TL.Text' value. ----- >>> isBase64 "U3V="--- False+-- Checks the alphabet, length, padding, and unused padding bits. On success,+-- returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.+-- The input is neither decoded nor normalized in the returned value. ---isBase64 :: TL.Text -> Bool-isBase64 = BL64.isBase64 . TL.encodeUtf8-{-# INLINE isBase64 #-}---- | Tell whether a 'TL.Text' value is a valid Base64 format.+-- This validates the Base64 encoding, not the UTF-8 validity of the decoded+-- bytes. Use 'decodeBase64UntypedWith' to check the decoded text encoding. ----- This will not tell you whether or not this is a correct Base64 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'TL.Text' value, use 'isBase64'.+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result. -- -- === __Examples__: ----- >>> isValidBase64 "U3Vu"--- True+-- >>> parseBase64 "U3Vu"+-- Right "U3Vu" ----- >>> isValidBase64 "U3V"--- True+-- >>> fmap decodeBase64 (parseBase64 "U3Vu")+-- Right "Sun" ----- >>> isValidBase64 "U3V="--- True+-- >>> parseBase64 "U3V"+-- Left "Base64-encoded bytestring requires padding" ----- >>> isValidBase64 "%"--- False+-- >>> parseBase64 "U3V="+-- Left "non-canonical encoding detected at offset: 2" ---isValidBase64 :: TL.Text -> Bool-isValidBase64 = BL64.isValidBase64 . TL.encodeUtf8-{-# INLINE isValidBase64 #-}+-- @since 2.0+--+parseBase64 :: TL.Text -> Either T.Text (Base64 'StdPadded TL.Text)+parseBase64 bs = assertBase64 bs <$ BL64.parseBase64 (TL.encodeUtf8 bs)+{-# INLINE parseBase64 #-}
src/Data/Text/Lazy/Encoding/Base64/URL.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.Text.Lazy.Encoding.Base64.URL--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,17 +19,21 @@ , encodeBase64Unpadded -- * Decoding , decodeBase64-, decodeBase64With+, decodeBase64Untyped+, decodeBase64UntypedWith , decodeBase64Unpadded-, decodeBase64UnpaddedWith+, decodeBase64UnpaddedUntyped+, decodeBase64UnpaddedUntypedWith , decodeBase64Padded-, decodeBase64PaddedWith+, decodeBase64PaddedUntyped+, decodeBase64PaddedUntypedWith , decodeBase64Lenient- -- * Validation-, isBase64Url-, isValidBase64Url+ -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where +import Data.Base64.Types import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString)@@ -40,6 +44,16 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +++-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'TL.Text' value in Base64url with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -49,43 +63,59 @@ -- >>> encodeBase64 "<<?>>" -- "PDw_Pj4=" ---encodeBase64 :: TL.Text -> TL.Text+encodeBase64 :: TL.Text -> Base64 'UrlPadded TL.Text encodeBase64 = BL64U.encodeBase64 . TL.encodeUtf8 {-# INLINE encodeBase64 #-} --- | Decode a padded Base64url-encoded 'TL.Text' value. If its length is not a multiple+-- | Decode an arbitrarily Base64url-encoded 'TL.Text' value.+--+-- For typed values:+-- - If a padded value is required, use 'decodeBase64Padded'+-- - If an unpadded value is required, use 'decodeBase64Unpadded'+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64 :: UrlAlphabet k => Base64 k TL.Text -> TL.Text+decodeBase64 = TL.decodeUtf8 . BL64U.decodeBase64 . fmap TL.encodeUtf8+{-# INLINE decodeBase64 #-}++-- | Decode an untyped Base64url-encoded 'TL.Text' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as base64url encodings are optionally padded. -- -- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded'. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`--- and pass in a custom decode function.--- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "PDw_Pj4="+-- >>> decodeBase64Untyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64 "PDw_Pj4"+-- >>> decodeBase64Untyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64 "PDw-Pg="+-- >>> decodeBase64Untyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ----- >>> decodeBase64 "PDw-Pg"+-- >>> decodeBase64Untyped "PDw-Pg" -- Right "<<>>" ---decodeBase64 :: TL.Text -> Either T.Text TL.Text-decodeBase64 = fmap TL.decodeLatin1 . BL64U.decodeBase64 . TL.encodeUtf8-{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: TL.Text -> Either T.Text TL.Text+decodeBase64Untyped = fmap TL.decodeUtf8+ . BL64U.decodeBase64Untyped+ . TL.encodeUtf8+{-# INLINE decodeBase64Untyped #-} --- | Attempt to decode a lazy 'ByteString' value as Base64url, converting from+-- | Attempt to decode an untyped lazy 'ByteString' value as Base64url, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -98,16 +128,16 @@ -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text' -- @ ---decodeBase64With+decodeBase64UntypedWith :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text-decodeBase64With f t = case BL64U.decodeBase64 t of+decodeBase64UntypedWith f t = case BL64U.decodeBase64Untyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64With #-}+{-# INLINE decodeBase64UntypedWith #-} -- | Encode a 'TL.Text' value in Base64url without padding. Note that for Base64url, -- padding is optional. If you call this function, you will simply be encoding@@ -120,35 +150,44 @@ -- >>> encodeBase64Unpadded "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded :: TL.Text -> TL.Text+encodeBase64Unpadded :: TL.Text -> Base64 'UrlUnpadded TL.Text encodeBase64Unpadded = BL64U.encodeBase64Unpadded . TL.encodeUtf8 {-# INLINE encodeBase64Unpadded #-} --- | Decode an unpadded Base64url encoded 'TL.Text' value.+-- | Decode an unpadded Base64url encoded 'Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64WUnpaddedWith`--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64Unpadded :: Base64 'UrlUnpadded TL.Text -> TL.Text+decodeBase64Unpadded = TL.decodeUtf8+ . BL64U.decodeBase64Unpadded+ . fmap TL.encodeUtf8+{-# INLINE decodeBase64Unpadded #-}++-- | Decode an unpadded, untyped Base64url encoded 'TL.Text' value.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Unpadded "PDw_Pj4"+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64Unpadded "PDw_Pj4="+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" ---decodeBase64Unpadded :: TL.Text -> Either T.Text TL.Text-decodeBase64Unpadded = fmap TL.decodeLatin1- . BL64U.decodeBase64Unpadded+decodeBase64UnpaddedUntyped :: TL.Text -> Either T.Text TL.Text+decodeBase64UnpaddedUntyped = fmap TL.decodeUtf8+ . BL64U.decodeBase64UnpaddedUntyped . TL.encodeUtf8-{-# INLINE decodeBase64Unpadded #-}+{-# INLINE decodeBase64UnpaddedUntyped #-} --- | Attempt to decode an unpadded lazy 'ByteString' value as Base64url, converting from+-- | Attempt to decode an unpadded, untyped lazy 'ByteString' value as Base64url, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -157,46 +196,52 @@ -- === __Examples__: -- -- @--- 'decodeBase64UnpaddedWith' 'TL.decodeUtf8''+-- 'decodeBase64UnpaddedUntypedWith' 'TL.decodeUtf8'' -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'TL.Text' -- @ ---decodeBase64UnpaddedWith+decodeBase64UnpaddedUntypedWith :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text-decodeBase64UnpaddedWith f t = case BL64U.decodeBase64Unpadded t of+decodeBase64UnpaddedUntypedWith f t = case BL64U.decodeBase64UnpaddedUntyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64UnpaddedWith #-}+{-# INLINE decodeBase64UnpaddedUntypedWith #-} --- | Decode an padded Base64url encoded 'TL.Text' value+-- | Decode a padded Base64url encoded 'TL.Text' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64PaddedWith`--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Padded $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+decodeBase64Padded :: Base64 'UrlPadded TL.Text -> TL.Text+decodeBase64Padded = TL.decodeUtf8+ . BL64U.decodeBase64Padded+ . fmap TL.encodeUtf8+{-# INLINE decodeBase64Padded #-}++-- | Decode an untyped, padded Base64url encoded 'Text' value+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Padded "PDw_Pj4="+-- >>> decodeBase64PaddedUntyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64Padded "PDw_Pj4"--- Left "Base64-encoded bytestring requires padding"----decodeBase64Padded :: TL.Text -> Either T.Text TL.Text-decodeBase64Padded = fmap TL.decodeLatin1- . BL64U.decodeBase64Padded- . TL.encodeUtf8-{-# INLINE decodeBase64Padded #-}+decodeBase64PaddedUntyped :: TL.Text -> Either T.Text TL.Text+decodeBase64PaddedUntyped = fmap TL.decodeUtf8+ . BL64U.decodeBase64PaddedUntyped+ . TL.encodeUtf8+{-# inline decodeBase64PaddedUntyped #-} --- | Attempt to decode a padded lazy 'ByteString' value as Base64url, converting from+-- | Attempt to decode a padded, untyped lazy 'ByteString' value as Base64url, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -209,18 +254,18 @@ -- :: 'ByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'Text' -- @ ---decodeBase64PaddedWith+decodeBase64PaddedUntypedWith :: (ByteString -> Either err TL.Text) -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'') -> ByteString -- ^ Input text to decode -> Either (Base64Error err) TL.Text-decodeBase64PaddedWith f t = case BL64U.decodeBase64Padded t of+decodeBase64PaddedUntypedWith f t = case BL64U.decodeBase64PaddedUntyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64PaddedWith #-}+{-# INLINE decodeBase64PaddedUntypedWith #-} --- | Leniently decode an unpadded Base64url-encoded 'TL.Text'. This function+-- | Leniently decode an untyped Base64url-encoded 'TL.Text'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -235,45 +280,75 @@ -- "<<?>>" -- decodeBase64Lenient :: TL.Text -> TL.Text-decodeBase64Lenient = TL.decodeLatin1+decodeBase64Lenient = TL.decodeUtf8 . BL64U.decodeBase64Lenient . TL.encodeUtf8 {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'TL.Text' value is Base64url-encoded+-- | Parse a canonical, padded Base64url-encoded 'TL.Text' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: TL.Text -> Bool-isBase64Url = BL64U.isBase64Url . TL.encodeUtf8-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: TL.Text -> Either T.Text (Base64 'UrlPadded TL.Text)+parseBase64Padded bs = assertBase64 bs <$ BL64U.parseBase64Padded (TL.encodeUtf8 bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'TL.Text' value is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'TL.Text' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'TL.Text' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- The entire input is validated before returning 'Right'; the original+-- chunk boundaries are preserved in the result.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: TL.Text -> Bool-isValidBase64Url = BL64U.isValidBase64Url . TL.encodeUtf8-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: TL.Text -> Either T.Text (Base64 'UrlUnpadded TL.Text)+parseBase64Unpadded bs = assertBase64 bs <$ BL64U.parseBase64Unpadded (TL.encodeUtf8 bs)+{-# INLINE parseBase64Unpadded #-}
src/Data/Text/Short/Encoding/Base64.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.Text.Short.Encoding.Base64--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,13 +18,14 @@ encodeBase64 -- * Decoding , decodeBase64-, decodeBase64With+, decodeBase64Untyped+, decodeBase64UntypedWith , decodeBase64Lenient- -- * Validation-, isBase64-, isValidBase64+ -- * Parsing+, parseBase64 ) where +import Data.Base64.Types import Data.Bifunctor (first) import qualified Data.ByteString.Base64 as B64@@ -36,6 +37,15 @@ import Data.Text.Short import Data.Text.Short.Unsafe ++-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--+ -- | Encode a 'ShortText' value in Base64 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>@@ -45,38 +55,45 @@ -- >>> encodeBase64 "Sun" -- "U3Vu" ---encodeBase64 :: ShortText -> ShortText-encodeBase64 = fromByteStringUnsafe+encodeBase64 :: ShortText -> Base64 'StdPadded ShortText+encodeBase64 = fmap fromByteStringUnsafe . B64.encodeBase64' . toByteString {-# INLINE encodeBase64 #-} -- | Decode a padded Base64-encoded 'ShortText' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With`--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'StdPadded "U3Vu"+-- "Sun"+--+decodeBase64 :: StdAlphabet k => Base64 k ShortText -> ShortText+decodeBase64 = fromText . B64T.decodeBase64 . fmap toText+{-# INLINE decodeBase64 #-}++-- | Decode a padded Base64-encoded 'ShortText' value+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64 "U3Vu"+-- >>> decodeBase64Untyped "U3Vu" -- Right "Sun" ----- >>> decodeBase64 "U3V"+-- >>> decodeBase64Untyped "U3V" -- Left "Base64-encoded bytestring requires padding" ----- >>> decodebase64 "U3V="+-- >>> decodeBase64Untyped "U3V=" -- Left "non-canonical encoding detected at offset: 2" ---decodeBase64 :: ShortText -> Either Text ShortText-decodeBase64 = fmap fromText . B64T.decodeBase64 . toText-{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: ShortText -> Either Text ShortText+decodeBase64Untyped = fmap fromText . B64T.decodeBase64Untyped . toText+{-# INLINE decodeBase64Untyped #-} --- | Attempt to decode a 'ShortByteString' value as Base64, converting from+-- | Attempt to decode an untyped 'ShortByteString' value as Base64, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -85,22 +102,22 @@ -- === __Example__: -- -- @--- 'decodeBase64With' 'T.decodeUtf8''+-- 'decodeBase64UntypedWith' 'T.decodeUtf8'' -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ ---decodeBase64With+decodeBase64UntypedWith :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText-decodeBase64With f t = case BS64.decodeBase64 t of+decodeBase64UntypedWith f t = case BS64.decodeBase64Untyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64With #-}+{-# INLINE decodeBase64UntypedWith #-} --- | Leniently decode a Base64-encoded 'ShortText' value. This function+-- | Leniently decode an untyped Base64-encoded 'ShortText' value. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -114,50 +131,39 @@ -- >>> decodeBase64Lenient "U3V" -- "Su" ----- >>> decodebase64Lenient "U3V="+-- >>> decodeBase64Lenient "U3V=" -- "Su" -- decodeBase64Lenient :: ShortText -> ShortText decodeBase64Lenient = fromText . B64T.decodeBase64Lenient . toText {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ShortText' value is Base64-encoded.------ === __Examples__:------ >>> isBase64 "U3Vu"--- True------ >>> isBase64 "U3V"--- False------ >>> isBase64 "U3V="--- False+-- | Parse a canonical, padded Base64-encoded 'ShortText' value. ---isBase64 :: ShortText -> Bool-isBase64 = B64.isBase64 . toByteString-{-# INLINE isBase64 #-}---- | Tell whether a 'ShortText' value is a valid Base64 format.+-- Checks the alphabet, length, padding, and unused padding bits. On success,+-- returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64'. On failure, returns the same error as 'decodeBase64Untyped'.+-- The input is neither decoded nor normalized in the returned value. ----- This will not tell you whether or not this is a correct Base64 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ShortText' value, use 'isBase64'.+-- This validates the Base64 encoding, not the UTF-8 validity of the decoded+-- bytes. Use 'decodeBase64UntypedWith' to check the decoded text encoding. -- -- === __Examples__: ----- >>> isValidBase64 "U3Vu"--- True+-- >>> parseBase64 "U3Vu"+-- Right "U3Vu" ----- >>> isValidBase64 "U3V"--- True+-- >>> fmap decodeBase64 (parseBase64 "U3Vu")+-- Right "Sun" ----- >>> isValidBase64 "U3V="--- True+-- >>> parseBase64 "U3V"+-- Left "Base64-encoded bytestring requires padding" ----- >>> isValidBase64 "%"--- False+-- >>> parseBase64 "U3V="+-- Left "non-canonical encoding detected at offset: 2" ---isValidBase64 :: ShortText -> Bool-isValidBase64 = B64.isValidBase64 . toByteString-{-# INLINE isValidBase64 #-}+-- @since 2.0+--+parseBase64 :: ShortText -> Either Text (Base64 'StdPadded ShortText)+parseBase64 bs = assertBase64 bs <$ B64.parseBase64 (toByteString bs)+{-# INLINE parseBase64 #-}
src/Data/Text/Short/Encoding/Base64/URL.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Data.Text.Short.Encoding.Base64.URL--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -19,17 +19,21 @@ , encodeBase64Unpadded -- * Decoding , decodeBase64-, decodeBase64With+, decodeBase64Untyped+, decodeBase64UntypedWith , decodeBase64Unpadded-, decodeBase64UnpaddedWith+, decodeBase64UnpaddedUntyped+, decodeBase64UnpaddedUntypedWith , decodeBase64Padded-, decodeBase64PaddedWith+, decodeBase64PaddedUntyped+, decodeBase64PaddedUntypedWith , decodeBase64Lenient- -- * Validation-, isBase64Url-, isValidBase64Url+ -- * Parsing+, parseBase64Padded+, parseBase64Unpadded ) where +import Data.Base64.Types import Data.Bifunctor (first) import qualified Data.ByteString.Base64.URL as B64U@@ -41,6 +45,16 @@ import Data.Text.Short import Data.Text.Short.Unsafe ++-- $setup+--+-- >>> import Data.Base64.Types+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications+-- >>> :set -XDataKinds+--++ -- | Encode a 'ShortText' value in Base64url with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-5 RFC-4648 section 5>@@ -50,20 +64,40 @@ -- >>> encodeBase64 "<<?>>" -- "PDw_Pj4=" ---encodeBase64 :: ShortText -> ShortText-encodeBase64 = fromByteStringUnsafe+encodeBase64 :: ShortText -> Base64 'UrlPadded ShortText+encodeBase64 = fmap fromByteStringUnsafe . B64U.encodeBase64' . toByteString {-# INLINE encodeBase64 #-} --- | Decode a padded Base64url-encoded 'ShortText' value. If its length is not a multiple+-- | Decode an arbitrarily padded Base64url-encoded 'ShortText' value.+--+-- For typed values:+-- - If a padded value is required, use 'decodeBase64Padded'+-- - If an unpadded value is required, use 'decodeBase64Unpadded'+--+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4>+--+-- === __Examples__:+--+-- >>> decodeBase64 $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+-- >>> decodeBase64 $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64 :: UrlAlphabet k => Base64 k ShortText -> ShortText+decodeBase64 = fromText . B64TU.decodeBase64 . fmap toText+{-# INLINE decodeBase64 #-}++-- | Decode an untyped padded Base64url-encoded 'ShortText' value. If its length is not a multiple -- of 4, then padding chars will be added to fill out the input to a multiple of -- 4 for safe decoding as base64url encodings are optionally padded. -- -- For a decoder that fails on unpadded input, use 'decodeBase64Unpadded'. -- -- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded+-- 'T.decodeUtf8'. This will always round trip for any valid Base64-encoded -- text value, but it may not round trip for bad inputs. The onus is on the -- caller to make sure inputs are valid. If unsure, defer to `decodeBase64With` -- and pass in a custom decode function.@@ -72,23 +106,23 @@ -- -- === __Examples__: ----- >>> decodeBase64 "PDw_Pj4="+-- >>> decodeBase64Untyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64 "PDw_Pj4"+-- >>> decodeBase64Untyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64 "PDw-Pg="+-- >>> decodeBase64Untyped "PDw-Pg=" -- Left "Base64-encoded bytestring has invalid padding" ----- >>> decodeBase64 "PDw-Pg"+-- >>> decodeBase64Untyped "PDw-Pg" -- Right "<<>>" ---decodeBase64 :: ShortText -> Either Text ShortText-decodeBase64 = fmap fromText . B64TU.decodeBase64 . toText-{-# INLINE decodeBase64 #-}+decodeBase64Untyped :: ShortText -> Either Text ShortText+decodeBase64Untyped = fmap fromText . B64TU.decodeBase64Untyped . toText+{-# INLINE decodeBase64Untyped #-} --- | Attempt to decode a 'ShortByteString' value as Base64url, converting from+-- | Attempt to decode an untyped 'ShortByteString' value as Base64url, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -101,20 +135,18 @@ -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ ---decodeBase64With+decodeBase64UntypedWith :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText-decodeBase64With f t = case BS64U.decodeBase64 t of+decodeBase64UntypedWith f t = case BS64U.decodeBase64Untyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64With #-}+{-# INLINE decodeBase64UntypedWith #-} --- | Encode a 'ShortText' value in Base64url without padding. Note that for Base64url,--- padding is optional. If you call this function, you will simply be encoding--- as Base64url and stripping padding chars from the output.+-- | Encode a 'ShortText' value in Base64url without padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2> --@@ -123,35 +155,44 @@ -- >>> encodeBase64Unpadded "<<?>>" -- "PDw_Pj4" ---encodeBase64Unpadded :: ShortText -> ShortText-encodeBase64Unpadded = fromByteStringUnsafe+encodeBase64Unpadded :: ShortText -> Base64 'UrlUnpadded ShortText+encodeBase64Unpadded = fmap fromByteStringUnsafe . B64U.encodeBase64Unpadded' . toByteString {-# INLINE encodeBase64Unpadded #-} -- | Decode an unpadded Base64url encoded 'ShortText' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64UnpaddedWith`--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Unpadded $ assertBase64 @'UrlUnpadded "PDw_Pj4"+-- "<<?>>"+--+decodeBase64Unpadded :: Base64 'UrlUnpadded ShortText -> ShortText+decodeBase64Unpadded = fromText . B64TU.decodeBase64Unpadded . fmap toText+{-# INLINE decodeBase64Unpadded #-}++-- | Decode an untyped, unpadded Base64url encoded 'ShortText' value.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Unpadded "PDw_Pj4"+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4" -- Right "<<?>>" ----- >>> decodeBase64Unpadded "PDw_Pj4="+-- >>> decodeBase64UnpaddedUntyped "PDw_Pj4=" -- Left "Base64-encoded bytestring has invalid padding" ---decodeBase64Unpadded :: ShortText -> Either Text ShortText-decodeBase64Unpadded = fmap fromText . B64TU.decodeBase64Unpadded . toText-{-# INLINE decodeBase64Unpadded #-}+decodeBase64UnpaddedUntyped :: ShortText -> Either Text ShortText+decodeBase64UnpaddedUntyped = fmap fromText+ . B64TU.decodeBase64UnpaddedUntyped+ . toText+{-# INLINE decodeBase64UnpaddedUntyped #-} --- | Attempt to decode an unpadded 'ShortByteString' value as Base64url, converting from+-- | Attempt to decode an untyped, unpadded 'ShortByteString' value as Base64url, converting from -- 'ShortByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -164,40 +205,47 @@ -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ ---decodeBase64UnpaddedWith+decodeBase64UnpaddedUntypedWith :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText-decodeBase64UnpaddedWith f t = case BS64U.decodeBase64Unpadded t of+decodeBase64UnpaddedUntypedWith f t = case BS64U.decodeBase64UnpaddedUntyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64UnpaddedWith #-}+{-# INLINE decodeBase64UnpaddedUntypedWith #-} --- | Decode an padded Base64url encoded 'ShortText' value+-- | Decode a padded Base64url encoded 'ShortText' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeLatin1'. This will always round trip for any valid Base64-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase64PaddedWith`--- and pass in a custom decode function.+-- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> --+-- === __Examples__:+--+-- >>> decodeBase64Padded $ assertBase64 @'UrlPadded "PDw_Pj4="+-- "<<?>>"+--+decodeBase64Padded :: Base64 'UrlPadded ShortText -> ShortText+decodeBase64Padded = fromText . B64TU.decodeBase64Padded . fmap toText+{-# INLINE decodeBase64Padded #-}++-- | Decode an untyped, padded Base64url encoded 'ShortText' value+-- -- See: <https://tools.ietf.org/html/rfc4648#section-4 RFC-4648 section 4> -- -- === __Examples__: ----- >>> decodeBase64Padded "PDw_Pj4="+-- >>> decodeBase64PaddedUntyped "PDw_Pj4=" -- Right "<<?>>" ----- >>> decodeBase64Padded "PDw_Pj4"+-- >>> decodeBase64PaddedUntyped "PDw_Pj4" -- Left "Base64-encoded bytestring requires padding" ---decodeBase64Padded :: ShortText -> Either Text ShortText-decodeBase64Padded = fmap fromText . B64TU.decodeBase64Padded . toText-{-# INLINE decodeBase64Padded #-}+decodeBase64PaddedUntyped :: ShortText -> Either Text ShortText+decodeBase64PaddedUntyped = fmap fromText . B64TU.decodeBase64PaddedUntyped . toText+{-# INLINE decodeBase64PaddedUntyped #-} --- | Attempt to decode a padded 'ShortByteString' value as Base64url, converting from+-- | Attempt to decode an untyped, padded 'ShortByteString' value as Base64url, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. --@@ -210,18 +258,18 @@ -- :: 'ShortByteString' -> 'Either' ('Base64Error' 'UnicodeException') 'ShortText' -- @ ---decodeBase64PaddedWith+decodeBase64PaddedUntypedWith :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'') -> ShortByteString -- ^ Input text to decode -> Either (Base64Error err) ShortText-decodeBase64PaddedWith f t = case BS64U.decodeBase64Padded t of+decodeBase64PaddedUntypedWith f t = case BS64U.decodeBase64PaddedUntyped t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a)-{-# INLINE decodeBase64PaddedWith #-}+{-# INLINE decodeBase64PaddedUntypedWith #-} --- | Leniently decode an unpadded Base64url-encoded 'ShortText'. This function+-- | Leniently decode an untyped, unpadded Base64url-encoded 'ShortText'. This function -- will not generate parse errors. If input data contains padding chars, -- then the input will be parsed up until the first pad character. --@@ -239,40 +287,64 @@ decodeBase64Lenient = fromText . B64TU.decodeBase64Lenient . toText {-# INLINE decodeBase64Lenient #-} --- | Tell whether a 'ShortText' value is Base64url-encoded.+-- | Parse a canonical, padded Base64url-encoded 'ShortText' value. --+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Padded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64PaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value.+--+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Padded "PDw_Pj4="+-- Right "PDw_Pj4=" ----- >>> isBase64Url "PDw_Pj4"--- True+-- >>> fmap decodeBase64Padded (parseBase64Padded "PDw_Pj4=")+-- Right "<<?>>" ----- >>> isBase64Url "PDw_Pj"--- False+-- >>> parseBase64Padded "PDw_Pj4"+-- Left "Base64-encoded bytestring requires padding" ---isBase64Url :: ShortText -> Bool-isBase64Url = B64U.isBase64Url . toByteString-{-# INLINE isBase64Url #-}+-- >>> parseBase64Padded "ZE=="+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Padded :: ShortText -> Either Text (Base64 'UrlPadded ShortText)+parseBase64Padded bs = assertBase64 bs <$ B64U.parseBase64Padded (toByteString bs)+{-# INLINE parseBase64Padded #-} --- | Tell whether a 'ShortText' value is a valid Base64url format.+-- | Parse a canonical, unpadded Base64url-encoded 'ShortText' value. ----- This will not tell you whether or not this is a correct Base64url representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base64 encoded 'ShortText' value, use 'isBase64Url'.+-- Checks the URL-safe alphabet, length, padding, and unused padding bits.+-- Returns the original encoded value wrapped in 'Base64', ready for+-- 'decodeBase64Unpadded' or 'decodeBase64'. Errors match the strict ByteString+-- 'Data.ByteString.Base64.URL.decodeBase64UnpaddedUntyped' decoder.+-- The input is neither decoded nor normalized in the returned value. --+-- This validates the Base64url encoding, independently of whether the+-- decoded payload is valid UTF-8.+-- -- === __Examples__: ----- >>> isValidBase64Url "PDw_Pj4="--- True+-- >>> parseBase64Unpadded "PDw_Pj4"+-- Right "PDw_Pj4" ----- >>> isValidBase64Url "PDw_Pj"--- True+-- >>> fmap decodeBase64Unpadded (parseBase64Unpadded "PDw_Pj4")+-- Right "<<?>>" ----- >>> isValidBase64Url "%"--- False+-- >>> parseBase64Unpadded "PDw_Pj4="+-- Left "Base64-encoded bytestring has invalid padding" ---isValidBase64Url :: ShortText -> Bool-isValidBase64Url = B64U.isValidBase64Url . toByteString-{-# INLINE isValidBase64Url #-}+-- >>> parseBase64Unpadded "ZE"+-- Left "non-canonical encoding detected at offset: 1"+--+-- @since 2.1+--+parseBase64Unpadded :: ShortText -> Either Text (Base64 'UrlUnpadded ShortText)+parseBase64Unpadded bs = assertBase64 bs <$ B64U.parseBase64Unpadded (toByteString bs)+{-# INLINE parseBase64Unpadded #-}
test/Internal.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE PackageImports #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Main--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -27,6 +29,7 @@ ) where +import "base64" Data.Base64.Types import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS@@ -58,19 +61,22 @@ -- data Harness bs = Harness { label :: String- , encode :: bs -> bs- , encodeUrl :: bs -> bs- , encodeUrlNopad :: bs -> bs+ , encode :: bs -> Base64 'StdPadded bs+ , encodeUrl :: bs -> Base64 'UrlPadded bs+ , encodeUrlNopad :: bs -> Base64 'UrlUnpadded bs , decode :: bs -> Either Text bs+ , decodeTyped :: Base64 'StdPadded bs -> bs , decodeUrl :: bs -> Either Text bs , decodeUrlPad :: bs -> Either Text bs , decodeUrlNopad :: bs -> Either Text bs+ , decodeUrlTyped :: forall k. UrlAlphabet k => Base64 k bs -> bs+ , decodeUrlTypedPad :: Base64 'UrlPadded bs -> bs+ , decodeUrlTypedNopad :: Base64 'UrlUnpadded bs -> bs , lenientUrl :: bs -> bs , lenient :: bs -> bs- , correct :: bs -> Bool- , correctUrl :: bs -> Bool- , validate :: bs -> Bool- , validateUrl :: bs -> Bool+ , parse :: bs -> Either Text (Base64 'StdPadded bs)+ , parseUrlPad :: bs -> Either Text (Base64 'UrlPadded bs)+ , parseUrlNopad :: bs -> Either Text (Base64 'UrlUnpadded bs) } @@ -78,108 +84,126 @@ b64 = Harness { label = "ByteString" , encode = B64.encodeBase64'- , decode = B64.decodeBase64+ , decode = B64.decodeBase64Untyped+ , decodeTyped = B64.decodeBase64 , lenient = B64.decodeBase64Lenient- , correct = B64.isBase64- , validate = B64.isValidBase64+ , parse = B64.parseBase64 , encodeUrl = B64U.encodeBase64' , encodeUrlNopad = B64U.encodeBase64Unpadded'- , decodeUrl = B64U.decodeBase64- , decodeUrlPad = B64U.decodeBase64Padded- , decodeUrlNopad = B64U.decodeBase64Unpadded+ , decodeUrl = B64U.decodeBase64Untyped+ , decodeUrlPad = B64U.decodeBase64PaddedUntyped+ , decodeUrlNopad = B64U.decodeBase64UnpaddedUntyped+ , decodeUrlTyped = B64U.decodeBase64+ , decodeUrlTypedPad = B64U.decodeBase64Padded+ , decodeUrlTypedNopad = B64U.decodeBase64Unpadded , lenientUrl = B64U.decodeBase64Lenient- , correctUrl = B64U.isBase64Url- , validateUrl = B64U.isValidBase64Url+ , parseUrlPad = B64U.parseBase64Padded+ , parseUrlNopad = B64U.parseBase64Unpadded } lb64 :: Harness LBS.ByteString lb64 = Harness { label = "Lazy ByteString" , encode = LB64.encodeBase64'- , decode = LB64.decodeBase64+ , decode = LB64.decodeBase64Untyped+ , decodeTyped = LB64.decodeBase64 , lenient = LB64.decodeBase64Lenient- , correct = LB64.isBase64- , validate = LB64.isValidBase64+ , parse = LB64.parseBase64 , encodeUrl = LB64U.encodeBase64' , encodeUrlNopad = LB64U.encodeBase64Unpadded'- , decodeUrl = LB64U.decodeBase64- , decodeUrlPad = LB64U.decodeBase64Padded- , decodeUrlNopad = LB64U.decodeBase64Unpadded+ , decodeUrl = LB64U.decodeBase64Untyped+ , decodeUrlPad = LB64U.decodeBase64PaddedUntyped+ , decodeUrlNopad = LB64U.decodeBase64UnpaddedUntyped+ , decodeUrlTyped = LB64U.decodeBase64+ , decodeUrlTypedPad = LB64U.decodeBase64Padded+ , decodeUrlTypedNopad = LB64U.decodeBase64Unpadded , lenientUrl = LB64U.decodeBase64Lenient- , correctUrl = LB64U.isBase64Url- , validateUrl = LB64U.isValidBase64Url+ , parseUrlPad = LB64U.parseBase64Padded+ , parseUrlNopad = LB64U.parseBase64Unpadded } sb64 :: Harness SBS.ShortByteString sb64 = Harness { label = "Short ByteString" , encode = SB64.encodeBase64'- , decode = SB64.decodeBase64+ , decode = SB64.decodeBase64Untyped+ , decodeTyped = SB64.decodeBase64 , lenient = SB64.decodeBase64Lenient- , correct = SB64.isBase64- , validate = SB64.isValidBase64+ , parse = SB64.parseBase64 , encodeUrl = SB64U.encodeBase64' , encodeUrlNopad = SB64U.encodeBase64Unpadded'- , decodeUrl = SB64U.decodeBase64- , decodeUrlPad = SB64U.decodeBase64Padded- , decodeUrlNopad = SB64U.decodeBase64Unpadded+ , decodeUrl = SB64U.decodeBase64Untyped+ , decodeUrlPad = SB64U.decodeBase64PaddedUntyped+ , decodeUrlNopad = SB64U.decodeBase64UnpaddedUntyped+ , decodeUrlTyped = SB64U.decodeBase64+ , decodeUrlTypedPad = SB64U.decodeBase64Padded+ , decodeUrlTypedNopad = SB64U.decodeBase64Unpadded , lenientUrl = SB64U.decodeBase64Lenient- , correctUrl = SB64U.isBase64Url- , validateUrl = SB64U.isValidBase64Url+ , parseUrlPad = SB64U.parseBase64Padded+ , parseUrlNopad = SB64U.parseBase64Unpadded } t64 :: Harness Text t64 = Harness { label = "Text" , encode = T64.encodeBase64- , decode = T64.decodeBase64+ , decode = T64.decodeBase64Untyped+ , decodeTyped = T64.decodeBase64 , lenient = T64.decodeBase64Lenient- , correct = T64.isBase64- , validate = T64.isValidBase64+ , parse = T64.parseBase64 , encodeUrl = T64U.encodeBase64 , encodeUrlNopad = T64U.encodeBase64Unpadded- , decodeUrl = T64U.decodeBase64- , decodeUrlPad = T64U.decodeBase64Padded- , decodeUrlNopad = T64U.decodeBase64Unpadded+ , decodeUrl = T64U.decodeBase64Untyped+ , decodeUrlPad = T64U.decodeBase64PaddedUntyped+ , decodeUrlNopad = T64U.decodeBase64UnpaddedUntyped+ , decodeUrlTyped = T64U.decodeBase64+ , decodeUrlTypedPad = T64U.decodeBase64Padded+ , decodeUrlTypedNopad = T64U.decodeBase64Unpadded , lenientUrl = T64U.decodeBase64Lenient- , correctUrl = T64U.isBase64Url- , validateUrl = T64U.isValidBase64Url+ , parseUrlPad = T64U.parseBase64Padded+ , parseUrlNopad = T64U.parseBase64Unpadded } tl64 :: Harness TL.Text tl64 = Harness { label = "Lazy Text" , encode = TL64.encodeBase64- , decode = TL64.decodeBase64+ , decode = TL64.decodeBase64Untyped+ , decodeTyped = TL64.decodeBase64 , lenient = TL64.decodeBase64Lenient- , correct = TL64.isBase64- , validate = TL64.isValidBase64+ , parse = TL64.parseBase64 , encodeUrl = TL64U.encodeBase64 , encodeUrlNopad = TL64U.encodeBase64Unpadded- , decodeUrl = TL64U.decodeBase64- , decodeUrlPad = TL64U.decodeBase64Padded- , decodeUrlNopad = TL64U.decodeBase64Unpadded+ , decodeUrl = TL64U.decodeBase64Untyped+ , decodeUrlPad = TL64U.decodeBase64PaddedUntyped+ , decodeUrlNopad = TL64U.decodeBase64UnpaddedUntyped+ , decodeUrlTyped = TL64U.decodeBase64+ , decodeUrlTypedPad = TL64U.decodeBase64Padded+ , decodeUrlTypedNopad = TL64U.decodeBase64Unpadded , lenientUrl = TL64U.decodeBase64Lenient- , correctUrl = TL64U.isBase64Url- , validateUrl = TL64U.isValidBase64Url+ , parseUrlPad = TL64U.parseBase64Padded+ , parseUrlNopad = TL64U.parseBase64Unpadded } ts64 :: Harness TS.ShortText ts64 = Harness { label = "Short Text" , encode = TS64.encodeBase64- , decode = TS64.decodeBase64+ , decode = TS64.decodeBase64Untyped+ , decodeTyped = TS64.decodeBase64 , lenient = TS64.decodeBase64Lenient- , correct = TS64.isBase64- , validate = TS64.isValidBase64+ , parse = TS64.parseBase64 , encodeUrl = TS64U.encodeBase64 , encodeUrlNopad = TS64U.encodeBase64Unpadded- , decodeUrl = TS64U.decodeBase64- , decodeUrlPad = TS64U.decodeBase64Padded- , decodeUrlNopad = TS64U.decodeBase64Unpadded+ , decodeUrl = TS64U.decodeBase64Untyped+ , decodeUrlPad = TS64U.decodeBase64PaddedUntyped+ , decodeUrlNopad = TS64U.decodeBase64UnpaddedUntyped+ , decodeUrlTyped = TS64U.decodeBase64+ , decodeUrlTypedPad = TS64U.decodeBase64Padded+ , decodeUrlTypedNopad = TS64U.decodeBase64Unpadded , lenientUrl = TS64U.decodeBase64Lenient- , correctUrl = TS64U.isBase64Url- , validateUrl = TS64U.isValidBase64Url+ , parseUrlPad = TS64U.parseBase64Padded+ , parseUrlNopad = TS64U.parseBase64Unpadded } -- -------------------------------------------------------------------- --@@ -194,26 +218,26 @@ tt64 :: TextHarness BS.ByteString Text tt64 = TextHarness- { decodeWith_ = T64.decodeBase64With- , decodeUrlWith_ = T64U.decodeBase64With- , decodeUrlPaddedWith_ = T64U.decodeBase64PaddedWith- , decodeUrlUnpaddedWith_ = T64U.decodeBase64UnpaddedWith+ { decodeWith_ = T64.decodeBase64UntypedWith+ , decodeUrlWith_ = T64U.decodeBase64UntypedWith+ , decodeUrlPaddedWith_ = T64U.decodeBase64PaddedUntypedWith+ , decodeUrlUnpaddedWith_ = T64U.decodeBase64UnpaddedUntypedWith } ttl64 :: TextHarness LBS.ByteString TL.Text ttl64 = TextHarness- { decodeWith_ = TL64.decodeBase64With- , decodeUrlWith_ = TL64U.decodeBase64With- , decodeUrlPaddedWith_ = TL64U.decodeBase64PaddedWith- , decodeUrlUnpaddedWith_ = TL64U.decodeBase64UnpaddedWith+ { decodeWith_ = TL64.decodeBase64UntypedWith+ , decodeUrlWith_ = TL64U.decodeBase64UntypedWith+ , decodeUrlPaddedWith_ = TL64U.decodeBase64PaddedUntypedWith+ , decodeUrlUnpaddedWith_ = TL64U.decodeBase64UnpaddedUntypedWith } tts64 :: TextHarness SBS.ShortByteString TS.ShortText tts64 = TextHarness- { decodeWith_ = TS64.decodeBase64With- , decodeUrlWith_ = TS64U.decodeBase64With- , decodeUrlPaddedWith_ = TS64U.decodeBase64PaddedWith- , decodeUrlUnpaddedWith_ = TS64U.decodeBase64UnpaddedWith+ { decodeWith_ = TS64.decodeBase64UntypedWith+ , decodeUrlWith_ = TS64U.decodeBase64UntypedWith+ , decodeUrlPaddedWith_ = TS64U.decodeBase64PaddedUntypedWith+ , decodeUrlUnpaddedWith_ = TS64U.decodeBase64UnpaddedUntypedWith } -- ------------------------------------------------------------------ --@@ -241,12 +265,12 @@ coarbitrary = coarbitrary . SBS.unpack instance Arbitrary T.Text where- arbitrary = T.pack <$> arbitrary- shrink xs = T.pack <$> shrink (T.unpack xs)+ arbitrary = T.pack . getUnicodeString <$> arbitrary+ shrink xs = T.pack . getUnicodeString <$> shrink (UnicodeString $ T.unpack xs) instance Arbitrary TL.Text where- arbitrary = TL.pack <$> arbitrary- shrink xs = TL.pack <$> shrink (TL.unpack xs)+ arbitrary = TL.pack . getUnicodeString <$> arbitrary+ shrink xs = TL.pack . getUnicodeString <$> shrink (UnicodeString $ TL.unpack xs) instance CoArbitrary T.Text where coarbitrary = coarbitrary . T.unpack@@ -256,7 +280,7 @@ instance Arbitrary TS.ShortText where arbitrary = TS.fromText <$> arbitrary- shrink xs = fmap TS.fromText $ shrink (TS.toText xs)+ shrink xs = TS.fromText <$> shrink (TS.toText xs) instance CoArbitrary TS.ShortText where coarbitrary = coarbitrary . TS.toText
test/Main.hs view
@@ -1,10 +1,13 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-} -- | -- Module : Main--- Copyright : (c) 2019-2020 Emily Pillmore+-- Copyright : (c) 2019-2026 Emily Pillmore -- License : BSD-style -- -- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>@@ -20,6 +23,8 @@ import Prelude hiding (length) +import Data.Base64.Types+ import Data.Bifunctor (second) import qualified Data.ByteString as BS import Data.ByteString.Internal (c2w)@@ -29,6 +34,7 @@ import "base64" Data.ByteString.Base64.URL as B64U import qualified "base64-bytestring" Data.ByteString.Base64 as Bos import qualified "base64-bytestring" Data.ByteString.Base64.URL as BosU+import Data.Either (isLeft) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Text.Encoding.Base64.Error (Base64Error(..))@@ -38,11 +44,12 @@ import Data.Word import Internal+import qualified Simd import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck (testProperty)-import Data.String (IsString)+import Data.String (IsString, fromString) import Test.QuickCheck hiding (label) @@ -51,8 +58,13 @@ tests :: TestTree-tests = testGroup "Base64 Tests"- [ mkTree b64+#ifdef BASE64_SIMD+tests = testGroup "Base64 Tests (simd enabled)"+#else+tests = testGroup "Base64 Tests (scalar)"+#endif+ [ Simd.tests+ , mkTree b64 [ mkPropTree , mkUnitTree BS.last BS.length ]@@ -80,6 +92,9 @@ , mkDecodeTree (second TS.fromText . T.decodeUtf8' . SBS.fromShort) tts64 sb64 ]+ , parseRepresentationTests+ , urlParseRepresentationTests+ , parserCoherenceTests ] -- ---------------------------------------------------------------- --@@ -118,7 +133,8 @@ mkPropTree :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree mkPropTree = mkTests "Property Tests" [ prop_roundtrip- , prop_correctness+ , prop_parse+ , prop_parse_url , prop_url_padding , const prop_bos_coherence ]@@ -135,8 +151,9 @@ [ paddingTests last_ length_ , rfcVectors , offsetVectors- , validityTests+ , urlParseTests , canonicityTests+ , parseTests ] -- | Make unit tests for textual 'decode*With' functions@@ -163,58 +180,335 @@ prop_roundtrip :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_roundtrip Harness{..} = testGroup "prop_roundtrip"- [ testProperty "prop_std_roundtrip" $ \(bs :: b) ->- Right (encode bs) == decode (encode (encode bs))- , testProperty "prop_url_roundtrip" $ \(bs :: b) ->- Right (encodeUrl bs) == decodeUrl (encodeUrl (encodeUrl bs))- , testProperty "prop_url_roundtrip_nopad" $ \(bs :: b) ->- Right (encodeUrlNopad bs)- == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))- , testProperty "prop_std_lenient_roundtrip" $ \(bs :: b) ->- encode bs == lenient (encode (encode bs))- , testProperty "prop_url_lenient_roundtrip" $ \(bs :: b) ->- encodeUrl bs == lenientUrl (encodeUrl (encodeUrl bs))+ [ testProperty "prop_std_roundtrip" $ \(bs :: a) ->+ Right bs == decode (extractBase64 $ encode bs)+ , testProperty "prop_url_roundtrip" $ \(bs :: a) ->+ Right bs == decodeUrl (extractBase64 $ encodeUrl bs)+ , testProperty "prop_url_roundtrip_nopad" $ \(bs :: a) ->+ Right bs+ == decodeUrlNopad (extractBase64 $ encodeUrlNopad bs)+ , testProperty "prop_std_lenient_roundtrip" $ \(bs :: a) ->+ bs == lenient (extractBase64 $ encode bs)+ , testProperty "prop_url_lenient_roundtrip" $ \(bs :: a) ->+ bs == lenientUrl (extractBase64 $ encodeUrl bs) ] -prop_correctness :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree-prop_correctness Harness{..} = testGroup "prop_validity"- [ testProperty "prop_std_valid" $ \(bs :: b) ->- validate (encode bs)- , testProperty "prop_url_valid" $ \(bs :: b) ->- validateUrl (encodeUrl bs)- , testProperty "prop_std_correct" $ \(bs :: b) ->- correct (encode bs)- , testProperty "prop_url_correct" $ \(bs :: b) ->- correctUrl (encodeUrl bs)+prop_parse :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree+prop_parse Harness{..} = testGroup "Parsing properties"+ [ testProperty "parse an encoded value" $ \(bs :: a) ->+ parse (extractBase64 $ encode bs) === Right (encode bs)+ , testProperty "decode a parsed value" $ \(bs :: a) ->+ fmap decodeTyped (parse $ extractBase64 $ encode bs) === Right bs+ , testProperty "preserve the encoded input" $ \(bs :: a) ->+ case parse bs of+ Left _ -> property True+ Right encoded -> extractBase64 encoded === bs+ , testProperty "agree with untyped decoding errors" $ \(bs :: a) ->+ -- Discard the decoded payload without forcing a possible UTF-8 conversion.+ (() <$ parse bs) === (() <$ decode bs) ] +parseTests :: (IsString a, Eq a, Show a) => Harness a -> TestTree+parseTests Harness{..} = testGroup "Parsing unit tests"+ [ testGroup "Preserve valid encoded values"+ [ testCase (show input) $+ parse input @?= Right (assertBase64 input)+ | input <- [ "", "Zg==", "Zm8=", "Zm9v", "Zm9vYg=="+ , "Zm9vYmE=", "Zm9vYmFy", "PDw/Pz4+"+ , "/w==" -- Valid Base64 whose decoded byte is not valid UTF-8.+ ]+ ]+ , testGroup "Reject malformed and non-canonical values"+ [ testCase (show input) $ parse input @?= Left err+ | (input, err) <-+ [ ("Z", "Base64-encoded bytestring has invalid size")+ , ("Zg", "Base64-encoded bytestring requires padding")+ , ("Zm8", "Base64-encoded bytestring requires padding")+ , ("Zg===", "Base64-encoded bytestring has invalid size")+ , ("====", "invalid padding near offset: 0")+ , ("A===", "invalid padding near offset: 1")+ , ("AA=A", "invalid base64 encoding near offset: 3")+ , ("Zg==AAAA", "invalid padding near offset: 2")+ , ("Zm8=AAAA", "invalid padding near offset: 3")+ , ("%AAA", "invalid base64 encoding near offset: 0")+ , ("A%AA", "invalid base64 encoding near offset: 1")+ , ("AA%A", "invalid base64 encoding near offset: 2")+ , ("AAA%", "invalid base64 encoding near offset: 3")+ , ("AAAA%AAA", "invalid base64 encoding near offset: 4")+ , ("PDw_", "invalid base64 encoding near offset: 3")+ , ("PDw-", "invalid base64 encoding near offset: 3")+ , ("AAA ", "invalid base64 encoding near offset: 3")+ , ("AAA\n", "invalid base64 encoding near offset: 3")+ , ("ZE==", "non-canonical encoding detected at offset: 1")+ , ("ZmC=", "non-canonical encoding detected at offset: 2")+ , ("Zm9vYE==", "non-canonical encoding detected at offset: 5")+ , ("Zm9vYmC=", "non-canonical encoding detected at offset: 6")+ ]+ ]+ , testCase "reject non-ASCII input" $+ assertBool "non-ASCII input was accepted" $+ isLeft (parse "\255\255\255\255")+ ]++parseRepresentationTests :: TestTree+parseRepresentationTests = testGroup "Parsing representations"+ [ testProperty "parse sliced ByteStrings" $ \bs ->+ let input = extractBase64 (B64.encodeBase64' bs)+ sliced = BS.take (BS.length input) $ BS.drop 2 ("!!" <> input <> "!!")+ in B64.parseBase64 sliced === Right (assertBase64 input)+ , testCase "error offsets are relative to the ByteString slice" $+ B64.parseBase64 (BS.take 4 $ BS.drop 2 "!!AA%A!!")+ @?= Left "invalid base64 encoding near offset: 2"+ , testGroup "Lazy ByteString chunk boundaries"+ [ testCase (show (input, n)) $+ let chunks = [BS.take n input, BS.drop n input]+ bytes = LBS.fromChunks chunks+ in fmap (fmap LBS.toStrict) (parse lb64 bytes)+ @?= B64.parseBase64 input+ | input <- ["Zg==", "Zm9vYmFy", "Zg==AAAA", "Zm9vYmC=", "Zg", "AAAA%AAA"]+ , n <- [0 .. BS.length input]+ ]+ , testGroup "Lazy Text chunk boundaries"+ [ testCase (show (input, n)) $+ let chunks = [T.take n input, T.drop n input]+ txt = TL.fromChunks chunks+ in fmap (fmap TL.toStrict) (parse tl64 txt)+ @?= parse t64 input+ | input <- ["Zg==", "Zm9vYmFy", "Zg==AAAA", "Zm9vYmC=", "Zg", "AAAA%AAA"]+ , n <- [0 .. T.length input]+ ]+ , testCase "preserve lazy ByteString chunks, including split padding" $ do+ let chunks = ["Z", "g=", "="]+ fmap (LBS.toChunks . extractBase64) (parse lb64 $ LBS.fromChunks chunks)+ @?= Right chunks+ , testCase "preserve lazy Text chunks, including split padding" $ do+ let chunks = ["Z", "g=", "="]+ fmap (TL.toChunks . extractBase64) (parse tl64 $ TL.fromChunks chunks)+ @?= Right chunks+ ]++prop_parse_url :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree+prop_parse_url Harness{..} = testGroup "URL parsing properties"+ [ parserProperties "padded" parseUrlPad encodeUrl decodeUrlTypedPad decodeUrlPad+ , parserProperties "unpadded" parseUrlNopad encodeUrlNopad decodeUrlTypedNopad decodeUrlNopad+ ]+ where+ parserProperties name parser encoder decoder untyped = testGroup name+ [ testProperty "parse an encoded value" $ \bs ->+ parser (extractBase64 $ encoder bs) === Right (encoder bs)+ , testProperty "decode a parsed value" $ \bs ->+ fmap decoder (parser $ extractBase64 $ encoder bs) === Right bs+ , testProperty "preserve arbitrary accepted input" $ \bs ->+ case parser bs of+ Left _ -> property True+ Right encoded -> extractBase64 encoded === bs+ , testProperty "agree with untyped decoding errors" $ \bs ->+ -- Do not force a possible UTF-8 conversion of the decoded payload.+ (() <$ parser bs) === (() <$ untyped bs)+ , testProperty "validate arbitrary alphabet and padding combinations" $+ forAll (listOf $ elements "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_=+/% \n") $ \s ->+ let input = fromString s+ in (extractBase64 <$> parser input) === (input <$ untyped input)+ ]++urlParseTests :: (IsString a, Eq a, Show a) => Harness a -> TestTree+urlParseTests Harness{..} = testGroup "URL parsing unit tests"+ [ testGroup "Preserve valid padded values"+ [ testCase (show input) $ parseUrlPad input @?= Right (assertBase64 input)+ | input <- ["", "Zg==", "Zm8=", "Zm9v", "Zm9vYg==", "Zm9vYmE=", "Zm9vYmFy"+ , "PDw_Pj4=", "PDw_Pz4-", "_w==", "-_8=", "PA==", "PDw=", "PDw_"+ , "ZA==", "ZmA=", "Zm9vYmA="]+ ]+ , testGroup "Preserve valid unpadded values"+ [ testCase (show input) $ parseUrlNopad input @?= Right (assertBase64 input)+ | input <- ["", "Zg", "Zm8", "Zm9v", "Zm9vYg", "Zm9vYmE", "Zm9vYmFy"+ , "PDw_Pj4", "PDw_Pz4-", "_w", "-_8", "PA", "PDw", "PDw_"+ , "ZA", "ZmA", "Zm9vYmA"]+ ]+ , testGroup "Require complete padding for UrlPadded"+ [ testCase (show input) $+ parseUrlPad input @?= Left "Base64-encoded bytestring requires padding"+ | input <- ["Zg", "Zm8", "Zg=", "PDw_Pj4"]+ ]+ , testGroup "Reject padding for UrlUnpadded"+ [ testCase (show input) $+ parseUrlNopad input @?= Left "Base64-encoded bytestring has invalid padding"+ | input <- ["Zg==", "Zm8=", "Zg=", "==", "====", "PDw_Pj4="]+ ]+ , testGroup "Reject malformed values in both modes"+ [ testGroup name+ [ testCase (show input) $ parser input @?= Left err+ | (input, err) <-+ [ ("Z", "Base64-encoded bytestring has invalid size")+ , ("Zg===", "Base64-encoded bytestring has invalid size")+ , ("AA=A", "invalid base64 encoding near offset: 3")+ , ("Zg==AAAA", "invalid padding near offset: 2")+ , ("Zm8=AAAA", "invalid padding near offset: 3")+ , ("%AAA", "invalid base64 encoding near offset: 0")+ , ("A%AA", "invalid base64 encoding near offset: 1")+ , ("AA%A", "invalid base64 encoding near offset: 2")+ , ("AAA%", "invalid base64 encoding near offset: 3")+ , ("AAAA%AAA", "invalid base64 encoding near offset: 4")+ , ("PDw/", "invalid base64 encoding near offset: 3")+ , ("PDw+", "invalid base64 encoding near offset: 3")+ , ("AAA ", "invalid base64 encoding near offset: 3")+ , ("AAA\n", "invalid base64 encoding near offset: 3")+ ]+ ]+ | (name, parser) <- [("padded", fmap extractBase64 . parseUrlPad)+ , ("unpadded", fmap extractBase64 . parseUrlNopad)]+ ]+ , testGroup "Reject invalid padded quanta"+ [ testCase (show input) $ parseUrlPad input @?= Left err+ | (input, err) <- [("====", "invalid padding near offset: 0")+ , ("A===", "invalid padding near offset: 1")]+ ]+ , testGroup "Reject non-canonical values in both modes"+ [ testCase (show (padded, unpadded)) $ do+ parseUrlPad padded @?= Left err+ parseUrlNopad unpadded @?= Left err+ | (padded, unpadded, err) <-+ [ ("ZE==", "ZE", "non-canonical encoding detected at offset: 1")+ , ("ZK==", "ZK", "non-canonical encoding detected at offset: 1")+ , ("ZmC=", "ZmC", "non-canonical encoding detected at offset: 2")+ , ("ZmD=", "ZmD", "non-canonical encoding detected at offset: 2")+ , ("_x==", "_x", "non-canonical encoding detected at offset: 1")+ , ("-_9=", "-_9", "non-canonical encoding detected at offset: 2")+ , ("Zm9vYE==", "Zm9vYE", "non-canonical encoding detected at offset: 5")+ , ("Zm9vYmC=", "Zm9vYmC", "non-canonical encoding detected at offset: 6")+ ]+ ]+ , testCase "reject non-ASCII input in both modes" $ do+ assertBool "padded parser accepted non-ASCII input" $+ isLeft (parseUrlPad "\255\255\255\255")+ assertBool "unpadded parser accepted non-ASCII input" $+ isLeft (parseUrlNopad "\255\255\255\255")+ ]++urlParseRepresentationTests :: TestTree+urlParseRepresentationTests = testGroup "URL parsing representations"+ [ testGroup name+ [ testProperty "parse sliced ByteStrings" $ \bs ->+ let input = encoder bs+ sliced = BS.take (BS.length input) $ BS.drop 2 ("!!" <> input <> "!!")+ in parser sliced === Right input+ , testCase "error offsets are relative to the ByteString slice" $+ parser (BS.take 4 $ BS.drop 2 "!!AA%A!!")+ @?= Left "invalid base64 encoding near offset: 2"+ , testGroup "Lazy ByteString chunk boundaries"+ [ testCase (show (input, n)) $+ let splitChunks = [BS.take n input, BS.drop n input]+ in fmap LBS.toStrict (lazyParser $ LBS.fromChunks splitChunks) @?= parser input+ | input <- inputs+ , n <- [0 .. BS.length input]+ ]+ , testGroup "Lazy Text chunk boundaries"+ [ testCase (show (input, n)) $+ let txt = T.decodeUtf8 input+ splitChunks = [T.take n txt, T.drop n txt]+ in fmap TL.toStrict (lazyTextParser $ TL.fromChunks splitChunks) @?= textParser txt+ | input <- inputs+ , n <- [0 .. BS.length input]+ ]+ , testCase "preserve lazy ByteString chunks" $+ fmap LBS.toChunks (lazyParser $ LBS.fromChunks chunks) @?= Right chunks+ , testCase "preserve lazy Text chunks" $+ let textChunks = fmap T.decodeUtf8 chunks+ in fmap TL.toChunks (lazyTextParser $ TL.fromChunks textChunks) @?= Right textChunks+ ]+ | (name, encoder, parser, lazyParser, textParser, lazyTextParser, chunks) <-+ [ ("padded", extractBase64 . B64U.encodeBase64'+ , fmap extractBase64 . parseUrlPad b64, fmap extractBase64 . parseUrlPad lb64+ , fmap extractBase64 . parseUrlPad t64, fmap extractBase64 . parseUrlPad tl64+ , ["_", "w=", "="])+ , ("unpadded", extractBase64 . B64U.encodeBase64Unpadded'+ , fmap extractBase64 . parseUrlNopad b64, fmap extractBase64 . parseUrlNopad lb64+ , fmap extractBase64 . parseUrlNopad t64, fmap extractBase64 . parseUrlNopad tl64+ , ["P", "Dw_", "Pj4"])+ ]+ ]+ where+ inputs =+ [ "", "_w==", "_w", "PDw_Pj4=", "PDw_Pj4", "PDw_Pz4-", "Zg==AAAA"+ , "Zm9vYmC=", "Zm9vYmC", "Zg=", "A", "AAAA%AAA", "AA=A", "===="+ , BS.replicate 64 65 <> "-_8=", BS.replicate 64 65 <> "-_8"+ , BS.replicate 64 65 <> "AA%A", BS.replicate 64 65 <> "-_9="+ ]++parserCoherenceTests :: TestTree+parserCoherenceTests = testGroup "Parser consistency across all representations"+ [ testProperty name $+ forAll (listOf $ resize 8 $ listOf1 $ elements alphabet) $ \chunks ->+ let textChunks = fmap T.pack chunks+ byteChunks = fmap T.encodeUtf8 textChunks+ textInput = T.concat textChunks+ byteInput = BS.concat byteChunks+ expected = strictBytes byteInput+ in conjoin+ [ counterexample "lazy ByteString" $+ (LBS.toStrict <$> lazyBytes (LBS.fromChunks byteChunks)) === expected+ , counterexample "short ByteString" $+ (SBS.fromShort <$> shortBytes (SBS.toShort byteInput)) === expected+ , counterexample "strict Text" $+ (T.encodeUtf8 <$> strictText textInput) === expected+ , counterexample "lazy Text" $+ (T.encodeUtf8 . TL.toStrict <$> lazyText (TL.fromChunks textChunks)) === expected+ , counterexample "short Text" $+ (TS.toByteString <$> shortText (TS.fromText textInput)) === expected+ ]+ | (name, strictBytes, lazyBytes, shortBytes, strictText, lazyText, shortText) <-+ [ ("standard padded"+ , fmap extractBase64 . parse b64, fmap extractBase64 . parse lb64+ , fmap extractBase64 . parse sb64, fmap extractBase64 . parse t64+ , fmap extractBase64 . parse tl64, fmap extractBase64 . parse ts64)+ , ("URL padded"+ , fmap extractBase64 . parseUrlPad b64, fmap extractBase64 . parseUrlPad lb64+ , fmap extractBase64 . parseUrlPad sb64, fmap extractBase64 . parseUrlPad t64+ , fmap extractBase64 . parseUrlPad tl64, fmap extractBase64 . parseUrlPad ts64)+ , ("URL unpadded"+ , fmap extractBase64 . parseUrlNopad b64, fmap extractBase64 . parseUrlNopad lb64+ , fmap extractBase64 . parseUrlNopad sb64, fmap extractBase64 . parseUrlNopad t64+ , fmap extractBase64 . parseUrlNopad tl64, fmap extractBase64 . parseUrlNopad ts64)+ ]+ ]+ where+ alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=_-% \n\255\955\128512"+ prop_url_padding :: (Arbitrary a, IsString a, Eq a, Show a) => Harness a -> TestTree prop_url_padding Harness{..} = testGroup "prop_url_padding"- [ testProperty "prop_url_nopad_roundtrip" $ \(bs :: b) ->- Right (encodeUrlNopad bs)- == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))-- , testProperty "prop_url_pad_roundtrip" $ \(bs :: b) ->- Right (encodeUrl bs) == decodeUrlPad (encodeUrl (encodeUrl bs))+ [ testProperty "prop_url_nopad_roundtrip_untyped" $ \(bs :: a) ->+ Right bs+ == decodeUrlNopad (extractBase64 $ encodeUrlNopad bs)+ , testProperty "prop_url_nopad_roundtrip_typed" $ \(bs :: a) ->+ bs == decodeUrlTypedNopad (encodeUrlNopad bs)+ , testProperty "prop_url_pad_roundtrip_untyped" $ \(bs :: a) ->+ Right bs == decodeUrlPad (extractBase64 $ encodeUrl bs)+ , testProperty "prop_url_pad_roundtrip_typed" $ \(bs :: a) ->+ bs == decodeUrlTypedPad (encodeUrl bs)+ , testProperty "prop_url_decode_invariant_untyped" $ \(bs :: a) ->+ (decodeUrlNopad (extractBase64 $ encodeUrlNopad bs)+ == decodeUrl (extractBase64 $ encodeUrlNopad bs))+ ||+ (decodeUrlPad (extractBase64 $ encodeUrl bs)+ == decodeUrl (extractBase64 $ encodeUrl bs)) - , testProperty "prop_url_decode_invariant" $ \(bs :: b) ->- ( decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))- == decodeUrl (encodeUrl (encodeUrl bs))- ) ||- ( decodeUrlPad (encodeUrl (encodeUrl bs))- == decodeUrl (encodeUrl (encodeUrl bs))- )+ , testProperty "prop_url_decode_invariant_typed" $ \(bs :: a) ->+ (decodeUrlTypedNopad (encodeUrlNopad bs)+ == decodeUrlTyped (encodeUrlNopad bs))+ ||+ (decodeUrlPad (extractBase64 $ encodeUrl bs)+ == decodeUrl (extractBase64 $ encodeUrl bs)) -- NOTE: we need to fix the bitmasking issue for "impossible" -- inputs - , testProperty "prop_url_padding_coherence" $ \(bs :: b) ->- Right (encodeUrl bs) == decodeUrl (encodeUrl (encodeUrl bs))- && Right (encodeUrl bs) == decodeUrlPad (encodeUrl (encodeUrl bs))+ , testProperty "prop_url_padding_coherence" $ \(bs :: a) ->+ Right bs == decodeUrl (extractBase64 $ encodeUrl bs)+ && Right bs == decodeUrlPad (extractBase64 $ encodeUrl bs) - , testProperty "prop_url_nopadding_coherence" $ \(bs :: b) ->- Right (encodeUrlNopad bs) == decodeUrlNopad (encodeUrlNopad (encodeUrlNopad bs))- && Right (encodeUrlNopad bs) == decodeUrl (encodeUrlNopad (encodeUrlNopad bs))+ , testProperty "prop_url_nopadding_coherence" $ \(bs :: a) ->+ Right bs == decodeUrlNopad (extractBase64 $ encodeUrlNopad bs)+ && Right bs == decodeUrl (extractBase64 $ encodeUrlNopad bs) ] -- | just a sanity check against `base64-bytestring`@@ -222,11 +516,13 @@ prop_bos_coherence :: TestTree prop_bos_coherence = testGroup "prop_bos_coherence" [ testProperty "prop_std_bos_coherence" $ \bs ->- Right bs == B64.decodeBase64 (B64.encodeBase64' bs)+ Right bs == B64.decodeBase64Untyped (extractBase64 $ B64.encodeBase64' bs) && Right bs == Bos.decode (Bos.encode bs)+ && bs == B64.decodeBase64 (B64.encodeBase64' bs) , testProperty "prop_url_bos_coherence" $ \bs ->- Right bs == B64U.decodeBase64 (B64U.encodeBase64' bs)+ Right bs == B64U.decodeBase64Untyped (extractBase64 $ B64U.encodeBase64' bs) && Right bs == BosU.decode (BosU.encode bs)+ && bs == B64U.decodeBase64 (B64U.encodeBase64' bs) ] -- ---------------------------------------------------------------- --@@ -260,19 +556,31 @@ testCaseStd s t = testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do step "encode is sound"- t @=? encode s+ assertBase64 t @=? encode s - step "decode is sound"- Right s @=? decode (encode s)+ step "decode is sound - untyped"+ Right s @=? decode (extractBase64 $ encode s)+ Right s @=? decode t + step "decode is sound - typed"+ s @=? decodeTyped (encode s)+ s @=? decodeTyped (assertBase64 t)+ testCaseUrl s t = testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do step "encode is sound"- t @=? encodeUrl s+ assertBase64 t @=? encodeUrl s - step "decode is sound"- Right s @=? decodeUrlPad t+ step "decode is sound - untyped"+ Right s @=? decodeUrl (extractBase64 $ encodeUrl s)+ Right s @=? decodeUrl t + step "decode is sound - typed"+ s @=? decodeUrlTyped (encodeUrl s)+ s @=? decodeUrlTypedPad (encodeUrl s)+ s @=? decodeUrlTyped (assertBase64 @'UrlPadded t)+ s @=? decodeUrlTypedPad (assertBase64 @'UrlPadded t)+ -- | Url-safe padding unit tests (stresses entire alphabet) -- paddingTests@@ -361,29 +669,29 @@ offsetVectors Harness{..} = testGroup "Offset tests" [ testGroup "Invalid padding" [ testCase "Invalid staggered padding" $ do- decodeUrl "=A==" @=? Left "invalid padding at offset: 0"- decodeUrl "P===" @=? Left "invalid padding at offset: 1"+ decodeUrl "=A==" @=? Left "invalid padding near offset: 0"+ decodeUrl "P===" @=? Left "invalid padding near offset: 1" , testCase "Invalid character coverage - final chunk" $ do- decodeUrl "%D==" @=? Left "invalid character at offset: 0"- decodeUrl "P%==" @=? Left "invalid character at offset: 1"- decodeUrl "PD%=" @=? Left "invalid character at offset: 2"- decodeUrl "PA=%" @=? Left "invalid character at offset: 3"- decodeUrl "PDw%" @=? Left "invalid character at offset: 3"+ decodeUrl "%D==" @=? Left "invalid base64 encoding near offset: 0"+ decodeUrl "P%==" @=? Left "invalid base64 encoding near offset: 1"+ decodeUrl "PD%=" @=? Left "invalid base64 encoding near offset: 2"+ decodeUrl "PA=%" @=? Left "invalid base64 encoding near offset: 3"+ decodeUrl "PDw%" @=? Left "invalid base64 encoding near offset: 3" , testCase "Invalid character coverage - decode chunk" $ do- decodeUrl "%Dw_PDw_" @=? Left "invalid character at offset: 0"- decodeUrl "P%w_PDw_" @=? Left "invalid character at offset: 1"- decodeUrl "PD%_PDw_" @=? Left "invalid character at offset: 2"- decodeUrl "PDw%PDw_" @=? Left "invalid character at offset: 3"+ decodeUrl "%Dw_PDw_" @=? Left "invalid base64 encoding near offset: 0"+ decodeUrl "P%w_PDw_" @=? Left "invalid base64 encoding near offset: 1"+ decodeUrl "PD%_PDw_" @=? Left "invalid base64 encoding near offset: 2"+ decodeUrl "PDw%PDw_" @=? Left "invalid base64 encoding near offset: 3" , testCase "Invalid padding in body" $ do- decodeUrl "PD=_PDw_" @=? Left "invalid padding at offset: 2"- decodeUrl "PDw=PDw_" @=? Left "invalid padding at offset: 3"+ decodeUrl "PD=_PDw_" @=? Left "invalid padding near offset: 2"+ decodeUrl "PDw=PDw_" @=? Left "invalid padding near offset: 3" , testCase "Padding fails everywhere but end" $ do- decode "=eAoeAo=" @=? Left "invalid padding at offset: 0"- decode "e=AoeAo=" @=? Left "invalid padding at offset: 1"- decode "eA=oeAo=" @=? Left "invalid padding at offset: 2"- decode "eAo=eAo=" @=? Left "invalid padding at offset: 3"- decode "eAoe=Ao=" @=? Left "invalid padding at offset: 4"- decode "eAoeA=o=" @=? Left "invalid padding at offset: 5"+ decode "=eAoeAo=" @=? Left "invalid padding near offset: 0"+ decode "e=AoeAo=" @=? Left "invalid padding near offset: 1"+ decode "eA=oeAo=" @=? Left "invalid padding near offset: 2"+ decode "eAo=eAo=" @=? Left "invalid padding near offset: 3"+ decode "eAoe=Ao=" @=? Left "invalid padding near offset: 4"+ decode "eAoeA=o=" @=? Left "invalid padding near offset: 5" ] ] @@ -433,7 +741,7 @@ Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do- case decodeWith_ utf8 (encode h "\1079743") of+ case decodeWith_ utf8 (extractBase64 $ encode h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUrlWith non-utf8 inputs on decodeUtf8" $ do@@ -441,7 +749,7 @@ Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeUrlWith valid utf8 inputs on decodeUtf8" $ do- case decodeUrlWith_ utf8 (encodeUrl h "\1079743") of+ case decodeUrlWith_ utf8 (extractBase64 $ encodeUrl h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUrlPaddedWith non-utf8 inputs on decodeUtf8" $ do@@ -449,7 +757,7 @@ Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodePaddedWith valid utf8 inputs on decodeUtf8" $ do- case decodeUrlPaddedWith_ utf8 (encodeUrl h "\1079743") of+ case decodeUrlPaddedWith_ utf8 (extractBase64 $ encodeUrl h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" , testCase "decodeUnpaddedWith non-utf8 inputs on decodeUtf8" $ do@@ -457,7 +765,7 @@ Left (DecodeError _) -> return () _ -> assertFailure "decoding phase" , testCase "decodeUnpaddedWith valid utf8 inputs on decodeUtf8" $ do- case decodeUrlUnpaddedWith_ utf8 (encodeUrlNopad h "\1079743") of+ case decodeUrlUnpaddedWith_ utf8 (extractBase64 $ encodeUrlNopad h "\1079743") of Left (ConversionError _) -> return () _ -> assertFailure "conversion phase" ]@@ -478,60 +786,5 @@ a <- either (assertFailure . show) pure $ decodeUrlNopad t "PDw_Pz4-" b <- either (assertFailure . show) pure $ decodeUrlUnpaddedWith_ utf8 "PDw_Pz4-" a @=? b- ]- ]---- | Validity unit tests for the URL workflow----validityTests :: IsString a => Harness a -> TestTree-validityTests Harness{..} = testGroup "Validity and correctness unit tests"- [ testGroup "Validity unit tests"- [ testCase "Padding tests" $ do- not (validateUrl "P") @? "P"- validateUrl "PA" @? "PA"- validateUrl "PDw" @? "PDw"- validateUrl "PDw_" @? "PDw_"- validateUrl "PA==" @? "PA=="- validateUrl "PDw=" @? "PDw="- validateUrl "PDw_" @? "PDw_"-- , testCase "Canonicity tests" $ do- validateUrl "ZK==" @? "ZK=="- validateUrl "ZE==" @? "ZE=="-- validateUrl "ZA==" @? "ZA=="- validateUrl "ZK==" @? "ZK=="- validateUrl "ZK" @? "ZK"-- validateUrl "ZmA=" @? "ZmA="- validateUrl "ZmC=" @? "ZmC="- validateUrl "ZmE" @? "ZmE"-- validateUrl "Zm9vYmA=" @? "Zm9vYmA="- validateUrl "Zm9vYmC=" @? "Zm9vYmC="- validateUrl "Zm9vYmC" @? "Zm9vYmC"- ]- , testGroup "Correctness unit tests"- [ testCase "Padding tests" $ do- not (validateUrl "P") @? "P"- correctUrl "PA" @? "PA"- correctUrl "PDw" @? "PDw"- correctUrl "PDw_" @? "PDw_"- correctUrl "PA==" @? "PA=="- correctUrl "PDw=" @? "PDw="- correctUrl "PDw_" @? "PDw_"-- , testCase "Canonicity tests" $ do- not (correctUrl "ZK==") @? "ZK=="- not (correctUrl "ZE==") @? "ZE=="- correctUrl "ZA==" @? "ZA=="-- correctUrl "ZmA=" @? "ZmA="- not (correctUrl "ZmC=") @? "ZmC="- not (correctUrl "ZmD") @? "ZmD"-- correctUrl "Zm9vYmA=" @? "Zm9vYmA="- not (correctUrl "Zm9vYmC=") @? "Zm9vYmC="- not (correctUrl "Zm9vYmC") @? "Zm9vYmC" ] ]
+ test/Simd.hs view
@@ -0,0 +1,235 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+-- |+-- Module : Simd+-- Copyright : (c) 2026 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- Public API regressions shared by the scalar and optional SIMD builds.+-- Expected encodings come from an independent implementation, including for+-- typed decoding: matching mistakes in our encoder and decoder cannot cancel.+module Simd (tests) where++import Control.Monad (forM_)+import "base64" Data.Base64.Types (assertBase64, extractBase64)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import qualified "base64" Data.ByteString.Base64 as B64+import qualified "base64" Data.ByteString.Base64.URL as B64U+import qualified "base64-bytestring" Data.ByteString.Base64 as Bos+import qualified "base64-bytestring" Data.ByteString.Base64.URL as BosU+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Short as TS+import Data.Word (Word8)+import Internal (Harness(..), b64, lb64, sb64, t64, tl64, ts64)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (Assertion, assertEqual, testCase)+++tests :: TestTree+tests = testGroup "SIMD compatibility"+ [ testCase "vector boundaries and every slice alignment" $+ forM_ sizes $ \n ->+ forM_ [0 .. 31] $ \offset ->+ checkHarness (context n offset) b64 (sliceAt offset) (payload n)+ , testCase "every input byte across vector blocks" $+ forM_ [0 .. 255] $ \byte ->+ checkHarness ("repeated byte=" ++ show byte) b64+ (sliceAt (fromIntegral byte `mod` 32)) (BS.replicate 257 byte)+ , testCase "invalid characters retain absolute offsets" invalidCharacters+ , testCase "all high bytes are invalid in both alphabets" highBytes+ , testCase "padding and canonical tails after vector prefixes" paddingAndTails+ , testCase "padding errors precede invalid bytes in the same quartet" mixedErrors+ , testCase "lazy chunks split input and encoded quartets" lazyChunks+ , testCase "short bytestrings preserve large buffers and tails" $+ forM_ [0, 1, 2, 47, 48, 49, 127, 128, 129, 4096, 65536] $ \n ->+ checkHarness ("short length=" ++ show n) sb64 SBS.toShort (payload n)+ , testCase "Unicode text wrappers preserve long values and UTF-8" textWrappers+ ]+ where+ sizes = [0 .. 5]+ ++ concatMap (\n -> [n - 2 .. n + 2]) [12, 16, 24, 32, 48, 64, 96, 128, 192, 256]+ ++ [255, 256, 257, 4095, 4096, 4097, 65535, 65536, 65537]++-- The prefix and suffix are deliberately non-base64 bytes. Only the slice is+-- valid input, and its address varies independently of its logical contents.+sliceAt :: Int -> BS.ByteString -> BS.ByteString+sliceAt offset bytes = BS.take (BS.length bytes) . BS.drop offset $+ BS.replicate offset 0xe5 <> bytes <> BS.replicate 32 0xff++payload :: Int -> BS.ByteString+payload n = BS.pack (take n (cycle [0 .. 255]))++context :: Int -> Int -> String+context n offset = "length=" ++ show n ++ ", slice offset=" ++ show offset++checkHarness+ :: (Eq a, Show a)+ => String+ -> Harness a+ -> (BS.ByteString -> a)+ -> BS.ByteString+ -> Assertion+checkHarness note harness convert raw = do+ equal "standard encode" std (extractBase64 (encode harness input))+ equal "URL padded encode" url (extractBase64 (encodeUrl harness input))+ equal "URL unpadded encode" unpadded (extractBase64 (encodeUrlNopad harness input))+ equal "standard typed decode" input (decodeTyped harness (assertBase64 std))+ equal "standard untyped decode" (Right input) (decode harness std)+ equal "URL padded typed decode" input (decodeUrlTypedPad harness (assertBase64 url))+ equal "URL padded untyped decode" (Right input) (decodeUrlPad harness url)+ equal "URL unpadded typed decode" input+ (decodeUrlTypedNopad harness (assertBase64 unpadded))+ equal "URL unpadded untyped decode" (Right input) (decodeUrlNopad harness unpadded)+ equal "URL generic padded decode" (Right input) (decodeUrl harness url)+ equal "URL generic unpadded decode" (Right input) (decodeUrl harness unpadded)+ where+ input = convert raw+ std = convert (Bos.encode raw)+ url = convert (BosU.encode raw)+ unpadded = convert (BS.takeWhile (/= 61) (BosU.encode raw))+ equal name = assertEqual (note ++ ": " ++ name)++-- Exercise invalid bytes in every lane, across native block boundaries, and+-- well after a valid SIMD prefix. A valid suffix prevents tail-only coverage.+invalidCharacters :: Assertion+invalidCharacters =+ forM_ [0, 1, 15, 31] $ \offset ->+ forM_ positions $ \position -> do+ forM_ [35, 128, 255] $ \byte ->+ forM_ decoders $ \(name, decoder) ->+ checkInvalid name decoder offset position byte+ forM_ [45, 95] $ \byte ->+ checkInvalid "standard rejects URL alphabet" B64.decodeBase64Untyped+ offset position byte+ forM_ [43, 47] $ \byte ->+ forM_ urlDecoders $ \(name, decoder) ->+ checkInvalid name decoder offset position byte+ where+ positions = [0 .. 19] ++ [31 .. 33] ++ [47 .. 49] ++ [63 .. 65]+ ++ [95 .. 97] ++ [127 .. 129] ++ [191 .. 193] ++ [255 .. 257]+ ++ [511 .. 513] ++ [4095 .. 4097]++highBytes :: Assertion+highBytes =+ forM_ [128 .. 255] $ \byte ->+ forM_ [15, 16, 31, 32, 63, 64, 127, 255, 256, 4096] $ \position ->+ forM_ decoders $ \(name, decoder) ->+ checkInvalid name decoder (fromIntegral byte `mod` 32) position byte++type Decoder = BS.ByteString -> Either T.Text BS.ByteString++decoders :: [(String, Decoder)]+decoders = ("standard", B64.decodeBase64Untyped) : urlDecoders++urlDecoders :: [(String, Decoder)]+urlDecoders =+ [ ("URL padded", B64U.decodeBase64PaddedUntyped)+ , ("URL unpadded", B64U.decodeBase64UnpaddedUntyped)+ , ("URL generic", B64U.decodeBase64Untyped)+ ]++checkInvalid :: String -> Decoder -> Int -> Int -> Word8 -> Assertion+checkInvalid name decoder offset position byte =+ assertEqual note+ (Left (atOffset "invalid base64 encoding near offset: " position))+ (decoder input)+ where+ input = sliceAt offset $+ BS.replicate position 65 <> BS.singleton byte+ <> BS.replicate (position `div` 4 * 4 + 260 - position - 1) 65+ note = name ++ ": " ++ context (BS.length input) offset+ ++ ", invalid byte=" ++ show byte ++ " at=" ++ show position++atOffset :: T.Text -> Int -> T.Text+atOffset prefix offset = prefix <> T.pack (show offset)++mixedErrors :: Assertion+mixedErrors =+ forM_ [0, 32, 64, 128, 256, 4096] $ \prefixLength ->+ forM_ [0, 1, 15, 31] $ \offset ->+ forM_ [("#=AA", 1), ("A#=A", 2), ("#AA=", 3), ("=#AA", 0)] $+ \(quartet, paddingPosition) ->+ forM_ decoders $ \(name, decoder) ->+ assertEqual (name ++ ": " ++ context prefixLength offset+ ++ ", mixed errors=" ++ show quartet)+ (Left (atOffset "invalid padding near offset: "+ (prefixLength + paddingPosition)))+ (decoder (sliceAt offset+ (BS.replicate prefixLength 65 <> quartet <> BS.replicate 256 65)))++paddingAndTails :: Assertion+paddingAndTails =+ forM_ [0, 16, 32, 48, 64, 96, 128, 192, 256, 4096] $ \prefixLength ->+ forM_ [0, 1, 15, 31] $ \offset -> do+ let prefix = BS.replicate prefixLength 65+ input suffix = sliceAt offset (prefix <> suffix)+ note name = name ++ ": " ++ context prefixLength offset+ expected suffix = Right (BS.replicate (prefixLength `div` 4 * 3) 0 <> suffix)+ forM_ decoders $ \(name, decoder) ->+ forM_ [0 .. 3] $ \position ->+ assertEqual (note name ++ ", interior padding at=" ++ show position)+ (Left (atOffset "invalid padding near offset: " (prefixLength + position)))+ (decoder (input (BS.replicate position 65 <> "="+ <> BS.replicate (7 - position) 65)))+ forM_ (("standard", B64.decodeBase64Untyped) : take 1 urlDecoders+ ++ [("URL generic", B64U.decodeBase64Untyped)]) $ \(name, decoder) -> do+ assertEqual (note name ++ ", one-byte tail") (expected "d")+ (decoder (input "ZA=="))+ assertEqual (note name ++ ", two-byte tail") (expected "f`")+ (decoder (input "ZmA="))+ forM_ [("ZE==", 1), ("ZmC=", 2)] $ \(suffix, position) ->+ assertEqual (note name ++ ", noncanonical tail=" ++ show suffix)+ (Left (atOffset "non-canonical encoding detected at offset: "+ (prefixLength + position))) (decoder (input suffix))+ forM_ (drop 1 urlDecoders) $ \(name, decoder) -> do+ assertEqual (note name ++ ", unpadded one-byte tail") (expected "d")+ (decoder (input "ZA"))+ assertEqual (note name ++ ", unpadded two-byte tail") (expected "f`")+ (decoder (input "ZmA"))+ forM_ [("ZE", 1), ("ZmC", 2)] $ \(suffix, position) ->+ assertEqual (note name ++ ", noncanonical unpadded tail=" ++ show suffix)+ (Left (atOffset "non-canonical encoding detected at offset: "+ (prefixLength + position))) (decoder (input suffix))+ assertEqual (note "unpadded rejects padding")+ (Left "Base64-encoded bytestring has invalid padding")+ (B64U.decodeBase64UnpaddedUntyped (input "ZA=="))+ assertEqual (note "padded requires padding")+ (Left "Base64-encoded bytestring requires padding")+ (B64U.decodeBase64PaddedUntyped (input "ZA"))+ forM_ decoders $ \(name, decoder) ->+ assertEqual (note name ++ ", invalid length")+ (Left "Base64-encoded bytestring has invalid size") (decoder (input "A"))++lazyChunks :: Assertion+lazyChunks =+ forM_ [47, 48, 49, 95, 96, 97, 127, 128, 129, 4096] $ \n ->+ forM_ [1, 2, 3, 4, 11, 12, 15, 16, 47, 48, 63, 64, 127] $ \chunkSize ->+ checkHarness ("lazy length=" ++ show n ++ ", chunk=" ++ show chunkSize)+ lb64 (LBS.fromChunks . chunksOf chunkSize) (payload n)++chunksOf :: Int -> BS.ByteString -> [BS.ByteString]+chunksOf n bytes+ | BS.null bytes = []+ | otherwise = let (chunk, rest) = BS.splitAt n bytes+ in sliceAt 1 chunk : chunksOf n rest++textWrappers :: Assertion+textWrappers =+ forM_ [0, 1, 15, 16, 31, 32, 127, 1024] $ \repetitions -> do+ let value = T.replicate repetitions "a\x00e9\x03bb\x1f642"+ raw = T.encodeUtf8 value+ note = "text repetitions=" ++ show repetitions+ checkHarness note t64 T.decodeUtf8 raw+ checkHarness note ts64 (TS.fromText . T.decodeUtf8) raw+ forM_ [1, 15, 16, 63, 64] $ \chunkSize ->+ checkHarness (note ++ ", text chunk=" ++ show chunkSize) tl64+ (TL.fromChunks . T.chunksOf chunkSize . T.decodeUtf8) raw
+ test/simd-native.c view
@@ -0,0 +1,380 @@+/* Copyright (c) 2026, Emily Pillmore. BSD-3-Clause; see LICENSE. */++/*+ * Standalone differential/bounds checks; link with cbits/base64_simd.c.+ * Recommended: -std=c99 -O2 -Wall -Wextra -Werror+ * -fsanitize=address,undefined -fno-omit-frame-pointer+ * Repeat with -DHS_BASE64_SIMD_FORCE_SCALAR to test fallback compilation.+ */+#ifndef _DEFAULT_SOURCE+#define _DEFAULT_SOURCE 1+#endif++#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#if defined(__unix__) || defined(__APPLE__)+#include <sys/mman.h>+#include <unistd.h>+#define HS_BASE64_GUARD_PAGES 1+#endif++#include "base64_simd.h"++#define CHECK(condition) do { \+ if (!(condition)) { \+ fprintf(stderr, "%s:%d: check failed: %s\n", __FILE__, __LINE__, #condition); \+ exit(EXIT_FAILURE); \+ } \+} while (0)++static const uint8_t alphabets[2][65] = {+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"+};++static size_t encode_block;+static size_t decode_block;+static size_t checks;++static void make_table(const uint8_t *alphabet, uint8_t *table)+{+ memset(table, 255, 256);+ for (size_t i = 0; i < 64; i++) {+ table[alphabet[i]] = (uint8_t)i;+ }+ table['='] = 64;+}++static size_t encode_prefix(size_t len)+{+ return encode_block == 0 ? 0 : len / encode_block * encode_block;+}++static size_t decode_prefix(const uint8_t *src, size_t len, const uint8_t *table)+{+ size_t consumed = 0;++ if (decode_block == 0 || len < 4) {+ return 0;+ }+ while (len - consumed >= decode_block + 4) {+ for (size_t i = 0; i < decode_block; i++) {+ if (table[src[consumed + i]] >= 64) {+ return consumed;+ }+ }+ consumed += decode_block;+ }+ return consumed;+}++static void scalar_encode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *alphabet)+{+ for (size_t i = 0; i < len; i += 3) {+ const unsigned triple = ((unsigned)src[i] << 16) |+ ((unsigned)src[i + 1] << 8) | src[i + 2];+ *dst++ = alphabet[(triple >> 18) & 63];+ *dst++ = alphabet[(triple >> 12) & 63];+ *dst++ = alphabet[(triple >> 6) & 63];+ *dst++ = alphabet[triple & 63];+ }+}++static void scalar_decode(const uint8_t *src, size_t len, uint8_t *dst,+ const uint8_t *table)+{+ for (size_t i = 0; i < len; i += 4) {+ const unsigned quartet = ((unsigned)table[src[i]] << 18) |+ ((unsigned)table[src[i + 1]] << 12) |+ ((unsigned)table[src[i + 2]] << 6) |+ table[src[i + 3]];+ *dst++ = (uint8_t)(quartet >> 16);+ *dst++ = (uint8_t)(quartet >> 8);+ *dst++ = (uint8_t)quartet;+ }+}++static void check_canary(const uint8_t *data, size_t len)+{+ for (size_t i = 0; i < len; i++) {+ CHECK(data[i] == 0xa5);+ }+}++static void check_encode(const uint8_t *src, size_t len, size_t offset,+ const uint8_t *alphabet)+{+ const size_t expected = encode_prefix(len);+ const size_t output_len = expected / 3 * 4;+ uint8_t *output = malloc(offset + output_len + 16);+ uint8_t *reference = malloc(output_len + 1);+ size_t consumed;++ CHECK(output != NULL && reference != NULL);+ memset(output, 0xa5, offset + output_len + 16);+ scalar_encode(src, expected, reference, alphabet);+ consumed = hs_base64_simd_encode(src, len, output + offset, alphabet);+ CHECK(consumed == expected);+ CHECK(consumed <= len && consumed % 3 == 0);+ CHECK(memcmp(output + offset, reference, output_len) == 0);+ check_canary(output, offset);+ check_canary(output + offset + output_len, 16);+ free(reference);+ free(output);+ checks++;+}++static void check_decode(const uint8_t *src, size_t len, size_t offset,+ const uint8_t *table)+{+ const size_t expected = decode_prefix(src, len, table);+ const size_t output_len = expected / 4 * 3;+ uint8_t *output = malloc(offset + output_len + 16);+ uint8_t *reference = malloc(output_len + 1);+ size_t consumed;++ CHECK(output != NULL && reference != NULL);+ memset(output, 0xa5, offset + output_len + 16);+ scalar_decode(src, expected, reference, table);+ consumed = hs_base64_simd_decode(src, len, output + offset, table);+ CHECK(consumed == expected);+ CHECK(consumed % 4 == 0 && consumed <= len);+ CHECK(len < 4 ? consumed == 0 : len - consumed >= 4);+ CHECK(memcmp(output + offset, reference, output_len) == 0);+ check_canary(output, offset);+ check_canary(output + offset + output_len, 16);+ free(reference);+ free(output);+ checks++;+}++static void test_lengths_and_alignment(void)+{+ uint8_t table[256];+ uint8_t source[1056];+ uint8_t encoded[1408];++ for (size_t alphabet = 0; alphabet < 2; alphabet++) {+ make_table(alphabets[alphabet], table);+ for (size_t offset = 0; offset < 32; offset++) {+ for (size_t i = 0; i < sizeof(source); i++) {+ source[i] = (uint8_t)(i * 73 + offset * 19);+ }+ scalar_encode(source, sizeof(source), encoded, alphabets[alphabet]);+ for (size_t len = 0; len <= 1024; len++) {+ check_encode(source + offset, len, 31 - offset, alphabets[alphabet]);+ check_decode(encoded + offset, len, 31 - offset, table);+ }+ }+ }+}++static void test_all_byte_values(void)+{+ uint8_t source[257];+ uint8_t encoded[344];+ uint8_t table[256];++ for (size_t alphabet = 0; alphabet < 2; alphabet++) {+ make_table(alphabets[alphabet], table);+ for (unsigned value = 0; value <= 255; value++) {+ memset(source, (int)value, sizeof(source));+ check_encode(source, sizeof(source), 1, alphabets[alphabet]);+ scalar_encode(source, 255, encoded, alphabets[alphabet]);+ memcpy(encoded + 340, "AAAA", 4);+ check_decode(encoded, sizeof(encoded), 1, table);+ }+ }+}++static void test_invalid_and_padding_stops(void)+{+ uint8_t source[580];+ uint8_t table[256];++ for (size_t alphabet = 0; alphabet < 2; alphabet++) {+ make_table(alphabets[alphabet], table);+ for (size_t position = 0; position < sizeof(source); position++) {+ for (unsigned value = 0; value <= 255; value++) {+ memset(source, 'A', sizeof(source));+ source[position] = (uint8_t)value;+ check_decode(source, sizeof(source), position % 32, table);+ }+ }+ /* In particular, every kind of final padding stays with the caller. */+ memset(source, '/', sizeof(source));+ for (size_t padding = 0; padding <= 4; padding++) {+ memset(source, alphabets[alphabet][63], sizeof(source));+ memset(source + sizeof(source) - padding, '=', padding);+ check_decode(source, sizeof(source), 0, table);+ }+ }+}++/* Fixed-seed xorshift exercises byte combinations outside repeated/cyclic data. */+static uint32_t next_random(uint32_t *state)+{+ uint32_t value = *state;+ value ^= value << 13;+ value ^= value >> 17;+ value ^= value << 5;+ *state = value;+ return value;+}++static void test_random_mixed_inputs(void)+{+ uint8_t source[6144];+ uint8_t encoded[8192];+ uint8_t table[256];+ uint32_t state = UINT32_C(0x6d253fb9);++ for (size_t alphabet = 0; alphabet < 2; alphabet++) {+ make_table(alphabets[alphabet], table);+ for (size_t sample = 0; sample < 256; sample++) {+ const size_t len = next_random(&state) % (sizeof(source) + 1);+ const size_t encoded_len = len / 3 * 4;+ const size_t offset = next_random(&state) % 32;++ for (size_t i = 0; i < len; i++) {+ source[i] = (uint8_t)next_random(&state);+ }+ check_encode(source, len, offset, alphabets[alphabet]);+ scalar_encode(source, len / 3 * 3, encoded, alphabets[alphabet]);+ check_decode(encoded, encoded_len, offset, table);+ if (encoded_len > 0) {+ const size_t position = next_random(&state) % encoded_len;+ encoded[position] = (uint8_t)next_random(&state);+ check_decode(encoded, encoded_len, offset, table);+ }+ }+ }+}++static void test_tight_allocations(void)+{+ uint8_t table[256];++ for (size_t alphabet = 0; alphabet < 2; alphabet++) {+ make_table(alphabets[alphabet], table);+ for (size_t len = 1; len <= 1024; len++) {+ uint8_t *source = malloc(len);+ const size_t encode_len = encode_prefix(len) / 3 * 4;+ uint8_t *encoded = malloc(encode_len == 0 ? 1 : encode_len);+ size_t decode_len;+ uint8_t *decoded;++ CHECK(source != NULL && encoded != NULL);+ memset(source, 0xfb, len);+ CHECK(hs_base64_simd_encode(source, len, encoded, alphabets[alphabet]) ==+ encode_prefix(len));+ memset(source, alphabets[alphabet][63], len);+ decode_len = decode_prefix(source, len, table) / 4 * 3;+ decoded = malloc(decode_len == 0 ? 1 : decode_len);+ CHECK(decoded != NULL);+ CHECK(hs_base64_simd_decode(source, len, decoded, table) ==+ decode_prefix(source, len, table));+ free(decoded);+ free(encoded);+ free(source);+ checks += 2;+ }+ }+}++#if defined(HS_BASE64_GUARD_PAGES)+/* Guard pages independently catch over-wide intrinsic loads/stores. */+static uint8_t *guarded_buffer(size_t page_size)+{+ uint8_t *mapping = mmap(NULL, page_size * 3, PROT_NONE,+ MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);+ CHECK(mapping != MAP_FAILED);+ CHECK(mprotect(mapping + page_size, page_size, PROT_READ | PROT_WRITE) == 0);+ return mapping;+}++static void test_guard_pages(void)+{+ const long raw_page_size = sysconf(_SC_PAGESIZE);+ size_t page_size;+ uint8_t *source_mapping;+ uint8_t *output_mapping;+ uint8_t table[256];++ CHECK(raw_page_size > 0);+ page_size = (size_t)raw_page_size;+ source_mapping = guarded_buffer(page_size);+ output_mapping = guarded_buffer(page_size);++ for (size_t alphabet = 0; alphabet < 2; alphabet++) {+ make_table(alphabets[alphabet], table);+ for (size_t len = 0; len <= 1024; len++) {+ for (size_t at_end = 0; at_end < 2; at_end++) {+ uint8_t *source = source_mapping + page_size ++ (at_end ? page_size - len : 0);+ const size_t encode_len = encode_prefix(len) / 3 * 4;+ uint8_t *output = output_mapping + page_size ++ (at_end ? page_size - encode_len : 0);+ size_t expected;+ size_t decode_len;++ memset(source, 0xfb, len);+ CHECK(hs_base64_simd_encode(source, len, output, alphabets[alphabet]) ==+ encode_prefix(len));+ memset(source, alphabets[alphabet][63], len);+ expected = decode_prefix(source, len, table);+ decode_len = expected / 4 * 3;+ output = output_mapping + page_size + (at_end ? page_size - decode_len : 0);+ CHECK(hs_base64_simd_decode(source, len, output, table) == expected);+ checks += 2;+ }+ }+ }+ CHECK(munmap(source_mapping, page_size * 3) == 0);+ CHECK(munmap(output_mapping, page_size * 3) == 0);+}+#endif++int main(int argc, char **argv)+{+ const int backend = hs_base64_simd_backend();++ if (argc != 1) {+ if (argc != 3 || strcmp(argv[1], "--require-backend") != 0 ||+ strlen(argv[2]) != 1 || argv[2][0] < '0' || argv[2][0] > '3') {+ fprintf(stderr, "usage: %s [--require-backend 0|1|2|3]\n", argv[0]);+ return EXIT_FAILURE;+ }+ if (backend != argv[2][0] - '0') {+ fprintf(stderr, "required SIMD backend %c, detected %d\n", argv[2][0], backend);+ return EXIT_FAILURE;+ }+ }+ CHECK(backend >= 0 && backend <= 3);+#if defined(HS_BASE64_SIMD_FORCE_SCALAR)+ CHECK(backend == 0);+#elif defined(HS_BASE64_SIMD_FORCE_SSSE3) && defined(__x86_64__)+ CHECK(backend == 0 || backend == 1);+#elif defined(__aarch64__) && defined(__ARM_NEON) && \+ (defined(__GNUC__) || defined(__clang__)) && !defined(HS_BASE64_SIMD_EMULATED_X86)+ CHECK(backend == 2);+#endif+ encode_block = backend == 3 ? 24 : backend == 2 ? 48 : backend == 1 ? 12 : 0;+ decode_block = backend == 3 ? 32 : backend == 2 ? 64 : backend == 1 ? 16 : 0;+ printf("SIMD backend: %d (%s)\n", backend,+ backend == 3 ? "AVX2" : backend == 2 ? "NEON" :+ backend == 1 ? "SSSE3" : "scalar fallback");+ test_lengths_and_alignment();+ test_all_byte_values();+ test_invalid_and_padding_stops();+ test_random_mixed_inputs();+ test_tight_allocations();+#if defined(HS_BASE64_GUARD_PAGES)+ test_guard_pages();+#endif+ printf("Passed %zu differential/bounds checks.\n", checks);+ return EXIT_SUCCESS;+}