1-- | 2-- Module : Data.Memory.Encoding.Base16 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Low-level Base16 encoding and decoding. 9-- 10-- If you just want to encode or decode some bytes, you probably want to use 11-- the "Data.ByteArray.Encoding" module. 12-- 13{-# LANGUAGE MagicHash #-} 14{-# LANGUAGE UnboxedTuples #-} 15{-# LANGUAGE OverloadedStrings #-} 16{-# LANGUAGE BangPatterns #-} 17{-# LANGUAGE Rank2Types #-} 18module Data.Memory.Encoding.Base16 19 ( showHexadecimal 20 , toHexadecimal 21 , fromHexadecimal 22 ) where 23 24import Data.Memory.Internal.Compat 25import Data.Word 26import Data.Bits ((.|.)) 27import GHC.Prim 28import GHC.Types 29import GHC.Word 30import Control.Monad 31import Foreign.Storable 32import Foreign.Ptr (Ptr) 33 34-- | Transform a raw memory to an hexadecimal 'String' 35-- 36-- user beware, no checks are made 37showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a) -- ^ a 'with' type of function to hold reference to the object 38 -> Int -- ^ length in bytes 39 -> String 40showHexadecimal withPtr = doChunks 0 41 where 42 doChunks ofs len 43 | len < 4 = doUnique ofs len 44 | otherwise = do 45 let !(W8# a, W8# b, W8# c, W8# d) = unsafeDoIO $ withPtr (read4 ofs) 46 !(# w1, w2 #) = convertByte a 47 !(# w3, w4 #) = convertByte b 48 !(# w5, w6 #) = convertByte c 49 !(# w7, w8 #) = convertByte d 50 in wToChar w1 : wToChar w2 : wToChar w3 : wToChar w4 51 : wToChar w5 : wToChar w6 : wToChar w7 : wToChar w8 52 : doChunks (ofs + 4) (len - 4) 53 54 doUnique ofs len 55 | len == 0 = [] 56 | otherwise = 57 let !(W8# b) = unsafeDoIO $ withPtr (byteIndex ofs) 58 !(# w1, w2 #) = convertByte b 59 in wToChar w1 : wToChar w2 : doUnique (ofs + 1) (len - 1) 60 61 read4 :: Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8) 62 read4 ofs p = 63 liftM4 (,,,) (byteIndex ofs p) (byteIndex (ofs+1) p) 64 (byteIndex (ofs+2) p) (byteIndex (ofs+3) p) 65 66 wToChar :: Word# -> Char 67 wToChar w = toEnum (I# (word2Int# w)) 68 69 byteIndex :: Int -> Ptr Word8 -> IO Word8 70 byteIndex i p = peekByteOff p i 71 72-- | Transform a number of bytes pointed by.@src in the hexadecimal binary representation in @dst 73-- 74-- destination memory need to be of correct size, otherwise it will lead 75-- to really bad things. 76toHexadecimal :: Ptr Word8 -- ^ destination memory 77 -> Ptr Word8 -- ^ source memory 78 -> Int -- ^ number of bytes 79 -> IO () 80toHexadecimal bout bin n = loop 0 81 where loop i 82 | i == n = return () 83 | otherwise = do 84 (W8# w) <- peekByteOff bin i 85 let !(# w1, w2 #) = convertByte w 86 pokeByteOff bout (i * 2) (W8# w1) 87 pokeByteOff bout (i * 2 + 1) (W8# w2) 88 loop (i+1) 89 90-- | Convert a value Word# to two Word#s containing 91-- the hexadecimal representation of the Word# 92convertByte :: Word# -> (# Word#, Word# #) 93convertByte b = (# r tableHi b, r tableLo b #) 94 where 95 r :: Addr# -> Word# -> Word# 96 r table index = indexWord8OffAddr# table (word2Int# index) 97 98 !tableLo = 99 "0123456789abcdef0123456789abcdef\ 100 \0123456789abcdef0123456789abcdef\ 101 \0123456789abcdef0123456789abcdef\ 102 \0123456789abcdef0123456789abcdef\ 103 \0123456789abcdef0123456789abcdef\ 104 \0123456789abcdef0123456789abcdef\ 105 \0123456789abcdef0123456789abcdef\ 106 \0123456789abcdef0123456789abcdef"# 107 !tableHi = 108 "00000000000000001111111111111111\ 109 \22222222222222223333333333333333\ 110 \44444444444444445555555555555555\ 111 \66666666666666667777777777777777\ 112 \88888888888888889999999999999999\ 113 \aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\ 114 \ccccccccccccccccdddddddddddddddd\ 115 \eeeeeeeeeeeeeeeeffffffffffffffff"# 116{-# INLINE convertByte #-} 117 118-- | convert a base16 @src in @dst. 119-- 120-- n need to even 121fromHexadecimal :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int) 122fromHexadecimal dst src n 123 | odd n = error "fromHexadecimal: invalid odd length." 124 | otherwise = loop 0 0 125 where loop di i 126 | i == n = return Nothing 127 | otherwise = do 128 a <- rHi `fmap` peekByteOff src i 129 b <- rLo `fmap` peekByteOff src (i+1) 130 if a == 0xff || b == 0xff 131 then return $ Just i 132 else pokeByteOff dst di (a .|. b) >> loop (di+1) (i+2) 133 134 rLo (W8# index) = W8# (indexWord8OffAddr# tableLo (word2Int# index)) 135 rHi (W8# index) = W8# (indexWord8OffAddr# tableHi (word2Int# index)) 136 137 !tableLo = 138 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 139 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 140 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 141 \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\ 142 \\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 143 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 144 \\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 145 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 146 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 147 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 148 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 149 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 150 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 151 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 152 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 153 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# 154 !tableHi = 155 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 156 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 157 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 158 \\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\ 159 \\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 160 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 161 \\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 162 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 163 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 164 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 165 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 166 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 167 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 168 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 169 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ 170 \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# 171 172