{-# LANGUAGE CPP #-}
{-# 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.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
import qualified Data.Text as T
#ifdef MIN_VERSION_cereal
import Data.Serialize (Serialize)
#endif
#ifdef MIN_VERSION_serialise
import Codec.Serialise (Serialise (..))
#endif
#ifdef MIN_VERSION_http_api_data
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))
#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'.
-- | 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
-------------------------------------------------------------------------------
#ifdef MIN_VERSION_cereal
-- | 'ByteString64' is serialised as 'ByteString'
--
-- >>> Cereal.encode (mkBS64 "foobar")
-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ACKfoobar"
instance Serialize ByteString64
#endif
-------------------------------------------------------------------------------
-- binary
-------------------------------------------------------------------------------
-- | 'ByteString64' is serialised as 'ByteString'
--
-- >>> Binary.encode (mkBS64 "foobar")
-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ACKfoobar"
instance Binary ByteString64 where
put = put . getBS64
get = fmap makeByteString64 get
-------------------------------------------------------------------------------
-- serialise
-------------------------------------------------------------------------------
#ifdef MIN_VERSION_serialise
-- | >>> Serialise.serialise (mkBS64 "xyzzy")
-- "Exyzzy"
instance Serialise ByteString64 where
encode = encode . getBS64
decode = fmap makeByteString64 decode
#endif
-------------------------------------------------------------------------------
-- http-api-data
-------------------------------------------------------------------------------
#ifdef MIN_VERSION_http_api_data
-- | >>> HTTP.toUrlPiece (mkBS64 $ pack [164..192])
-- "pKWmp6ipqqusra6vsLGys7S1tre4ubq7vL2+v8A="
--
-- /Note:/ the plus in the encoding.
-- Consider using "Data.ByteString.Base64.URL.Type" variant.
instance ToHttpApiData ByteString64 where
toUrlPiece = decodeLatin1 . getEncodedByteString64
toHeader = getEncodedByteString64
instance FromHttpApiData ByteString64 where
parseUrlPiece = either (Left .T.pack) (Right . mkBS64) . Base64.decode . encodeUtf8
parseHeader = either (Left . T.pack) (Right . mkBS64) . Base64.decode
#endif
-------------------------------------------------------------------------------
-- 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 Codec.Serialise as Serialise
-- >>> import qualified Data.Serialize as Cereal
-- >>> import qualified Data.Binary as Binary
-- >>> import qualified Data.Aeson as Aeson
-- >>> import qualified Web.HttpApiData as HTTP