1-- |
2-- Module      : Data.ByteArray.Encoding
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Base conversions for 'ByteArray'.
9--
10module Data.ByteArray.Encoding
11    ( convertToBase
12    , convertFromBase
13    , Base(..)
14    ) where
15
16import           Data.ByteArray.Types
17import qualified Data.ByteArray.Types        as B
18import qualified Data.ByteArray.Methods      as B
19import           Data.Memory.Internal.Compat
20import           Data.Memory.Encoding.Base16
21import           Data.Memory.Encoding.Base32
22import           Data.Memory.Encoding.Base64
23
24-- $setup
25-- >>> :set -XOverloadedStrings
26-- >>> import Data.ByteString
27
28-- | The different bases that can be used.
29--
30-- See <http://tools.ietf.org/html/rfc4648 RFC4648> for details.
31-- In particular, Base64 can be standard or
32-- <http://tools.ietf.org/html/rfc4648#section-5 URL-safe>. URL-safe
33-- encoding is often used in other specifications without
34-- <http://tools.ietf.org/html/rfc4648#section-3.2 padding> characters.
35--
36-- ==== Examples
37--
38-- A quick example to show the differences:
39--
40-- >>> let input = "Is 3 > 2?" :: ByteString
41-- >>> let convertedTo base = convertToBase base input :: ByteString
42-- >>> convertedTo Base16
43-- "49732033203e20323f"
44-- >>> convertedTo Base32
45-- "JFZSAMZAHYQDEPY="
46-- >>> convertedTo Base64
47-- "SXMgMyA+IDI/"
48-- >>> convertedTo Base64URLUnpadded
49-- "SXMgMyA-IDI_"
50-- >>> convertedTo Base64OpenBSD
51-- "QVKeKw.8GBG9"
52--
53data Base = Base16            -- ^ similar to hexadecimal
54          | Base32
55          | Base64            -- ^ standard Base64
56          | Base64URLUnpadded -- ^ unpadded URL-safe Base64
57          | Base64OpenBSD     -- ^ Base64 as used in OpenBSD password encoding (such as bcrypt)
58          deriving (Show,Eq)
59
60-- | Encode some bytes to the equivalent representation in a specific 'Base'.
61--
62-- ==== Examples
63--
64-- Convert a 'ByteString' to base-64:
65--
66-- >>> convertToBase Base64 ("foobar" :: ByteString) :: ByteString
67-- "Zm9vYmFy"
68--
69convertToBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> bout
70convertToBase base b = case base of
71    Base16 -> doConvert (binLength * 2) toHexadecimal
72    Base32 -> let (q,r)  = binLength `divMod` 5
73                  outLen = 8 * (if r == 0 then q else q + 1)
74               in doConvert outLen toBase32
75    Base64 -> doConvert base64Length toBase64
76    -- Base64URL         -> doConvert base64Length (toBase64URL True)
77    Base64URLUnpadded -> doConvert base64UnpaddedLength (toBase64URL False)
78    Base64OpenBSD     -> doConvert base64UnpaddedLength toBase64OpenBSD
79  where
80    binLength = B.length b
81
82    base64Length = let (q,r) = binLength `divMod` 3
83                    in 4 * (if r == 0 then q else q+1)
84
85    base64UnpaddedLength = let (q,r) = binLength `divMod` 3
86                            in 4 * q + (if r == 0 then 0 else r+1)
87    doConvert l f =
88        B.unsafeCreate l $ \bout ->
89        B.withByteArray b     $ \bin  ->
90            f bout bin binLength
91
92-- | Try to decode some bytes from the equivalent representation in a specific 'Base'.
93--
94-- ==== Examples
95--
96-- Successfully convert from base-64 to a 'ByteString':
97--
98-- >>> convertFromBase Base64 ("Zm9vYmFy" :: ByteString) :: Either String ByteString
99-- Right "foobar"
100--
101-- Trying to decode invalid data will return an error string:
102--
103-- >>> convertFromBase Base64 ("!!!" :: ByteString) :: Either String ByteString
104-- Left "base64: input: invalid length"
105--
106convertFromBase :: (ByteArrayAccess bin, ByteArray bout) => Base -> bin -> Either String bout
107convertFromBase Base16 b
108    | odd (B.length b) = Left "base16: input: invalid length"
109    | otherwise        = unsafeDoIO $ do
110        (ret, out) <-
111            B.allocRet (B.length b `div` 2) $ \bout ->
112            B.withByteArray b               $ \bin  ->
113                fromHexadecimal bout bin (B.length b)
114        case ret of
115            Nothing  -> return $ Right out
116            Just ofs -> return $ Left ("base16: input: invalid encoding at offset: " ++ show ofs)
117convertFromBase Base32 b = unsafeDoIO $
118    withByteArray b $ \bin -> do
119        mDstLen <- unBase32Length bin (B.length b)
120        case mDstLen of
121            Nothing     -> return $ Left "base32: input: invalid length"
122            Just dstLen -> do
123                (ret, out) <- B.allocRet dstLen $ \bout -> fromBase32 bout bin (B.length b)
124                case ret of
125                    Nothing  -> return $ Right out
126                    Just ofs -> return $ Left ("base32: input: invalid encoding at offset: " ++ show ofs)
127convertFromBase Base64 b = unsafeDoIO $
128    withByteArray b $ \bin -> do
129        mDstLen <- unBase64Length bin (B.length b)
130        case mDstLen of
131            Nothing     -> return $ Left "base64: input: invalid length"
132            Just dstLen -> do
133                (ret, out) <- B.allocRet dstLen $ \bout -> fromBase64 bout bin (B.length b)
134                case ret of
135                    Nothing  -> return $ Right out
136                    Just ofs -> return $ Left ("base64: input: invalid encoding at offset: " ++ show ofs)
137convertFromBase Base64URLUnpadded b = unsafeDoIO $
138    withByteArray b $ \bin ->
139        case unBase64LengthUnpadded (B.length b) of
140            Nothing     -> return $ Left "base64URL unpadded: input: invalid length"
141            Just dstLen -> do
142                (ret, out) <- B.allocRet dstLen $ \bout -> fromBase64URLUnpadded bout bin (B.length b)
143                case ret of
144                    Nothing  -> return $ Right out
145                    Just ofs -> return $ Left ("base64URL unpadded: input: invalid encoding at offset: " ++ show ofs)
146convertFromBase Base64OpenBSD b = unsafeDoIO $
147    withByteArray b $ \bin ->
148        case unBase64LengthUnpadded (B.length b) of
149            Nothing     -> return $ Left "base64 unpadded: input: invalid length"
150            Just dstLen -> do
151                (ret, out) <- B.allocRet dstLen $ \bout -> fromBase64OpenBSD bout bin (B.length b)
152                case ret of
153                    Nothing  -> return $ Right out
154                    Just ofs -> return $ Left ("base64 unpadded: input: invalid encoding at offset: " ++ show ofs)
155
156