diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for base64-lens + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2020, Emily Pillmore + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Emily Pillmore nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,73 @@ +# Base64-lens + +[![Build Status](https://travis-ci.com/emilypi/base64-lens.svg?branch=master)](https://travis-ci.com/emilypi/base64-lens) + +This package provides optics and convenient pattern synonyms for the [base64](https://hackage.haskell.org/package/base64) library. + +### Patterns + +The pattern synonyms provided in this library are: + +```haskell +pattern Base64 :: ByteString -> ByteString +pattern Base64Url :: ByteString -> ByteString +pattern Base64Unpadded :: ByteString -> ByteString +pattern Base64UrlUnpadded :: ByteString -> ByteString + +-- and + +pattern Base64 :: Text -> Text +pattern Base64Url :: Text -> Text +pattern Base64Unpadded :: Text -> Text +pattern Base64UrlUnpadded :: Text -> Text +``` + +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 :: Prism' ByteString ByteString +_Base64Url :: Prism' ByteString ByteString +_Base64Unpadded :: Prism' ByteString ByteString +_Base64UrlUnpadded :: Prism' ByteString ByteString + +-- and + +_Base64 :: Prism' Text Text +_Base64Url :: Prism' Text Text +_Base64Unpadded :: Prism' Text Text +_Base64UrlUnpadded :: Prism' Text Text + +``` + +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: + +```haskell + +data MyStruct = MyStruct + { _a :: Int + , _b :: Text + } deriving Show + +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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main where + +import Distribution.Extra.Doctest (defaultMainWithDoctests) + +main :: IO () +main = defaultMainWithDoctests "doctests" diff --git a/base64-lens.cabal b/base64-lens.cabal new file mode 100644 --- /dev/null +++ b/base64-lens.cabal @@ -0,0 +1,62 @@ +cabal-version: 1.24 + +name: base64-lens +version: 0.1.0.0 +synopsis: Optics for the Base64 library +description: + Prisms and pattern synonyms for the Base64 library +homepage: https://github.com/emilypi/base64-lens +bug-reports: https://github.com/emilypi/base64-lens/issues +license: BSD3 +license-file: LICENSE +author: Emily Pillmore +maintainer: emilypi@cohomolo.gy +copyright: (c) 2019 Emily Pillmore +category: Data +build-type: Custom +extra-source-files: + CHANGELOG.md + README.md + +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 + location: https://github.com/emilypi/base64.git + + +custom-setup + setup-depends: + base >=4.10 && <5 + , Cabal + , cabal-doctest + + +library + exposed-modules: Data.ByteString.Base64.Lens + , Data.Text.Encoding.Base64.Lens + + build-depends: base >=4.10 && <5 + , base64 >=0.2.0.0 + , bytestring >=0.10 && <0.11 + , lens >=4.0 && <4.19 + , text >=1.2 && <1.3 + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + + +test-suite doctests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: doctests.hs + + build-depends: base >=4.10 && <5 + , base64-lens + , doctest + , lens + + hs-source-dirs: test + ghc-options: -Wall -threaded + x-doctest-options: --fast diff --git a/src/Data/ByteString/Base64/Lens.hs b/src/Data/ByteString/Base64/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base64/Lens.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Text.Encoding.Base64.Lens +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Control.Lens.Type.Prism's for Base64-encoding and +-- decoding 'ByteString' values. +-- +module Data.ByteString.Base64.Lens +( -- * Prisms + _Base64 +, _Base64Url +, _Base64Unpadded +, _Base64UrlUnpadded + -- * Patterns +, pattern Base64 +, pattern Base64Url +, pattern Base64Unpadded +, pattern Base64UrlUnpadded +) where + + +import Control.Lens + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.URL as B64U + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.ByteString.Base64.Lens +-- +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeApplications + + +-- -------------------------------------------------------------------------- -- +-- Optics + +-- | A 'Control.Lens.Type.Prism' into the Base64 encoding of a 'ByteString' value +-- +-- >>> _Base64 # "Sun" +-- "U3Vu" +-- +-- >>> "U3Vu" ^? _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 'Control.Lens.Type.Prism' into the Base64-url encoding of a 'ByteString' value +-- +-- >>> _Base64Url # "Sun" +-- "U3Vu" +-- +-- >>> "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" +-- "U3Vu" +-- +-- >>> "U3Vu" ^? _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 #-} + +-- | 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 #-} + +-- -------------------------------------------------------------------------- -- +-- Patterns + +-- | Unidirectional pattern synonym for base64-encoded 'ByteString' values. +-- +pattern Base64 :: ByteString -> ByteString +pattern Base64 a <- (preview _Base64 -> Just a) where + Base64 a = _Base64 # a + +-- | Unidirectional pattern synonym for base64url-encoded 'ByteString' values. +-- +pattern Base64Url :: ByteString -> ByteString +pattern Base64Url a <- (preview _Base64Url -> Just a) where + Base64Url a = _Base64Url # a + +-- | 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 + +-- | 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/Text/Encoding/Base64/Lens.hs b/src/Data/Text/Encoding/Base64/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Encoding/Base64/Lens.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Text.Encoding.Base64.Lens +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : non-portable +-- +-- This module contains 'Control.Lens.Type.Prism's Base64-encoding and +-- decoding 'Text' values. +-- +module Data.Text.Encoding.Base64.Lens +( -- * Prisms + _Base64 +, _Base64Url +, _Base64Unpadded +, _Base64UrlUnpadded + -- * Patterns +, pattern Base64 +, pattern Base64Url +, pattern Base64Unpadded +, pattern Base64UrlUnpadded +) where + + +import Control.Lens + +import Data.Text (Text) +import qualified Data.Text.Encoding.Base64 as B64T +import qualified Data.Text.Encoding.Base64.URL as B64TU + + +-- $setup +-- +-- >>> import Control.Lens +-- >>> import Data.Text.Encoding.Base64.Lens +-- +-- >>> :set -XOverloadedStrings +-- >>> :set -XTypeApplications + +-- -------------------------------------------------------------------------- -- +-- Optics + +-- | A 'Control.Lens.Type.Prism' into the Base64 encoding of a 'Text' value. +-- +-- >>> _Base64 # "Sun" +-- "U3Vu" +-- +-- >>> "U3Vu" ^? _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 #-} + +-- | A 'Control.Lens.Type.Prism' into the Base64-url encoding of a 'Text' value. +-- +-- >>> _Base64Url # "Sun" +-- "U3Vu" +-- +-- >>> "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 #-} + +-- | 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" +-- "U3Vu" +-- +-- >>> "U3Vu" ^? _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 #-} + +-- | 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 #-} + +-- -------------------------------------------------------------------------- -- +-- 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/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,7 @@ +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Test.DocTest (doctest) + +main :: IO () +main = doctest $ flags ++ pkgs ++ module_sources