{-# LANGUAGE RecordWildCards, ForeignFunctionInterface, RankNTypes #-}
{-|
Module      : Hapstone.Capstone
Description : a high-level API to hide all the details of using C-style capstone
Copyright   : (c) Inokentiy Babushkin, 2016
License     : BSD3
Maintainer  : Inokentiy Babushkin <inokentiy.babushkin@googlemail.com>
Stability   : experimental

This module wraps all the complex and unsafe details of the capstone API to
provide a simple interface to a disassembler, while retaining a reasonable level
of versatility.

TODO: write a proper user guide here.
-}
module Hapstone.Capstone 
    ( disasmIO
    , disasmSimpleIO
    , Disassembler(..)
    , defaultSkipdataStruct
    , defaultAction
    , mkCallback
    ) where

import Data.Word

import Foreign
import Foreign.C.Types
import Foreign.Ptr

import Hapstone.Internal.Capstone

-- | default setup for skipdata: ".db" string and no callback
defaultSkipdataStruct :: CsSkipdataStruct
defaultSkipdataStruct :: CsSkipdataStruct
defaultSkipdataStruct = String -> CsSkipdataCallback -> Ptr () -> CsSkipdataStruct
CsSkipdataStruct String
".db" CsSkipdataCallback
forall a. FunPtr a
nullFunPtr Ptr ()
forall a. Ptr a
nullPtr

foreign import ccall "wrapper"
  allocCallback :: (Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize)
                -> IO CsSkipdataCallback

-- | wrap a relatively safe function to get a callback
-- "safe" in this context means that the buffer remains unmodified
mkCallback :: Storable a 
           => (([Word8], [Word8]) -> a -> IO CSize)
           -> IO CsSkipdataCallback
mkCallback :: (([Word8], [Word8]) -> a -> IO CSize) -> IO CsSkipdataCallback
mkCallback = (Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize)
-> IO CsSkipdataCallback
allocCallback ((Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize)
 -> IO CsSkipdataCallback)
-> ((([Word8], [Word8]) -> a -> IO CSize)
    -> Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize)
-> (([Word8], [Word8]) -> a -> IO CSize)
-> IO CsSkipdataCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Word8], [Word8]) -> a -> IO CSize)
-> Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize
forall a.
Storable a =>
(([Word8], [Word8]) -> a -> IO CSize)
-> Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize
mkCallback'

mkCallback' :: Storable a
           => (([Word8], [Word8]) -> a -> IO CSize)
           -> Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize
mkCallback' :: (([Word8], [Word8]) -> a -> IO CSize)
-> Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize
mkCallback' ([Word8], [Word8]) -> a -> IO CSize
func Ptr Word8
ptr CSize
size CSize
off Ptr ()
user_data = do
    ([Word8], [Word8])
buf <- Int -> [Word8] -> ([Word8], [Word8])
forall a. Int -> [a] -> ([a], [a])
splitAt (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
off) ([Word8] -> ([Word8], [Word8]))
-> IO [Word8] -> IO ([Word8], [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size) Ptr Word8
ptr
    a
arg <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
user_data)
    ([Word8], [Word8]) -> a -> IO CSize
func ([Word8], [Word8])
buf a
arg

-- | default action to run on each instruction (does nothing)
defaultAction :: Csh -> CsInsn -> IO ()
defaultAction :: CSize -> CsInsn -> IO ()
defaultAction CSize
_ CsInsn
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | a structure holding settings for a disassembling action
data Disassembler a = Disassembler
    { Disassembler a -> CsArch
arch :: CsArch -- ^ architecture
    , Disassembler a -> [CsMode]
modes :: [CsMode] -- ^ disassembling modes
    , Disassembler a -> [Word8]
buffer :: [Word8] -- ^ buffer to disassemble
    , Disassembler a -> Word64
addr :: Word64 -- ^ address of first byte in the buffer
    , Disassembler a -> Int
num :: Int -- ^ number of instructions to disassemble (0 for maximum)
    , Disassembler a -> Bool
detail :: Bool -- ^ include detailed information?
    , Disassembler a -> Maybe CsSkipdataStruct
skip :: Maybe CsSkipdataStruct -- ^ setup SKIPDATA options
    , Disassembler a -> CSize -> CsInsn -> IO a
action :: Csh -> CsInsn -> IO a -- ^ action to run on each instruction
    }

-- | run a disassembler, throwing away the results of the custom action
disasmSimpleIO :: Disassembler a -> IO (Either CsErr [CsInsn])
disasmSimpleIO :: Disassembler a -> IO (Either CsErr [CsInsn])
disasmSimpleIO = (Either CsErr [(CsInsn, a)] -> Either CsErr [CsInsn])
-> IO (Either CsErr [(CsInsn, a)]) -> IO (Either CsErr [CsInsn])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(CsInsn, a)] -> [CsInsn])
-> Either CsErr [(CsInsn, a)] -> Either CsErr [CsInsn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CsInsn, a) -> CsInsn) -> [(CsInsn, a)] -> [CsInsn]
forall a b. (a -> b) -> [a] -> [b]
map (CsInsn, a) -> CsInsn
forall a b. (a, b) -> a
fst)) (IO (Either CsErr [(CsInsn, a)]) -> IO (Either CsErr [CsInsn]))
-> (Disassembler a -> IO (Either CsErr [(CsInsn, a)]))
-> Disassembler a
-> IO (Either CsErr [CsInsn])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Disassembler a -> IO (Either CsErr [(CsInsn, a)])
forall a. Disassembler a -> IO (Either CsErr [(CsInsn, a)])
disasmIO

