base64-bytestring-type (empty) → 1
raw patch · 9 files changed
+881/−0 lines, 9 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, base-compat, base64-bytestring, base64-bytestring-type, binary, bytestring, cereal, deepseq, ghc-prim, hashable, semigroups, tasty, tasty-quickcheck, text
Files
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- base64-bytestring-type.cabal +88/−0
- src/Data/ByteString/Base64/Lazy/Type.hs +176/−0
- src/Data/ByteString/Base64/Type.hs +165/−0
- src/Data/ByteString/Base64/URL/Lazy/Type.hs +176/−0
- src/Data/ByteString/Base64/URL/Type.hs +162/−0
- test/Tests.hs +77/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015-2018, Futurice++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 Oleg Grenrus 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.
+ README.md view
@@ -0,0 +1,5 @@+# haskell-base64-bytestring-type++[](https://travis-ci.org/futurice/haskell-base64-bytestring-type)++A 'ByteString64' -type with `FromJSON`, `ToJSON`, `Binary` and `Serializable` instances.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ base64-bytestring-type.cabal view
@@ -0,0 +1,88 @@+name: base64-bytestring-type+version: 1+synopsis: A newtype around ByteString, for base64 encoding+description:+ A newtype around ByteString, for base64 encoding.+ Strict and lazy, normal and url alphabet variants.+category: Web+homepage: https://github.com/futurice/haskell-base64-bytestring-type#readme+bug-reports: https://github.com/futurice/haskell-base64-bytestring-type/issues+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: 1.12+tested-with:+ GHC==7.4.2,+ GHC==7.6.3,+ GHC==7.8.4,+ GHC==7.10.3,+ GHC==8.0.2,+ GHC==8.2.2,+ GHC==8.4.1++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/futurice/haskell-base64-bytestring-type++library+ hs-source-dirs:+ src+ ghc-options: -Wall++ -- boot libraries+ -- https://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/VersionHistory+ build-depends:+ base >=4.5.1.0 && <4.11+ , binary >=0.5.1.0 && <0.10+ , bytestring >=0.9.2.1 && <0.11+ , deepseq >=1.3.0.0 && <1.5+ , text >=1.2.3.0 && <1.3++ -- other dependencies:+ build-depends:+ aeson >=1.2.3.0 && <1.3+ , base-compat >=0.9.3 && <0.10+ , base64-bytestring >=1.0.0.1 && <1.1+ , cereal >=0.5.5.0 && <0.6+ , hashable >=1.2.6.1 && <1.3+ , QuickCheck >=2.11.3 && <2.12++ if !impl(ghc >= 8.0)+ build-depends: semigroups >=0.18.4 && <0.19++ if impl(ghc < 7.5)+ build-depends: ghc-prim++ exposed-modules:+ Data.ByteString.Base64.Type+ Data.ByteString.Base64.Lazy.Type+ Data.ByteString.Base64.URL.Type+ Data.ByteString.Base64.URL.Lazy.Type+ default-language: Haskell2010++test-suite tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs:+ test+ ghc-options: -Wall++ -- dependencies with bounds inherited from library:+ build-depends:+ base+ , aeson+ , binary+ , bytestring+ , base64-bytestring-type+ , cereal++ -- other dependencies+ build-depends:+ tasty >=0.10.0.2 && <1.1+ , tasty-quickcheck >=0.8.3.2 && <0.10
+ src/Data/ByteString/Base64/Lazy/Type.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+-- | Lazy 'ByteString' standard base64 encoding.+--+-- See <https://tools.ietf.org/html/rfc4648>.+module Data.ByteString.Base64.Lazy.Type (+ ByteString64,+ makeByteString64,+ getByteString64,+ mkBS64,+ getBS64,+ getEncodedByteString64,+ ) where++import Prelude ()+import Prelude.Compat++import Control.DeepSeq (NFData (..))+import Data.Aeson+ (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), withText)+import Data.Aeson.Types (FromJSONKeyFunction (..), toJSONKeyText)+import Data.Binary (Binary (..))+import Data.ByteString.Lazy (ByteString, pack, unpack)+import Data.Data (Data, Typeable)+import Data.Hashable (Hashable)+import Data.Semigroup (Semigroup (..))+import Data.Serialize (Serialize)+import Data.String (IsString (..))+import Data.Text.Lazy (fromStrict, toStrict)+import Data.Text.Lazy.Encoding (decodeLatin1, encodeUtf8)+import GHC.Generics (Generic)+import Test.QuickCheck+ (Arbitrary (..), CoArbitrary (..), Function (..), functionMap,+ shrinkMap)++import qualified Data.ByteString.Base64.Lazy as Base64++#if !(MIN_VERSION_bytestring(0,10,0))+import Data.ByteString.Lazy.Internal (ByteString (..))+#endif++-- | Aeson serialisable bytestring. Uses base64 encoding.+--+-- The inner 'ByteString' is in raw format.+--+-- >>> let bs64 = makeByteString64 "foobar"+-- >>> bs64+-- mkBS64 "foobar"+--+-- 'Binary' instance doesn't use base64 encoding:+--+-- >>> Binary.encode bs64+-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ACKfoobar"+--+-- 'Aeson' instance does:+--+-- >>> Aeson.encode bs64+-- "\"Zm9vYmFy\""+--+-- This module uses standard alphabet+--+-- >>> Aeson.encode (makeByteString64 "aa\191")+-- "\"YWG/\""+--+newtype ByteString64 = BS64 ByteString+ deriving (Eq, Ord, Data, Typeable, Generic)++instance Show ByteString64 where+ showsPrec d (BS64 bs) = showParen (d > 10) $ showString "mkBS64 " . showsPrec 11 bs++-- | Wrap 'ByteString' into 'ByteString64'. Essentially 'coerce'.+makeByteString64 :: ByteString -> ByteString64+makeByteString64 = BS64++-- | Shorter variant of 'makeByteString64'+mkBS64 :: ByteString -> ByteString64+mkBS64 = makeByteString64++-- | Unwrap 'ByteString' from 'ByteString64'. Essentially 'coerce'.+getByteString64 :: ByteString64 -> ByteString+getByteString64 = \(BS64 bs) -> bs++-- | Shorter variant of 'getByteString64'+getBS64 :: ByteString64 -> ByteString+getBS64 = \(BS64 bs) -> bs++-- | Get base64 encode bytestring+--+-- >>> getEncodedByteString64 "foobar"+-- "Zm9vYmFy"+--+-- >>> getEncodedByteString64 "aa\191"+-- "YWG/"+--+getEncodedByteString64 :: ByteString64 -> ByteString+getEncodedByteString64 = Base64.encode . getBS64++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance IsString ByteString64 where+ fromString = BS64 . fromString++instance Semigroup ByteString64 where+ BS64 a <> BS64 b = BS64 (a <> b)++instance Monoid ByteString64 where+ mempty = BS64 mempty+ mappend = (<>)++instance NFData ByteString64 where+ rnf = rnf' . getBS64 where+#if MIN_VERSION_bytestring(0,10,0)+ rnf' = rnf+#else+ rnf' Empty = ()+ rnf' (Chunk _ b) = rnf' b+#endif++instance Hashable ByteString64++-------------------------------------------------------------------------------+-- aeson+-------------------------------------------------------------------------------++instance ToJSON ByteString64 where+ toJSON = toJSON . decodeLatin1 . getEncodedByteString64+ toEncoding = toEncoding . decodeLatin1 . getEncodedByteString64++instance FromJSON ByteString64 where+ parseJSON = withText "ByteString" $+ either fail (pure . BS64) . Base64.decode . encodeUtf8 . fromStrict++instance ToJSONKey ByteString64 where+ toJSONKey = toJSONKeyText (toStrict . decodeLatin1 . getEncodedByteString64)++instance FromJSONKey ByteString64 where+ fromJSONKey = FromJSONKeyTextParser $+ either fail (pure . BS64) . Base64.decode . encodeUtf8 . fromStrict++-------------------------------------------------------------------------------+-- cereal+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Serialize ByteString64++-------------------------------------------------------------------------------+-- binary+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Binary ByteString64 where+ put = put . getBS64+ get = fmap makeByteString64 get++-------------------------------------------------------------------------------+-- QuickCheck+-------------------------------------------------------------------------------++instance Arbitrary ByteString64 where+ arbitrary = BS64 . pack <$> arbitrary+ shrink = shrinkMap (BS64 . pack) (unpack . getBS64)++instance CoArbitrary ByteString64 where+ coarbitrary = coarbitrary . unpack . getBS64++instance Function ByteString64 where+ function = functionMap (unpack . getBS64) (BS64 . pack)++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Binary as Binary+-- >>> import qualified Data.Aeson as Aeson
+ src/Data/ByteString/Base64/Type.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+-- | Strict 'ByteString' standard base64 encoding.+--+-- See <https://tools.ietf.org/html/rfc4648>.+module Data.ByteString.Base64.Type (+ ByteString64,+ makeByteString64,+ getByteString64,+ mkBS64,+ getBS64,+ getEncodedByteString64,+ ) where++import Prelude ()+import Prelude.Compat++import Control.DeepSeq (NFData (..))+import Data.Aeson+ (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), withText)+import Data.Aeson.Types (FromJSONKeyFunction (..), toJSONKeyText)+import Data.Binary (Binary (..))+import Data.ByteString (ByteString, pack, unpack)+import Data.Data (Data, Typeable)+import Data.Hashable (Hashable)+import Data.Semigroup (Semigroup (..))+import Data.Serialize (Serialize)+import Data.String (IsString (..))+import Data.Text.Encoding (decodeLatin1, encodeUtf8)+import GHC.Generics (Generic)+import Test.QuickCheck+ (Arbitrary (..), CoArbitrary (..), Function (..), functionMap,+ shrinkMap)++import qualified Data.ByteString.Base64 as Base64++-- | Aeson serialisable bytestring. Uses base64 encoding.+--+-- The inner 'ByteString' is in raw format.+--+-- >>> let bs64 = makeByteString64 "foobar"+-- >>> bs64+-- mkBS64 "foobar"+--+-- 'Binary' instance doesn't use base64 encoding:+--+-- >>> Binary.encode bs64+-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ACKfoobar"+--+-- 'Aeson' instance does:+--+-- >>> Aeson.encode bs64+-- "\"Zm9vYmFy\""+--+-- This module uses standard alphabet+--+-- >>> Aeson.encode (makeByteString64 "aa\191")+-- "\"YWG/\""+--+newtype ByteString64 = BS64 ByteString+ deriving (Eq, Ord, Data, Typeable, Generic)++instance Show ByteString64 where+ showsPrec d (BS64 bs) = showParen (d > 10) $ showString "mkBS64 " . showsPrec 11 bs++-- | Wrap 'ByteString' into 'ByteString64'. Essentially 'coerce'.++-- | Wrap 'ByteString' into 'ByteString64'. Essentially 'coerce'.+makeByteString64 :: ByteString -> ByteString64+makeByteString64 = BS64++-- | Shorter variant of 'makeByteString64'+mkBS64 :: ByteString -> ByteString64+mkBS64 = makeByteString64++-- | Unwrap 'ByteString' from 'ByteString64'. Essentially 'coerce'.+getByteString64 :: ByteString64 -> ByteString+getByteString64 = \(BS64 bs) -> bs++-- | Shorter variant of 'getByteString64'+getBS64 :: ByteString64 -> ByteString+getBS64 = \(BS64 bs) -> bs++-- | Get base64 encode bytestring+--+-- >>> getEncodedByteString64 "foobar"+-- "Zm9vYmFy"+--+-- >>> getEncodedByteString64 "aa\191"+-- "YWG/"+--+getEncodedByteString64 :: ByteString64 -> ByteString+getEncodedByteString64 = Base64.encode . getBS64++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance IsString ByteString64 where+ fromString = BS64 . fromString++instance Semigroup ByteString64 where+ BS64 a <> BS64 b = BS64 (a <> b)++instance Monoid ByteString64 where+ mempty = BS64 mempty+ mappend = (<>)++-- Instance is written like this to support bytestring-0.9+instance NFData ByteString64 where rnf x = x `seq` ()+instance Hashable ByteString64++-------------------------------------------------------------------------------+-- aeson+-------------------------------------------------------------------------------++instance ToJSON ByteString64 where+ toJSON = toJSON . decodeLatin1 . getEncodedByteString64+ toEncoding = toEncoding . decodeLatin1 . getEncodedByteString64++instance FromJSON ByteString64 where+ parseJSON = withText "ByteString" $+ either fail (pure . BS64) . Base64.decode . encodeUtf8++instance ToJSONKey ByteString64 where+ toJSONKey = toJSONKeyText (decodeLatin1 . getEncodedByteString64)++instance FromJSONKey ByteString64 where+ fromJSONKey = FromJSONKeyTextParser $+ either fail (pure . BS64) . Base64.decode . encodeUtf8++-------------------------------------------------------------------------------+-- cereal+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Serialize ByteString64++-------------------------------------------------------------------------------+-- binary+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Binary ByteString64 where+ put = put . getBS64+ get = fmap makeByteString64 get++-------------------------------------------------------------------------------+-- QuickCheck+-------------------------------------------------------------------------------++instance Arbitrary ByteString64 where+ arbitrary = BS64 . pack <$> arbitrary+ shrink = shrinkMap (BS64 . pack) (unpack . getBS64)++instance CoArbitrary ByteString64 where+ coarbitrary = coarbitrary . unpack . getBS64++instance Function ByteString64 where+ function = functionMap (unpack . getBS64) (BS64 . pack)++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Binary as Binary+-- >>> import qualified Data.Aeson as Aeson
+ src/Data/ByteString/Base64/URL/Lazy/Type.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+-- | Lazy 'ByteString' base64 encoding with URL and filename safe alphabet.+--+-- See <https://tools.ietf.org/html/rfc4648>.+module Data.ByteString.Base64.URL.Lazy.Type (+ ByteString64,+ makeByteString64,+ getByteString64,+ mkBS64,+ getBS64,+ getEncodedByteString64,+ ) where++import Prelude ()+import Prelude.Compat++import Control.DeepSeq (NFData (..))+import Data.Aeson+ (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), withText)+import Data.Aeson.Types (FromJSONKeyFunction (..), toJSONKeyText)+import Data.Binary (Binary (..))+import Data.ByteString.Lazy (ByteString, pack, unpack)+import Data.Data (Data, Typeable)+import Data.Hashable (Hashable)+import Data.Semigroup (Semigroup (..))+import Data.Serialize (Serialize)+import Data.String (IsString (..))+import Data.Text.Lazy (fromStrict, toStrict)+import Data.Text.Lazy.Encoding (decodeLatin1, encodeUtf8, )+import GHC.Generics (Generic)+import Test.QuickCheck+ (Arbitrary (..), CoArbitrary (..), Function (..), functionMap,+ shrinkMap)++import qualified Data.ByteString.Base64.URL.Lazy as Base64++#if !(MIN_VERSION_bytestring(0,10,0))+import Data.ByteString.Lazy.Internal (ByteString (..))+#endif++-- | Aeson serialisable bytestring. Uses base64 encoding.+--+-- The inner 'ByteString' is in raw format.+--+-- >>> let bs64 = makeByteString64 "foobar"+-- >>> bs64+-- mkBS64 "foobar"+--+-- 'Binary' instance doesn't use base64 encoding:+--+-- >>> Binary.encode bs64+-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ACKfoobar"+--+-- 'Aeson' instance does:+--+-- >>> Aeson.encode bs64+-- "\"Zm9vYmFy\""+--+-- This module uses standard alphabet+--+-- >>> Aeson.encode (makeByteString64 "aa\191")+-- "\"YWG_\""+--+newtype ByteString64 = BS64 ByteString+ deriving (Eq, Ord, Data, Typeable, Generic)++instance Show ByteString64 where+ showsPrec d (BS64 bs) = showParen (d > 10) $ showString "mkBS64 " . showsPrec 11 bs++-- | Wrap 'ByteString' into 'ByteString64'. Essentially 'coerce'.+makeByteString64 :: ByteString -> ByteString64+makeByteString64 = BS64++-- | Shorter variant of 'makeByteString64'+mkBS64 :: ByteString -> ByteString64+mkBS64 = makeByteString64++-- | Unwrap 'ByteString' from 'ByteString64'. Essentially 'coerce'.+getByteString64 :: ByteString64 -> ByteString+getByteString64 = \(BS64 bs) -> bs++-- | Shorter variant of 'getByteString64'+getBS64 :: ByteString64 -> ByteString+getBS64 = \(BS64 bs) -> bs++-- | Get base64 encode bytestring+--+-- >>> getEncodedByteString64 "foobar"+-- "Zm9vYmFy"+--+-- >>> getEncodedByteString64 "aa\191"+-- "YWG_"+--+getEncodedByteString64 :: ByteString64 -> ByteString+getEncodedByteString64 = Base64.encode . getBS64++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance IsString ByteString64 where+ fromString = BS64 . fromString++instance Semigroup ByteString64 where+ BS64 a <> BS64 b = BS64 (a <> b)++instance Monoid ByteString64 where+ mempty = BS64 mempty+ mappend = (<>)++instance NFData ByteString64 where+ rnf = rnf' . getBS64 where+#if MIN_VERSION_bytestring(0,10,0)+ rnf' = rnf+#else+ rnf' Empty = ()+ rnf' (Chunk _ b) = rnf' b+#endif++instance Hashable ByteString64++-------------------------------------------------------------------------------+-- aeson+-------------------------------------------------------------------------------++instance ToJSON ByteString64 where+ toJSON = toJSON . decodeLatin1 . getEncodedByteString64+ toEncoding = toEncoding . decodeLatin1 . getEncodedByteString64++instance FromJSON ByteString64 where+ parseJSON = withText "ByteString" $+ either fail (pure . BS64) . Base64.decode . encodeUtf8 . fromStrict++instance ToJSONKey ByteString64 where+ toJSONKey = toJSONKeyText (toStrict . decodeLatin1 . getEncodedByteString64)++instance FromJSONKey ByteString64 where+ fromJSONKey = FromJSONKeyTextParser $+ either fail (pure . BS64) . Base64.decode . encodeUtf8 . fromStrict++-------------------------------------------------------------------------------+-- cereal+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Serialize ByteString64++-------------------------------------------------------------------------------+-- binary+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Binary ByteString64 where+ put = put . getBS64+ get = fmap makeByteString64 get++-------------------------------------------------------------------------------+-- QuickCheck+-------------------------------------------------------------------------------++instance Arbitrary ByteString64 where+ arbitrary = BS64 . pack <$> arbitrary+ shrink = shrinkMap (BS64 . pack) (unpack . getBS64)++instance CoArbitrary ByteString64 where+ coarbitrary = coarbitrary . unpack . getBS64++instance Function ByteString64 where+ function = functionMap (unpack . getBS64) (BS64 . pack)++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Binary as Binary+-- >>> import qualified Data.Aeson as Aeson
+ src/Data/ByteString/Base64/URL/Type.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+-- | Strict 'ByteString' base64 encoding with URL and filename safe alphabet.+--+-- See <https://tools.ietf.org/html/rfc4648>.+module Data.ByteString.Base64.URL.Type (+ ByteString64,+ makeByteString64,+ getByteString64,+ mkBS64,+ getBS64,+ getEncodedByteString64,+ ) where++import Prelude ()+import Prelude.Compat++import Control.DeepSeq (NFData (..))+import Data.Aeson+ (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), withText)+import Data.Aeson.Types (FromJSONKeyFunction (..), toJSONKeyText)+import Data.Binary (Binary (..))+import Data.ByteString (ByteString, pack, unpack)+import Data.Data (Data, Typeable)+import Data.Hashable (Hashable)+import Data.Semigroup (Semigroup (..))+import Data.Serialize (Serialize)+import Data.String (IsString (..))+import Data.Text.Encoding (decodeLatin1, encodeUtf8)+import GHC.Generics (Generic)+import Test.QuickCheck+ (Arbitrary (..), CoArbitrary (..), Function (..), functionMap,+ shrinkMap)++import qualified Data.ByteString.Base64.URL as Base64++-- | Aeson serialisable bytestring. Uses base64 encoding.+--+-- The inner 'ByteString' is in raw format.+--+-- >>> let bs64 = makeByteString64 "foobar"+-- >>> bs64+-- mkBS64 "foobar"+--+-- 'Binary' instance doesn't use base64 encoding:+--+-- >>> Binary.encode bs64+-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ACKfoobar"+--+-- 'Aeson' instance does:+--+-- >>> Aeson.encode bs64+-- "\"Zm9vYmFy\""+--+-- This module uses standard alphabet+--+-- >>> Aeson.encode (makeByteString64 "aa\191")+-- "\"YWG_\""+--+newtype ByteString64 = BS64 ByteString+ deriving (Eq, Ord, Data, Typeable, Generic)++instance Show ByteString64 where+ showsPrec d (BS64 bs) = showParen (d > 10) $ showString "mkBS64 " . showsPrec 11 bs++-- | Wrap 'ByteString' into 'ByteString64'. Essentially 'coerce'.+makeByteString64 :: ByteString -> ByteString64+makeByteString64 = BS64++-- | Shorter variant of 'makeByteString64'+mkBS64 :: ByteString -> ByteString64+mkBS64 = makeByteString64++-- | Unwrap 'ByteString' from 'ByteString64'. Essentially 'coerce'.+getByteString64 :: ByteString64 -> ByteString+getByteString64 = \(BS64 bs) -> bs++-- | Shorter variant of 'getByteString64'+getBS64 :: ByteString64 -> ByteString+getBS64 = \(BS64 bs) -> bs++-- | Get base64 encode bytestring+--+-- >>> getEncodedByteString64 "foobar"+-- "Zm9vYmFy"+--+-- >>> getEncodedByteString64 "aa\191"+-- "YWG_"+--+getEncodedByteString64 :: ByteString64 -> ByteString+getEncodedByteString64 = Base64.encode . getBS64++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance IsString ByteString64 where+ fromString = BS64 . fromString++instance Semigroup ByteString64 where+ BS64 a <> BS64 b = BS64 (a <> b)++instance Monoid ByteString64 where+ mempty = BS64 mempty+ mappend = (<>)++instance NFData ByteString64 where rnf x = x `seq` ()+instance Hashable ByteString64++-------------------------------------------------------------------------------+-- aeson+-------------------------------------------------------------------------------++instance ToJSON ByteString64 where+ toJSON = toJSON . decodeLatin1 . getEncodedByteString64+ toEncoding = toEncoding . decodeLatin1 . getEncodedByteString64++instance FromJSON ByteString64 where+ parseJSON = withText "ByteString" $+ either fail (pure . BS64) . Base64.decode . encodeUtf8++instance ToJSONKey ByteString64 where+ toJSONKey = toJSONKeyText (decodeLatin1 . getEncodedByteString64)++instance FromJSONKey ByteString64 where+ fromJSONKey = FromJSONKeyTextParser $+ either fail (pure . BS64) . Base64.decode . encodeUtf8++-------------------------------------------------------------------------------+-- cereal+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Serialize ByteString64++-------------------------------------------------------------------------------+-- binary+-------------------------------------------------------------------------------++-- | 'ByteString64' is serialised as 'ByteString'+instance Binary ByteString64 where+ put = put . getBS64+ get = fmap makeByteString64 get++-------------------------------------------------------------------------------+-- QuickCheck+-------------------------------------------------------------------------------++instance Arbitrary ByteString64 where+ arbitrary = BS64 . pack <$> arbitrary+ shrink = shrinkMap (BS64 . pack) (unpack . getBS64)++instance CoArbitrary ByteString64 where+ coarbitrary = coarbitrary . unpack . getBS64++instance Function ByteString64 where+ function = functionMap (unpack . getBS64) (BS64 . pack)++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Binary as Binary+-- >>> import qualified Data.Aeson as Aeson
+ test/Tests.hs view
@@ -0,0 +1,77 @@+module Main (main) where++import Test.Tasty+import Test.Tasty.QuickCheck (testProperty, (===))++import qualified Data.Aeson as A+import qualified Data.Binary as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64.Lazy.Type as L+import qualified Data.ByteString.Base64.Type as S+import qualified Data.ByteString.Base64.URL.Lazy.Type as UL+import qualified Data.ByteString.Base64.URL.Type as US+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Serialize as C++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests"+ [ aeson+ , binary+ , cereal+ ]++aeson :: TestTree+aeson = testGroup "Aeson"+ [ testProperty "strict" propS+ , testProperty "lazy" propL+ , testProperty "strict url" propUL+ , testProperty "lazy url" propUS+ ]+ where+ propS bs64 = A.decode (A.encode bs64) === Just (bs64 :: S.ByteString64)+ propL bs64 = A.decode (A.encode bs64) === Just (bs64 :: L.ByteString64)+ propUL bs64 = A.decode (A.encode bs64) === Just (bs64 :: UL.ByteString64)+ propUS bs64 = A.decode (A.encode bs64) === Just (bs64 :: US.ByteString64)++binary :: TestTree+binary = testGroup "Binary"+ [ testProperty "strict" propS+ , testProperty "lazy" propL+ , testProperty "strict url" propUL+ , testProperty "lazy url" propUS+ ]+ where+ propS ws = let bs64 = S.makeByteString64 (BS.pack ws)+ in B.decode (B.encode bs64) === bs64++ propL ws = let bs64 = L.makeByteString64 (LBS.pack ws)+ in B.decode (B.encode bs64) === bs64++ propUS ws = let bs64 = US.makeByteString64 (BS.pack ws)+ in B.decode (B.encode bs64) === bs64++ propUL ws = let bs64 = UL.makeByteString64 (LBS.pack ws)+ in B.decode (B.encode bs64) === bs64++cereal :: TestTree+cereal = testGroup "Cereal"+ [ testProperty "strict" propS+ , testProperty "lazy" propL+ , testProperty "strict url" propUL+ , testProperty "lazy url" propUS+ ]+ where+ propS ws = let bs64 = S.makeByteString64 (BS.pack ws)+ in C.decode (C.encode bs64) === Right bs64++ propL ws = let bs64 = L.makeByteString64 (LBS.pack ws)+ in C.decode (C.encode bs64) === Right bs64++ propUS ws = let bs64 = US.makeByteString64 (BS.pack ws)+ in C.decode (C.encode bs64) === Right bs64++ propUL ws = let bs64 = UL.makeByteString64 (LBS.pack ws)+ in C.decode (C.encode bs64) === Right bs64