diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,51 +1,91 @@ # Base64 [![Build Status](https://travis-ci.com/emilypi/base64.svg?branch=master)](https://travis-ci.com/emilypi/base64) +[![Hackage](https://img.shields.io/hackage/v/base64.svg)](https://hackage.haskell.org/package/base64) Padded and unpadded base64 and base64url encodings for `Text` and `ByteString` values, along with their optics. -### Why? +### Summary +What does this library provide? Here is the summary: + +- Better performance over existing Base64 libraries (2x and 3x for most use-cases - see [PERFORMANCE.md](benchmarks/PERFORMANCE.md)) +- Support for unpadded Base64 and Base64-url +- Support for `Text` encodings and decodings +- Optics for handling more complex structures with Base64 representations + + +### Motivation + Haskell has two main libraries for Base64: `memory`, and `base64-bytestring`. -Of these, `memory` is geared towards integration with other memory primitives in the library, without much of an eye towards performance, while `base64-bytestring` is built to exclusively address `ByteString` encoding and decoding, and is very performant. Many great strides have been made in the realm of Base64 performance and vectorization just in the past 5 years, which this library attempts to capture. Additionally, we attempt to fix percieved shortcomings with both APIs in the support of unpadded Base64 and Base64-url support (which `memory` provides, but not `base64-bytestring`), as well as supporting `Text` values (neither libraries provide), and also supplying some nice compositional optics for composing structures with Base64-encodable/decodable focii (neither libraries provide). +Of these, `memory` is geared towards integration with other memory primitives in the library, without much of an eye towards performance, while `base64-bytestring` is built to exclusively address `ByteString` encoding and decoding, and is very performant. Many great strides have been made in the realm of Base64 performance and vectorization just in the past 5 years, which this library attempts to capture. Additionally, we attempt to fix percieved shortcomings with both APIs in the support of unpadded Base64 and Base64-url support (which `memory` provides, but not `base64-bytestring`), as well as supporting `Text` values (neither libraries provide), supplying some optics for composing structures with Base64-encodable/decodable focii (neither libraries provide), and convenient pattern synonyms (no library to date does this). -### Optics +### Patterns -Structs may want to support encoding and decoding their substructures, which is supported with the following prismatic typeclass: +The pattern synonyms provided in this library are: ```haskell -class AsBase64 s where - type Base64 s - -- | A prism into a base64-encoded focus of - -- some type - -- - _Base64 :: Prism' s (Base64 s) +pattern Base64 :: ByteString -> ByteString +pattern Base64Url :: ByteString -> ByteString +pattern Base64Unpadded :: ByteString -> ByteString +pattern Base64UrlUnpadded :: ByteString -> ByteString - -- | A prism into the base64url-encoded focus of - -- some type - -- - _Base64Url :: Prism' s (Base64 s) +-- and + +pattern Base64 :: Text -> Text +pattern Base64Url :: Text -> Text +pattern Base64Unpadded :: Text -> Text +pattern Base64UrlUnpadded :: Text -> Text ``` -The data of a `Prism` naturally conforms to this "encoding/decoding" dichotomy, where the `Review`, or "builder" half of the `Prism` of type `b -> t` is an encoding, and the "Matcher" half of the prism, of type `s -> Either t a`, represents a decoding of a similar structure. Monomorphizing for `t ~ s` and `a ~ b`, a simple `Prism` is formed: +These provide a convenient high level interface for passing Base64 encoded values. + +### Optics + +`Prism`s for encoding and decoding `Text` and `ByteString` values are given as part of the library: + + ```haskell ->>> _Base64 @Text # "<>" -"PDw/Pz8+Pg==" +_Base64 :: Prism' ByteString ByteString +_Base64Url :: Prism' ByteString ByteString +_Base64Unpadded :: Prism' ByteString ByteString +_Base64UrlUnpadded :: Prism' ByteString ByteString ->>> "PDw/Pz8+Pg==" ^? _Base64 @Text -Just "<>" +-- and + +_Base64 :: Prism' Text Text +_Base64Url :: Prism' Text Text +_Base64Unpadded :: Prism' Text Text +_Base64UrlUnpadded :: Prism' Text Text + ``` -The two most obvious types for which we have an instance are those that are supported natively by the library: `ByteString` and `Text`. Trivially, their instances consist of the functions provided here in this library. +If a particular structure has a `Lens` into some `Text` or `ByteString` value they might want to encode (or decode), then composing such a `Lens` with these `Prisms` yields an affine `Traversal`, resulting in a structure which has the focus of its `Lens` encoded as or decoded from Base64(-url). All one needs to do is compose their optics: -### Summary +```haskell -What does this library provide? Here is the summary: +data MyStruct = MyStruct + { _a :: Int + , _b :: Text + } deriving Show -- Better performance over existing Base64 libraries (2x and 3x for most use-cases - see [PERFORMANCE.md](benchmarks/PERFORMANCE.md)) -- Support for unpadded Base64 and Base64-url -- Support for `Text` encodings and decodings -- Classy optics for handling more complex structures with Base64 representations +b :: Lens' MyStruct Text +b = lens _b (\t b_ -> t { _b = b_ }) + +myB64Struct :: Traversal' s Text +myB64Struct = b . _Base64 + +-- >>> MyStruct 3 "U3Vu" ^? b . _Base64 +-- MyStruct {_a = 3, _b = "Sun"} + +bRe :: Review MyStruct Text +bRe = unto (\b -> MyStruct 0 b) + +-- >>> bRe . _Base64 # "Sun" +-- MyStruct {_a = 0, _b = "UV3u"} +``` + +The data of a `Prism` naturally conforms to this "encoding/decoding" dichotomy, where the `Review`, or "builder" half of the `Prism` of type `b -> t` is an encoding, and the "Matcher" half of the prism, of type `s -> Either t a`, represents a decoding of a similar structure. Hence, `Prism` is the most appropriate structure. diff --git a/base64.cabal b/base64.cabal --- a/base64.cabal +++ b/base64.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: base64 -version: 0.0.1.0 +version: 0.1.0.0 synopsis: RFC 4648-compliant padded and unpadded base64 and base64url encodings description: RFC 4648-compliant padded and unpadded base64 and base64url encoding and decoding. @@ -18,7 +18,7 @@ CHANGELOG.md README.md -tested-with: GHC ==8.8.1 || ==8.6.5 || ==8.6.3 || ==8.4.4 || ==8.4.3 || ==8.0.2 +tested-with: GHC ==8.8.1 || ==8.6.5 || ==8.6.3 || ==8.4.4 || ==8.4.3 || ==8.2.2 source-repository head type: git @@ -45,7 +45,7 @@ other-modules: Data.ByteString.Base64.Internal - build-depends: base >=4.9 && <5 + build-depends: base >=4.10 && <5 , bytestring , deepseq , text @@ -70,7 +70,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Base64Tests.hs - build-depends: base >=4.9 && <5 + build-depends: base >=4.10 && <5 , base64 , base64-bytestring , random-bytestring @@ -85,7 +85,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Base64Bench.hs - build-depends: base >=4.9 && <5 + build-depends: base >=4.10 && <5 , base64 , base64-bytestring , bytestring diff --git a/benchmarks/Base64Bench.hs b/benchmarks/Base64Bench.hs --- a/benchmarks/Base64Bench.hs +++ b/benchmarks/Base64Bench.hs @@ -32,20 +32,28 @@ main :: IO () -main = defaultMain $ fmap benchN [25,100,1000,10000,100000] +main = defaultMain + $ fmap (benchN random encode_) sizes + ++ fmap (benchN (fmap B64.encodeBase64 . random) decode_) sizes + where - benchN n = env (random n) $ bgroup (show n) . bgroup_ - bgroup_ e = - [ bgroup "encode" + sizes = [25,100,1000,10000,100000] + benchN f bs n = env (f n) $ bgroup (show n) . bs + + encode_ e = + [ bgroup "base64 encode" [ encodeBench @'Mem e , encodeBench @'Bos e , encodeBench @'B64 e ] - -- , bgroup "base64 decode" - -- [ decodeBench @'Mem e - -- , decodeBench @'Bos e - -- , decodeBench @'B64 e - -- ] + ] + + decode_ e = + [ bgroup "base64 decode" + [ decodeBench @'Mem e + , decodeBench @'Bos e + , decodeBench @'B64 e + ] ] encodeBench :: forall a. Harness a => Base64 a -> Benchmark diff --git a/src/Data/ByteString/Base64.hs b/src/Data/ByteString/Base64.hs --- a/src/Data/ByteString/Base64.hs +++ b/src/Data/ByteString/Base64.hs @@ -26,23 +26,23 @@ -- | Encode a 'ByteString' in base64 with padding. -- --- See: RFC-4648 section 4 +-- See: -- encodeBase64 :: ByteString -> ByteString -encodeBase64 = encodeB64Padded base64Table +encodeBase64 = encodeBase64_ True base64Table {-# INLINE encodeBase64 #-} -- | Decode a padded base64-encoded 'ByteString' -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64 :: ByteString -> Either Text ByteString -decodeBase64 = decodeB64 decodeB64Table +decodeBase64 = decodeBase64_ decodeB64Table {-# INLINE decodeBase64 #-} -- | Encode a 'ByteString' in base64 without padding. -- --- Note: in some circumstances, the use of padding ("=") in base-encoded data +-- __Note:__ in some circumstances, the use of padding ("=") in base-encoded data -- is not required or used. This is not one of them. If you are absolutely sure -- the length of your bytestring is divisible by 3, this function will be the same -- as 'encodeBase64' with padding, however, if not, you may see garbage appended to @@ -51,16 +51,16 @@ -- Only call unpadded variants when you can make assumptions about the length of -- your input data. -- --- See: RFC-4648 section 3.2 +-- See: -- encodeBase64Unpadded :: ByteString -> ByteString -encodeBase64Unpadded = encodeB64Unpadded base64Table +encodeBase64Unpadded = encodeBase64_ False base64Table {-# INLINE encodeBase64Unpadded #-} -- | Decode an unpadded base64-encoded 'ByteString' -- --- See: RFC-4648 section 3.2 +-- See: -- decodeBase64Unpadded :: ByteString -> Either Text ByteString -decodeBase64Unpadded = decodeB64 decodeB64Table +decodeBase64Unpadded = decodeBase64_ decodeB64Table {-# INLINE decodeBase64Unpadded #-} diff --git a/src/Data/ByteString/Base64/Internal.hs b/src/Data/ByteString/Base64/Internal.hs --- a/src/Data/ByteString/Base64/Internal.hs +++ b/src/Data/ByteString/Base64/Internal.hs @@ -16,11 +16,10 @@ -- module Data.ByteString.Base64.Internal ( -- * Base64 encoding - encodeB64Padded -, encodeB64Unpadded + encodeBase64_ -- * Base64 decoding -, decodeB64 +, decodeBase64_ -- * Decoding Tables -- ** Standard @@ -37,6 +36,8 @@ ) where +import Control.Monad (when) + import Data.Bits import Data.ByteString (ByteString) import Data.ByteString.Internal @@ -103,65 +104,15 @@ -- -------------------------------------------------------------------------- -- --- Unpadded Base64 - -encodeB64Unpadded :: EncodingTable -> ByteString -> ByteString -encodeB64Unpadded (EncodingTable _ !efp) (PS sfp !soff !slen) = - unsafeCreate dlen $ \dptr -> - withForeignPtr sfp $ \sptr -> - withForeignPtr efp $ \eptr -> - encodeB64UnpaddedInternal - eptr - (plusPtr sptr soff) - (castPtr dptr) - (plusPtr sptr (soff + slen)) - where - !dlen = 4 * ((slen + 2) `div` 3) -{-# INLINE encodeB64Unpadded #-} - --- | Unpadded Base64. The implicit assumption is that the input --- data has a length that is a multiple of 3 --- -encodeB64UnpaddedInternal - :: Ptr Word16 - -> Ptr Word8 - -> Ptr Word16 - -> Ptr Word8 - -> IO () -encodeB64UnpaddedInternal etable sptr dptr end = go sptr dptr - where - w32 :: Word8 -> Word32 - w32 i = fromIntegral i - {-# INLINE w32 #-} - - go !src !dst - | src >= end = return () - | otherwise = do - - !i <- w32 <$> peek src - !j <- w32 <$> peek (plusPtr src 1) - !k <- w32 <$> peek (plusPtr src 2) - - let !w = (shiftL i 16) .|. (shiftL j 8) .|. k - - !x <- peekElemOff etable (fromIntegral (shiftR w 12)) - !y <- peekElemOff etable (fromIntegral (w .&. 0xfff)) - - poke dst x - poke (plusPtr dst 2) y - - go (plusPtr src 3) (plusPtr dst 4) -{-# INLINE encodeB64UnpaddedInternal #-} - --- -------------------------------------------------------------------------- -- --- Padded Base64 +-- Encode Base64 -encodeB64Padded :: EncodingTable -> ByteString -> ByteString -encodeB64Padded (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = +encodeBase64_ :: Bool -> EncodingTable -> ByteString -> ByteString +encodeBase64_ padding (EncodingTable !aptr !efp) (PS !sfp !soff !slen) = unsafeCreate dlen $ \dptr -> withForeignPtr sfp $ \sptr -> withForeignPtr efp $ \eptr -> - encodeB64PaddedInternal + encodeBase64_' + padding aptr eptr (plusPtr sptr soff) @@ -170,16 +121,17 @@ where dlen :: Int !dlen = 4 * ((slen + 2) `div` 3) -{-# INLINE encodeB64Padded #-} +{-# INLINE encodeBase64_ #-} -encodeB64PaddedInternal - :: Ptr Word8 +encodeBase64_' + :: Bool + -> Ptr Word8 -> Ptr Word16 -> Ptr Word8 -> Ptr Word16 -> Ptr Word8 -> IO () -encodeB64PaddedInternal (Ptr !alpha) !etable !sptr !dptr !end = go sptr dptr +encodeBase64_' !padded (Ptr !alpha) !etable !sptr !dptr !end = go sptr dptr where ix (W8# i) = W8# (indexWord8OffAddr# alpha (word2Int# i)) {-# INLINE ix #-} @@ -237,12 +189,15 @@ -- pokeByteOff dst 1 (ix b') pokeByteOff dst 2 (ix c') + + when padded (pokeByteOff @Word8 dst 3 0x3d) + else do pokeByteOff dst 1 (ix b) - pokeByteOff @Word8 dst 2 0x3d - - pokeByteOff @Word8 dst 3 0x3d -{-# INLINE encodeB64PaddedInternal #-} + when padded $ do + pokeByteOff @Word8 dst 2 0x3d + pokeByteOff @Word8 dst 3 0x3d +{-# INLINE encodeBase64_' #-} -- -------------------------------------------------------------------------- -- -- Decoding Base64 @@ -291,15 +246,15 @@ ] {-# NOINLINE decodeB64UrlTable #-} -decodeB64 :: ForeignPtr Word8 -> ByteString -> Either Text ByteString -decodeB64 !dtfp (PS !sfp !soff !slen) +decodeBase64_ :: ForeignPtr Word8 -> ByteString -> Either Text ByteString +decodeBase64_ !dtfp (PS !sfp !soff !slen) | r /= 0 = Left "invalid padding" | otherwise = unsafeDupablePerformIO $ withForeignPtr dtfp $ \dtable -> withForeignPtr sfp $ \sptr -> do dfp <- mallocPlainForeignPtrBytes dlen withForeignPtr dfp $ \dptr -> - decodeB64Internal + decodeBase64_' dtable (plusPtr sptr soff) dptr @@ -308,9 +263,9 @@ where (!q, !r) = divMod slen 4 !dlen = q * 3 -{-# INLINE decodeB64 #-} +{-# INLINE decodeBase64_ #-} -decodeB64Internal +decodeBase64_' :: Ptr Word8 -- ^ decode lookup table -> Ptr Word8 @@ -322,7 +277,7 @@ -> ForeignPtr Word8 -- ^ dst foreign ptr (for consing bs) -> IO (Either Text ByteString) -decodeB64Internal !dtable !sptr !dptr !end !dfp = go dptr sptr 0 +decodeBase64_' !dtable !sptr !dptr !end !dfp = go dptr sptr 0 where err = return . Left . T.pack {-# INLINE err #-} @@ -370,4 +325,4 @@ else do poke @Word8 (dst `plusPtr` 2) (fromIntegral w) go (dst `plusPtr` 3) (src `plusPtr` 4) (n + 3) -{-# INLINE decodeB64Internal #-} +{-# INLINE decodeBase64_' #-} diff --git a/src/Data/ByteString/Base64/Lens.hs b/src/Data/ByteString/Base64/Lens.hs --- a/src/Data/ByteString/Base64/Lens.hs +++ b/src/Data/ByteString/Base64/Lens.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Text.Encoding.Base64.Lens -- Copyright : (c) 2019 Emily Pillmore @@ -6,19 +7,22 @@ -- -- Maintainer : Emily Pillmore -- Stability : Experimental --- Portability : TypeFamilies --- --- This module contains the 'AsBase64' instance for @Text@, which is --- defined to be the collection of 'Control.Lens.Type.Prism's defining the --- RFC 4648 specification for the Base64 encoding format. +-- Portability : non-portable -- --- In order to expose this file, you must build the package with --- '-foptics' enabled. +-- This module contains 'Control.Lens.Type.Prism's Base64-encoding and +-- decoding 'ByteString' values. -- module Data.ByteString.Base64.Lens -( -- * Classy Prisms - AsBase64(..) -, AsBase64Unpadded(..) +( -- * Prisms + _Base64 +, _Base64Url +, _Base64Unpadded +, _Base64UrlUnpadded + -- * Patterns +, pattern Base64 +, pattern Base64Url +, pattern Base64Unpadded +, pattern Base64UrlUnpadded ) where @@ -29,77 +33,97 @@ import qualified Data.ByteString.Base64.URL as B64U --- | If a particular type @s@ has a base64 representation --- for any of its focii, this class provides the optical interface --- for satisfying the padded base64 spec in RFC 4648 --- -class AsBase64 s where - type Base64 s - -- | A prism into a base64-encoded focus of - -- some type - -- - -- Examples: - -- - -- >>> _Base64 @Text # "Sun" - -- "UV3u" - -- -- - -- >>> "PDw/Pz8+Pg==" ^? _Base64 - -- Just "<>" - -- - _Base64 :: Prism' s (Base64 s) - - -- | A prism into the base64url-encoded focus of - -- some type - -- - -- Examples: - -- - -- >>> _Base64Url @Text # "Sun" - -- "UV3u" - -- - -- >>> "PDw_Pz8-Pg==" ^? _Base64Url - -- Just "<>" - -- - _Base64Url :: Prism' s (Base64 s) +-- -------------------------------------------------------------------------- -- +-- Optics --- | If a particular type @a@ has an unpadded base64 representation --- for any of its focii, this class provides the optical interface --- for satisfying the unpadded base64 spec in RFC 4648 +-- | A 'Control.Lens.Type.Prism' into the Base64 encoding of a 'ByteString' value -- -class AsBase64Unpadded s where - type Base64Unpadded s - -- | A prism into the unpadded base64-encoded focus of - -- some type - -- - _Base64Unpadded :: Prism' s (Base64Unpadded s) +-- >>> _Base64 # "Sun" +-- "UV3u" +-- +-- >>> "UV3u" ^? _Base64 +-- Just "Sun" +-- +_Base64 :: Prism' ByteString ByteString +_Base64 = prism' B64.encodeBase64 $ \s -> case B64.decodeBase64 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64 #-} - -- | A prism into the unpadded base64url-encoded focus of - -- some type - -- - _Base64UrlUnpadded :: Prism' s (Base64Unpadded s) +-- | A 'Control.Lens.Type.Prism' into the Base64-url encoding of a 'ByteString' value +-- +-- >>> _Base64Url # "Sun" +-- "UV3u" +-- +-- >>> "PDw_Pz8-Pg==" ^? _Base64Url +-- Just "<>" +-- +_Base64Url :: Prism' ByteString ByteString +_Base64Url = prism' B64U.encodeBase64 $ \s -> case B64U.decodeBase64 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64Url #-} +-- | A 'Control.Lens.Type.Prism' into the unpadded Base64 encoding of a +-- 'ByteString' value +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base64Unpadded # "Sun" +-- "UV3u" +-- +-- >>> "UV3u" ^? _Base64Unpadded +-- Just "Sun" +-- +_Base64Unpadded :: Prism' ByteString ByteString +_Base64Unpadded = prism' B64.encodeBase64Unpadded $ \s -> case B64.decodeBase64Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64Unpadded #-} -instance AsBase64 ByteString where - type Base64 ByteString = ByteString +-- | A 'Control.Lens.Type.Prism' into the Base64-url encoding of a 'ByteString' value +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base64UrlUnpadded # "<>" +-- "PDw_Pz4-" +-- +-- >>> "PDw_Pz4-" ^? _Base64UrlUnpadded +-- Just "<>" +-- +_Base64UrlUnpadded :: Prism' ByteString ByteString +_Base64UrlUnpadded = prism' B64U.encodeBase64Unpadded $ \s -> case B64U.decodeBase64Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64UrlUnpadded #-} - _Base64 = prism' B64.encodeBase64 $ \s -> case B64.decodeBase64 s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64 #-} +-- -------------------------------------------------------------------------- -- +-- Patterns - _Base64Url = prism' B64U.encodeBase64 $ \s -> case B64U.decodeBase64 s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64Url #-} +-- | Unidirectional pattern synonym for base64-encoded 'ByteString' values. +-- +pattern Base64 :: ByteString -> ByteString +pattern Base64 a <- (preview _Base64 -> Just a) where + Base64 a = _Base64 # a -instance AsBase64Unpadded ByteString where - type Base64Unpadded ByteString = ByteString +-- | Unidirectional pattern synonym for base64url-encoded 'ByteString' values. +-- +pattern Base64Url :: ByteString -> ByteString +pattern Base64Url a <- (preview _Base64Url -> Just a) where + Base64Url a = _Base64Url # a - _Base64Unpadded = prism' B64.encodeBase64 $ \s -> case B64U.decodeBase64 s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64Unpadded #-} +-- | Unidirectional pattern synonym for unpadded base64-encoded 'ByteString' values. +-- +pattern Base64Unpadded :: ByteString -> ByteString +pattern Base64Unpadded a <- (preview _Base64Unpadded -> Just a) where + Base64Unpadded a = _Base64Unpadded # a - _Base64UrlUnpadded = prism' B64.encodeBase64 $ \s -> case B64U.decodeBase64Unpadded s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64UrlUnpadded #-} +-- | Unidirectional pattern synonym for unpadded base64url-encoded 'ByteString' values. +-- +pattern Base64UrlUnpadded :: ByteString -> ByteString +pattern Base64UrlUnpadded a <- (preview _Base64UrlUnpadded -> Just a) where + Base64UrlUnpadded a = _Base64UrlUnpadded # a diff --git a/src/Data/ByteString/Base64/URL.hs b/src/Data/ByteString/Base64/URL.hs --- a/src/Data/ByteString/Base64/URL.hs +++ b/src/Data/ByteString/Base64/URL.hs @@ -25,17 +25,17 @@ -- | Encode a 'ByteString' in base64-url with padding. -- --- See: RFC-4648 section 5 +-- See: -- encodeBase64 :: ByteString -> ByteString -encodeBase64 = encodeB64Padded base64UrlTable +encodeBase64 = encodeBase64_ True base64UrlTable -- | Decode a padded base64-url encoded 'ByteString' -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64 :: ByteString -> Either Text ByteString -decodeBase64 = decodeB64 decodeB64UrlTable +decodeBase64 = decodeBase64_ decodeB64UrlTable -- | Encode a 'ByteString' in base64-url without padding. -- @@ -48,14 +48,14 @@ -- Only call unpadded variants when you can make assumptions about the length of -- your input data. -- --- See: RFC-4648 section 3.2 +-- See: -- encodeBase64Unpadded :: ByteString -> ByteString -encodeBase64Unpadded = encodeB64Unpadded base64UrlTable +encodeBase64Unpadded = encodeBase64_ False base64UrlTable -- | Decode an unpadded base64-url encoded 'ByteString' -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64Unpadded :: ByteString -> Either Text ByteString -decodeBase64Unpadded = decodeB64 decodeB64UrlTable +decodeBase64Unpadded = decodeBase64_ decodeB64UrlTable diff --git a/src/Data/Text/Encoding/Base64.hs b/src/Data/Text/Encoding/Base64.hs --- a/src/Data/Text/Encoding/Base64.hs +++ b/src/Data/Text/Encoding/Base64.hs @@ -26,14 +26,14 @@ -- | Encode 'Text' in base64 with padding. -- --- See: RFC-4648 section 5 +-- See: -- encodeBase64 :: Text -> Text encodeBase64 = T.decodeUtf8 . B64.encodeBase64 . T.encodeUtf8 -- | Decode a padded base64 encoded 'Text' value -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeUtf8 . B64.decodeBase64 . T.encodeUtf8 @@ -49,7 +49,7 @@ -- Only call unpadded variants when you can make assumptions about the length of -- your input data. -- --- See: RFC-4648 section 3.2 +-- See: -- encodeBase64Unpadded :: Text -> Text encodeBase64Unpadded = T.decodeUtf8 @@ -58,7 +58,7 @@ -- | Decode an unpadded base64 encoded 'Text' -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64Unpadded :: Text -> Either Text Text decodeBase64Unpadded = fmap T.decodeUtf8 diff --git a/src/Data/Text/Encoding/Base64/Lens.hs b/src/Data/Text/Encoding/Base64/Lens.hs --- a/src/Data/Text/Encoding/Base64/Lens.hs +++ b/src/Data/Text/Encoding/Base64/Lens.hs @@ -1,5 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Text.Encoding.Base64.Lens -- Copyright : (c) 2019 Emily Pillmore @@ -7,50 +7,123 @@ -- -- Maintainer : Emily Pillmore -- Stability : Experimental --- Portability : TypeFamilies --- --- This module contains the 'AsBase64' and 'AsBase64Unpadded' instances --- for 'Text', which defined to be the collection of 'Control.Lens.Type.Prism's defining the --- RFC 4648 specification for the padded and unpadded Base64 encoding format. +-- Portability : non-portable -- --- These typeclasses are re-exported for convenience +-- This module contains 'Control.Lens.Type.Prism's Base64-encoding and +-- decoding 'Text' values. -- module Data.Text.Encoding.Base64.Lens -( AsBase64(..) -, AsBase64Unpadded(..) +( -- * Prisms + _Base64 +, _Base64Url +, _Base64Unpadded +, _Base64UrlUnpadded + -- * Patterns +, pattern Base64 +, pattern Base64Url +, pattern Base64Unpadded +, pattern Base64UrlUnpadded ) where import Control.Lens import Data.Text (Text) -import Data.ByteString.Base64.Lens import qualified Data.Text.Encoding.Base64 as B64T import qualified Data.Text.Encoding.Base64.URL as B64TU -instance AsBase64 Text where - type Base64 Text = Text +-- -------------------------------------------------------------------------- -- +-- Optics - _Base64 = prism' B64T.encodeBase64 $ \s -> case B64T.decodeBase64 s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64 #-} +-- | A 'Control.Lens.Type.Prism' into the Base64 encoding of a 'Text' value. +-- +-- >>> _Base64 # "Sun" +-- "UV3u" +-- +-- >>> "UV3u" ^? _Base64 +-- Just "Sun" +-- +_Base64 :: Prism' Text Text +_Base64 = prism' B64T.encodeBase64 $ \s -> case B64T.decodeBase64 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64 #-} - _Base64Url = prism' B64TU.encodeBase64 $ \s -> case B64TU.decodeBase64 s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64Url #-} +-- | A 'Control.Lens.Type.Prism' into the Base64-url encoding of a 'Text' value. +-- +-- >>> _Base64Url # "Sun" +-- "UV3u" +-- +-- >>> "PDw_Pz8-Pg==" ^? _Base64Url +-- Just "<>" +-- +_Base64Url :: Prism' Text Text +_Base64Url = prism' B64TU.encodeBase64 $ \s -> case B64TU.decodeBase64 s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64Url #-} -instance AsBase64Unpadded Text where - type Base64Unpadded Text = Text +-- | A 'Control.Lens.Type.Prism' into the unpadded Base64 encoding of a +-- 'Text' value. +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base64Unpadded # "Sun" +-- "UV3u" +-- +-- >>> "UV3u" ^? _Base64Unpadded +-- Just "Sun" +-- +_Base64Unpadded :: Prism' Text Text +_Base64Unpadded = prism' B64T.encodeBase64Unpadded $ \s -> case B64T.decodeBase64Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64Unpadded #-} - _Base64Unpadded = prism' B64T.encodeBase64 $ \s -> case B64T.decodeBase64 s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64Unpadded #-} +-- | A 'Control.Lens.Type.Prism' into the Base64-url encoding of a 'Text' value. +-- +-- Please note that unpadded variants should only be used +-- when assumptions about the data can be made. In particular, if the length of +-- the input is divisible by 3, then this is a safe function to call. +-- +-- >>> _Base64UrlUnpadded # "<>" +-- "PDw_Pz4-" +-- +-- >>> "PDw_Pz4-" ^? _Base64UrlUnpadded +-- Just "<>" +-- +_Base64UrlUnpadded :: Prism' Text Text +_Base64UrlUnpadded = prism' B64TU.encodeBase64Unpadded $ \s -> case B64TU.decodeBase64Unpadded s of + Left _ -> Nothing + Right a -> Just a +{-# INLINE _Base64UrlUnpadded #-} - _Base64UrlUnpadded = prism' B64TU.encodeBase64 $ \s -> case B64TU.decodeBase64Unpadded s of - Left _ -> Nothing - Right a -> Just a - {-# INLINE _Base64UrlUnpadded #-} +-- -------------------------------------------------------------------------- -- +-- Patterns + +-- | Unidirectional pattern synonym for base64-encoded 'Text' values. +-- +pattern Base64 :: Text -> Text +pattern Base64 a <- (preview _Base64 -> Just a) where + Base64 a = _Base64 # a + +-- | Unidirectional pattern synonym for base64url-encoded 'Text' values. +-- +pattern Base64Url :: Text -> Text +pattern Base64Url a <- (preview _Base64Url -> Just a) where + Base64Url a = _Base64Url # a + +-- | Unidirectional pattern synonym for unpadded base64-encoded 'Text' values. +-- +pattern Base64Unpadded :: Text -> Text +pattern Base64Unpadded a <- (preview _Base64Unpadded -> Just a) where + Base64Unpadded a = _Base64Unpadded # a + +-- | Unidirectional pattern synonym for unpadded base64url-encoded 'Text' values. +-- +pattern Base64UrlUnpadded :: Text -> Text +pattern Base64UrlUnpadded a <- (preview _Base64UrlUnpadded -> Just a) where + Base64UrlUnpadded a = _Base64UrlUnpadded # a diff --git a/src/Data/Text/Encoding/Base64/URL.hs b/src/Data/Text/Encoding/Base64/URL.hs --- a/src/Data/Text/Encoding/Base64/URL.hs +++ b/src/Data/Text/Encoding/Base64/URL.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.Text.Encoding.Base64.URL -- Copyright : (c) 2019 Emily Pillmore @@ -25,21 +26,21 @@ -- | Encode a 'Text' in base64-url with padding. -- --- See: RFC-4648 section 5 +-- See: -- encodeBase64 :: Text -> Text encodeBase64 = T.decodeUtf8 . B64U.encodeBase64 . T.encodeUtf8 -- | Decode a padded base64-url encoded 'Text' -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64 :: Text -> Either Text Text decodeBase64 = fmap T.decodeUtf8 . B64U.decodeBase64 . T.encodeUtf8 -- | Encode a 'Text' value in base64-url without padding. -- --- Note: in some circumstances, the use of padding ("=") in base-encoded data +-- __Note:__ in some circumstances, the use of padding ("=") in base-encoded data -- is not required or used. If you are absolutely sure the length of your -- input data is divisible by 3, this function will be the same as 'encodeBase64' -- with padding. However, if not, you may see garbage appended to output in the @@ -48,7 +49,7 @@ -- Only call unpadded variants when you can make assumptions about the length of -- your input data. -- --- See: RFC-4648 section 3.2 +-- See: -- encodeBase64Unpadded :: Text -> Text encodeBase64Unpadded = T.decodeUtf8 @@ -57,7 +58,7 @@ -- | Decode an unpadded base64-url encoded 'Text' value -- --- See: RFC-4648 section 4 +-- See: -- decodeBase64Unpadded :: Text -> Either Text Text decodeBase64Unpadded = fmap T.decodeUtf8