-- | run a Disassembler, keeping the results of the custom action
disasmIO :: Disassembler a -> IO (Either CsErr [(CsInsn, a)])
disasmIO :: Disassembler a -> IO (Either CsErr [(CsInsn, a)])
disasmIO d :: Disassembler a
d@Disassembler{Bool
Int
[Word8]
[CsMode]
Maybe CsSkipdataStruct
Word64
CsArch
CSize -> CsInsn -> IO a
action :: CSize -> CsInsn -> IO a
skip :: Maybe CsSkipdataStruct
detail :: Bool
num :: Int
addr :: Word64
buffer :: [Word8]
modes :: [CsMode]
arch :: CsArch
action :: forall a. Disassembler a -> CSize -> CsInsn -> IO a
skip :: forall a. Disassembler a -> Maybe CsSkipdataStruct
detail :: forall a. Disassembler a -> Bool
num :: forall a. Disassembler a -> Int
addr :: forall a. Disassembler a -> Word64
buffer :: forall a. Disassembler a -> [Word8]
modes :: forall a. Disassembler a -> [CsMode]
arch :: forall a. Disassembler a -> CsArch
..} = do (CsErr
err, CSize
handle) <- CsArch -> [CsMode] -> IO (CsErr, CSize)
csOpen CsArch
arch [CsMode]
modes
                                 Either CsErr [(CsInsn, a)]
res <- case CsErr
err of
                                          CsErr
CsErrOk -> CSize -> IO (Either CsErr [(CsInsn, a)])
disasmIOWithHandle CSize
handle
                                          CsErr
_ -> Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)]))
-> Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall a b. (a -> b) -> a -> b
$ CsErr -> Either CsErr [(CsInsn, a)]
forall a b. a -> Either a b
Left CsErr
err
                                 CSize -> IO CsErr
csClose CSize
handle
                                 Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall (m :: * -> *) a. Monad m => a -> m a
return Either CsErr [(CsInsn, a)]
res
    where disasmIOWithHandle :: CSize -> IO (Either CsErr [(CsInsn, a)])
disasmIOWithHandle CSize
handle = do
              CsErr
err <- if Bool
detail
                        then CSize -> CsOption -> CsOptionState -> IO CsErr
forall a. Enum a => CSize -> CsOption -> a -> IO CsErr
csOption CSize
handle CsOption
CsOptDetail CsOptionState
CsOptOn
                        else CsErr -> IO CsErr
forall (m :: * -> *) a. Monad m => a -> m a
return CsErr
CsErrOk
              case CsErr
err of
                CsErr
CsErrOk -> CSize -> IO (Either CsErr [(CsInsn, a)])
disasmIOWithHandleDetail CSize
handle
                CsErr
_ -> Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)]))
-> Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall a b. (a -> b) -> a -> b
$ CsErr -> Either CsErr [(CsInsn, a)]
forall a b. a -> Either a b
Left CsErr
err
          disasmIOWithHandleDetail :: CSize -> IO (Either CsErr [(CsInsn, a)])
disasmIOWithHandleDetail CSize
handle = do
              CsErr
err <- CSize -> Maybe CsSkipdataStruct -> IO CsErr
csSetSkipdata CSize
handle Maybe CsSkipdataStruct
skip
              case CsErr
err of
                CsErr
CsErrOk -> do [CsInsn]
insns <- CsArch -> CSize -> [Word8] -> Word64 -> Int -> IO [CsInsn]
csDisasm CsArch
arch CSize
handle [Word8]
buffer Word64
addr Int
num
                              [a]
as <- (CsInsn -> IO a) -> [CsInsn] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CSize -> CsInsn -> IO a
action CSize
handle) [CsInsn]
insns
                              Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)]))
-> ([(CsInsn, a)] -> Either CsErr [(CsInsn, a)])
-> [(CsInsn, a)]
-> IO (Either CsErr [(CsInsn, a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CsInsn, a)] -> Either CsErr [(CsInsn, a)]
forall a b. b -> Either a b
Right ([(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)]))
-> [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall a b. (a -> b) -> a -> b
$ [CsInsn] -> [a] -> [(CsInsn, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CsInsn]
insns [a]
as
                CsErr
_ -> Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)]))
-> Either CsErr [(CsInsn, a)] -> IO (Either CsErr [(CsInsn, a)])
forall a b. (a -> b) -> a -> b
$ CsErr -> Either CsErr [(CsInsn, a)]
forall a b. a -> Either a b
Left CsErr
err