{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Data.ByteString.Base16.Lazy
-- Copyright   : (c) 2011 MailRank, Inc.
--
-- License     : BSD
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Fast and efficient encoding and decoding of base16-encoded strings.

module Data.ByteString.Base16.Lazy
    (
      encode
    , decode
    ) where

import Data.Word (Word8)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Lazy.Internal

-- | Encode a string into base16 form.  The result will always be a
-- multiple of 2 bytes in length.
--
-- Example:
--
-- > encode "foo"  == "666f6f"
encode :: ByteString -> ByteString
encode :: ByteString -> ByteString
encode (Chunk c :: ByteString
c cs :: ByteString
cs) = ByteString -> ByteString -> ByteString
Chunk (ByteString -> ByteString
B16.encode ByteString
c) (ByteString -> ByteString
encode ByteString
cs)
encode Empty        = ByteString
Empty

-- | Decode a string from base16 form. The first element of the
-- returned tuple contains the decoded data. The second element starts
-- at the first invalid base16 sequence in the original string.
--
-- This function operates as lazily as possible over the input chunks.
--
-- Examples:
--
-- > decode "666f6f"  == ("foo", "")
-- > decode "66quux"  == ("f", "quux")
-- > decode "666quux" == ("f", "6quux")
decode :: ByteString -> (ByteString, ByteString)
decode :: ByteString -> (ByteString, ByteString)
decode = Maybe Word8 -> ByteString -> (ByteString, ByteString)
go Maybe Word8
forall a. Maybe a
Nothing
  where
      go :: Maybe Word8 -> ByteString -> (ByteString, ByteString)
      go :: Maybe Word8 -> ByteString -> (ByteString, ByteString)
go Nothing Empty = (ByteString
Empty, ByteString
Empty)
      go (Just w :: Word8
w) Empty = (ByteString
Empty, Word8 -> ByteString
BL.singleton Word8
w)
      go (Just w :: Word8
w) (Chunk c :: ByteString
c z :: ByteString
z) =
           Maybe Word8 -> ByteString -> (ByteString, ByteString)
go Maybe Word8
forall a. Maybe a
Nothing (ByteString -> ByteString -> ByteString
chunk ([Word8] -> ByteString
B.pack [Word8
w, ByteString -> Word8
B.unsafeHead ByteString
c]) (ByteString -> ByteString -> ByteString
chunk (ByteString -> ByteString
B.unsafeTail ByteString
c) ByteString
z))
      go Nothing (Chunk c :: ByteString
c z :: ByteString
z)
           | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
                 let ~(res :: ByteString
res,tail' :: ByteString
tail') = Maybe Word8 -> ByteString -> (ByteString, ByteString)
go Maybe Word8
forall a. Maybe a
Nothing ByteString
z
                 in (ByteString -> ByteString -> ByteString
chunk ByteString
h ByteString
res, ByteString
tail')
           | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Word8 -> Bool
isHex (ByteString -> Word8
B.unsafeHead ByteString
t) =
                 let ~(res :: ByteString
res,tail' :: ByteString
tail') = Maybe Word8 -> ByteString -> (ByteString, ByteString)
go (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (ByteString -> Word8
B.unsafeHead ByteString
t)) ByteString
z
                 in (ByteString -> ByteString -> ByteString
chunk ByteString
h ByteString
res, ByteString
tail')
           | Bool
otherwise = (ByteString -> ByteString -> ByteString
chunk ByteString
h ByteString
Empty, ByteString -> ByteString -> ByteString
chunk ByteString
t ByteString
z)
            where (h :: ByteString
h,t :: ByteString
t) = ByteString -> (ByteString, ByteString)
B16.decode ByteString
c
                  len :: Int
len = ByteString -> Int
B.length ByteString
t

isHex :: Word8 -> Bool
isHex :: Word8 -> Bool
isHex w :: Word8
w = (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 57) Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 97 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 102) Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 65 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 70)