{-# LANGUAGE BangPatterns, MagicHash #-}

-- |
-- Module      : Data.ByteString.Base16
-- 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
    (
      encode
    , decode
    ) where

import Data.ByteString.Char8 (empty)
import Data.ByteString.Internal (ByteString(..), createAndTrim', unsafeCreate)
import Data.Bits (shiftL)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, minusPtr, plusPtr)
import Foreign.Storable (peek, poke)
import System.IO.Unsafe (unsafePerformIO)
import GHC.Prim
import GHC.Types
import GHC.Word

-- | 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 (PS sfp :: ForeignPtr Word8
sfp soff :: Int
soff slen :: Int
slen)
    | Int
slen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 =
        [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "Data.ByteString.Base16.encode: input too long"
    | Bool
otherwise = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (Int
slenInt -> Int -> Int
forall a. Num a => a -> a -> a
*2) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Word8
dptr ->
                    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sptr :: Ptr Word8
sptr ->
                      Ptr Word8 -> Ptr Word8 -> IO ()
enc (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff) Ptr Word8
dptr
 where
  enc :: Ptr Word8 -> Ptr Word8 -> IO ()
enc sptr :: Ptr Word8
sptr = Ptr Word8 -> Ptr Word8 -> IO ()
go Ptr Word8
sptr where
    e :: Ptr b
e = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
slen
    go :: Ptr Word8 -> Ptr Word8 -> IO ()
go s :: Ptr Word8
s d :: Ptr Word8
d | Ptr Word8
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
e = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           | Bool
otherwise = do
      Int
x <- Ptr Word8 -> IO Int
peek8 Ptr Word8
s
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
d (Addr# -> Int -> Word8
tlookup Addr#
tableHi Int
x)
      Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
d Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Addr# -> Int -> Word8
tlookup Addr#
tableLo Int
x)
      Ptr Word8 -> Ptr Word8 -> IO ()
go (Ptr Word8
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Ptr Word8
d Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2)
    tlookup :: Addr# -> Int -> Word8
    tlookup :: Addr# -> Int -> Word8
tlookup table :: Addr#
table (I# index :: Int#
index) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table Int#
index)
    !tableLo :: Addr#
tableLo =
      "\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66\
      \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x61\x62\x63\x64\x65\x66"#
    !tableHi :: Addr#
tableHi =
      "\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\x30\
      \\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\x31\
      \\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\x32\
      \\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\x33\
      \\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\x34\
      \\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\x35\
      \\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\x36\
      \\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\x37\
      \\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\x38\
      \\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\x39\
      \\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\x61\
      \\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\x62\
      \\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\x63\
      \\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\x64\
      \\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\x65\
      \\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66\x66"#

-- | 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.
--
-- Examples:
--
-- > decode "666f6f"  == ("foo", "")
-- > decode "66quux"  == ("f", "quux")
-- > decode "666quux" == ("f", "6quux")
decode :: ByteString -> (ByteString, ByteString)
decode :: ByteString -> (ByteString, ByteString)
decode (PS sfp :: ForeignPtr Word8
sfp soff :: Int
soff slen :: Int
slen) =
  IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> ((Ptr Word8 -> IO (Int, Int, ByteString))
    -> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> IO (ByteString, ByteString)
forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' (Int
slen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) ((Ptr Word8 -> IO (Int, Int, ByteString))
 -> (ByteString, ByteString))
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Word8
dptr ->
      ForeignPtr Word8
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> IO (Int, Int, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Int, Int, ByteString))
 -> IO (Int, Int, ByteString))
-> (Ptr Word8 -> IO (Int, Int, ByteString))
-> IO (Int, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ \sptr :: Ptr Word8
sptr ->
        Ptr Word8 -> Ptr Word8 -> IO (Int, Int, ByteString)
forall b a.
(Storable b, Num a, Num b) =>
Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
dec (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff) Ptr Word8
dptr
 where
  dec :: Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
dec sptr :: Ptr Word8
sptr = Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
forall b a.
(Storable b, Num a, Num b) =>
Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
go Ptr Word8
sptr where
    e :: Ptr b
e = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
slen then Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 else Int
slen
    go :: Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
go s :: Ptr Word8
s d :: Ptr b
d | Ptr Word8
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
e = let len :: Int
len = Ptr Any
forall b. Ptr b
e Ptr Any -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr
                      in (a, Int, ByteString) -> IO (a, Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (0, Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2, ForeignPtr Word8 -> Int -> Int -> ByteString
ps ForeignPtr Word8
sfp (Int
soffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len) (Int
slenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len))
           | Bool
otherwise = do
      Word8
hi <- Int -> Word8
hex (Int -> Word8) -> IO Int -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Int
peek8 Ptr Word8
s
      Word8
lo <- Int -> Word8
hex (Int -> Word8) -> IO Int -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Int
peek8 (Ptr Word8
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1)
      if Word8
lo Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff Bool -> Bool -> Bool
|| Word8
hi Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff
        then let len :: Int
len = Ptr Word8
s Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr
             in (a, Int, ByteString) -> IO (a, Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (0, Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2, ForeignPtr Word8 -> Int -> Int -> ByteString
ps ForeignPtr Word8
sfp (Int
soffInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len) (Int
slenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len))
        else do
          Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
d (b -> IO ()) -> (Word8 -> b) -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word8
lo Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
hi Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 4)
          Ptr Word8 -> Ptr b -> IO (a, Int, ByteString)
go (Ptr Word8
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) (Ptr b
d Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1)

    hex :: Int -> Word8
hex (I# index :: Int#
index) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table Int#
index)
    !table :: Addr#
table =
        "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\
        \\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

peek8 :: Ptr Word8 -> IO Int
peek8 :: Ptr Word8 -> IO Int
peek8 p :: Ptr Word8
p = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p

ps :: ForeignPtr Word8 -> Int -> Int -> ByteString
ps :: ForeignPtr Word8 -> Int -> Int -> ByteString
ps fp :: ForeignPtr Word8
fp off :: Int
off len :: Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = ByteString
empty
    | Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
off Int
len