-- Copyright (c) 2011, Galois Inc.  All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
-- 
--     * Redistributions in binary form must reproduce the above
--       copyright notice, this list of conditions and the following
--       disclaimer in the documentation and/or other materials provided
--       with the distribution.
-- 
--     * Neither the name of Trevor Elliott nor the names of other
--       contributors may be used to endorse or promote products derived
--       from this software without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--

module EVM.Hexdump (prettyHex, simpleHex, paddedShowHex) where

import Data.ByteString                       (ByteString)
import qualified Data.ByteString       as B  (length, unpack)
import qualified Data.ByteString.Char8 as B8 (unpack)
import Data.Char                             (isAscii, isControl)
import Data.List                             (intercalate, transpose, unfoldr)
import Numeric                               (showHex)

byteWidth :: Num a => a
byteWidth :: forall a. Num a => a
byteWidth    = a
2  -- Width of an padded 'Word8'

numWordBytes :: Num a => a
numWordBytes :: forall a. Num a => a
numWordBytes = a
4  -- Number of bytes to group into a 32-bit word

-- |'prettyHex' renders a 'ByteString' as a multi-line 'String' complete with
-- addressing, hex digits, and ASCII representation.
--
-- Sample output
--
-- @Length: 100 (0x64) bytes
--0000:   4b c1 ad 8a  5b 47 d7 57  48 64 e7 cc  5e b5 2f 6e   K...[G.WHd..^./n
--0010:   c5 b3 a4 73  44 3b 97 53  99 2d 54 e7  1b 2f 91 12   ...sD;.S.-T../..
--0020:   c8 1a ff c4  3b 2b 72 ea  97 e2 9f e2  93 ad 23 79   ....;+r.......#y
--0030:   e8 0f 08 54  02 14 fa 09  f0 2d 34 c9  08 6b e1 64   ...T.....-4..k.d
--0040:   d1 c5 98 7e  d6 a1 98 e2  97 da 46 68  4e 60 11 15   ...~......FhN`..
--0050:   d8 32 c6 0b  70 f5 2e 76  7f 8d f2 3b  ed de 90 c6   .2..p..v...;....
--0060:   93 12 9c e1                                          ....@
prettyHex :: Int -> ByteString -> String
prettyHex :: Int -> ByteString -> [Char]
prettyHex Int
hexDisplayWidth ByteString
bs = [[Char]] -> [Char]
unlines ([Char]
header [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
body)
 where
  numLineWords :: Int
numLineWords    = Int
4  -- Number of words to group onto a line
  addressWidth :: Int
addressWidth    = Int
4  -- Minimum width of a padded address
  numLineBytes :: Int
numLineBytes    = Int
numLineWords Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
numWordBytes -- Number of bytes on a line
  replacementChar :: Char
replacementChar = Char
'.' -- 'Char' to use for non-printable characters

  header :: [Char]
header = [Char]
"Length: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show    (ByteString -> Int
B.length ByteString
bs)
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (0x"     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex (ByteString -> Int
B.length ByteString
bs) [Char]
") bytes"

  body :: [[Char]]
body = ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"   ")
       ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[[Char]]]
forall a. [[a]] -> [[a]]
transpose [[[Char]]
mkLineNumbers, ByteString -> [[Char]]
mkHexDisplay ByteString
bs, ByteString -> [[Char]]
mkAsciiDump ByteString
bs]

  mkHexDisplay :: ByteString -> [[Char]]
mkHexDisplay
    = Int -> [[Char]] -> [[Char]]
padLast Int
hexDisplayWidth
    ([[Char]] -> [[Char]])
-> (ByteString -> [[Char]]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"  ") ([[[Char]]] -> [[Char]])
-> (ByteString -> [[[Char]]]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[[Char]]]
forall a. Int -> [a] -> [[a]]
group Int
numLineWords
    ([[Char]] -> [[[Char]]])
-> (ByteString -> [[Char]]) -> ByteString -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" ")  ([[[Char]]] -> [[Char]])
-> (ByteString -> [[[Char]]]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[[Char]]]
forall a. Int -> [a] -> [[a]]
group Int
forall a. Num a => a
numWordBytes
    ([[Char]] -> [[[Char]]])
-> (ByteString -> [[Char]]) -> ByteString -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [Char]) -> [Word8] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8 -> [Char]
forall a. (Show a, Integral a) => Int -> a -> [Char]
paddedShowHex Int
forall a. Num a => a
byteWidth)
    ([Word8] -> [[Char]])
-> (ByteString -> [Word8]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

  mkAsciiDump :: ByteString -> [[Char]]
mkAsciiDump = Int -> [Char] -> [[Char]]
forall a. Int -> [a] -> [[a]]
group Int
numLineBytes ([Char] -> [[Char]])
-> (ByteString -> [Char]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
cleanString ([Char] -> [Char])
-> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B8.unpack

  cleanString :: [Char] -> [Char]
cleanString = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
go
   where
    go :: Char -> Char
go Char
x | Char -> Bool
isWorthPrinting Char
x = Char
x
         | Bool
otherwise         = Char
replacementChar

  mkLineNumbers :: [[Char]]
mkLineNumbers = [Int -> Int -> [Char]
forall a. (Show a, Integral a) => Int -> a -> [Char]
paddedShowHex Int
addressWidth (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numLineBytes) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":"
                   | Int
x <- [Int
0 .. (ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numLineBytes] ]

  padLast :: Int -> [[Char]] -> [[Char]]
padLast Int
w [[Char]
x]         = [[Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
x) Char
' ']
  padLast Int
w ([Char]
x:[[Char]]
xs)      = [Char]
x [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Int -> [[Char]] -> [[Char]]
padLast Int
w [[Char]]
xs
  padLast Int
_ []          = []

-- |'paddedShowHex' displays a number in hexidecimal and pads the number
-- with 0 so that it has a minimum length of @w@.
paddedShowHex :: (Show a, Integral a) => Int -> a -> String
paddedShowHex :: forall a. (Show a, Integral a) => Int -> a -> [Char]
paddedShowHex Int
w a
n = [Char]
pad [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str
    where
     str :: [Char]
str = a -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex a
n [Char]
""
     pad :: [Char]
pad = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str) Char
'0'


-- |'simpleHex' converts a 'ByteString' to a 'String' showing the octets
-- grouped in 32-bit words.
--
-- Sample output
--
-- @4b c1 ad 8a  5b 47 d7 57@
simpleHex :: ByteString -> String
simpleHex :: ByteString -> [Char]
simpleHex = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"  "
          ([[Char]] -> [Char])
-> (ByteString -> [[Char]]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" ") ([[[Char]]] -> [[Char]])
-> (ByteString -> [[[Char]]]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[[Char]]]
forall a. Int -> [a] -> [[a]]
group Int
forall a. Num a => a
numWordBytes
          ([[Char]] -> [[[Char]]])
-> (ByteString -> [[Char]]) -> ByteString -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [Char]) -> [Word8] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8 -> [Char]
forall a. (Show a, Integral a) => Int -> a -> [Char]
paddedShowHex Int
forall a. Num a => a
byteWidth)
          ([Word8] -> [[Char]])
-> (ByteString -> [Word8]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

-- |'isWorthPrinting' returns 'True' for non-control ascii characters.
-- These characters will all fit in a single character when rendered.
isWorthPrinting :: Char -> Bool
isWorthPrinting :: Char -> Bool
isWorthPrinting Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isControl Char
x)

-- |'group' breaks up a list into sublists of size @n@. The last group
-- may be smaller than @n@ elements. When @n@ less not positive the
-- list is returned as one sublist.
group :: Int -> [a] -> [[a]]
group :: forall a. Int -> [a] -> [[a]]
group Int
n
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = ([a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[])
 | Bool
otherwise = ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [a] -> Maybe ([a], [a])
go
  where
    go :: [a] -> Maybe ([a], [a])
go [] = Maybe ([a], [a])
forall a. Maybe a
Nothing
    go [a]
xs = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs)