module Data.ByteString.Base16
( encode
, decode
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Internal as Internal
import Foreign.Storable (peek, poke)
import Foreign.Ptr (plusPtr, Ptr)
import System.IO.Unsafe (unsafePerformIO)
import Data.ByteString.BaseN
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.Word
encode :: B8.ByteString -> B8.ByteString
encode = encodeAlphabet hexlower
decode :: B8.ByteString -> Either String B8.ByteString
decode = decodeAlphabet hexlower
encodeAlphabet :: Enc -> B8.ByteString -> B8.ByteString
encodeAlphabet enc src@(Internal.PS sfp soff slen) =
unsafePerformIO $ byChunk 1 (slen * 2) onchunk onend src
where
encodeNibble :: (Word8 -> Word8) -> Ptr Word8 -> IO Word8
encodeNibble fn p = encodeWord enc . fn <$> peek p
onchunk :: Ptr Word8 -> Ptr Word8 -> IO Int
onchunk sp dp = do
poke dp =<< encodeNibble leftNibble sp
poke (dp `plusPtr` 1) =<< encodeNibble rightNibble sp
return 2
onend :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
onend sp dp rem = return ()
decodeAlphabet :: Enc -> B8.ByteString -> Either String B8.ByteString
decodeAlphabet enc src@(Internal.PS sfp soff slen)
| slen == 0 = Right BS.empty
| otherwise =
unsafePerformIO $ byChunkErr 2 dlen onchunk onend src
where
dlen = slen `div` 2
onchunk :: Ptr Word8 -> Ptr Word8 -> IO (Either String Int)
onchunk sp dp = do
leftNibble <- decodeWord enc <$> peek sp
rightNibble <- decodeWord enc <$> peek (sp `plusPtr` 1)
case (.|.) <$> fmap (`shiftL` 4) leftNibble <*> rightNibble of
Left err -> do
l <- peek sp :: IO Word8
r <- peek (sp `plusPtr` 1) :: IO Word8
return $ Left $ "Invalid byte encountered. One of: " ++ B8.unpack (BS.pack [l,r])
Right w -> do
poke dp w
return $ Right 1
onend :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Either String Int)
onend sp dp rem = onchunk sp dp >> return (Right dlen)
leftNibble :: Word8 -> Word8
leftNibble n = n `shiftR` 4
rightNibble :: Word8 -> Word8
rightNibble n = 0x0F .&. n
hexlower :: Enc
hexlower = mkEnc "0123456789abcdef"
hexupper :: Enc
hexupper = mkEnc "0123456789ABCDEF"