{-|
Module      : Heystone
Description : The Keystone assembler engine.
Copyright   : (c) Adrian Herrera, 2016
License     :  GPL-2

Keystone is a lightweight multi-platform, multi-architecture assembler
framework.

Further information is available at <http://www.keystone-engine.org>.
-}
module Heystone
    ( -- * Assembler control
      Assembler
    , Engine
    , Architecture(..)
    , Mode(..)
    , OptionType(..)
    , OptionValue(..)
    , runAssembler
    , open
    , option
    , assemble

      -- * Error handling
    , Error(..)
    , errno
    , strerror

      -- * Misc.
    , version
    ) where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (runExceptT, throwE)
import Data.ByteString (ByteString, packCStringLen)
import Data.List (intercalate)
import Foreign

import Heystone.Internal.Core
import Heystone.Internal.Keystone

-------------------------------------------------------------------------------
-- Assembler control
-------------------------------------------------------------------------------

-- | Run the Keystone assembler and return a result on success, or an 'Error'
-- on failure.
runAssembler :: Assembler a         -- ^ The assembler code to execute
             -> IO (Either Error a) -- ^ A result on success, or an 'Error' on
                                    -- failure
runAssembler :: forall a. Assembler a -> IO (Either Error a)
runAssembler =
    ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | Create a new instance of the Keystone assembler.
open :: Architecture        -- ^ CPU architecture
     -> [Mode]              -- ^ CPU hardware mode
     -> Assembler Engine    -- ^ A Keystone engine on success, or an 'Error'
                            -- on failure
open :: Architecture -> [Mode] -> Assembler Engine
open Architecture
arch [Mode]
mode = do
    (Error
err, EnginePtr
ksPtr) <- IO (Error, EnginePtr) -> ExceptT Error IO (Error, EnginePtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Error, EnginePtr) -> ExceptT Error IO (Error, EnginePtr))
-> IO (Error, EnginePtr) -> ExceptT Error IO (Error, EnginePtr)
forall a b. (a -> b) -> a -> b
$ Architecture -> [Mode] -> IO (Error, EnginePtr)
ksOpen Architecture
arch [Mode]
mode
    if Error
err Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
ErrOk then
        -- Return a pointer to the Keystone engine if ksOpen completed
        -- successfully
        IO Engine -> Assembler Engine
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Engine -> Assembler Engine) -> IO Engine -> Assembler Engine
forall a b. (a -> b) -> a -> b
$ EnginePtr -> IO Engine
mkEngine EnginePtr
ksPtr
    else
        -- Otherwise return an error
        Error -> Assembler Engine
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
err

option :: Engine        -- ^ Keystone engine handle
       -> OptionType    -- ^ Type of option to set
       -> OptionValue   -- ^ Option value corresponding with the type
       -> Assembler ()  -- ^ An 'Error' on failure
option :: Engine -> OptionType -> OptionValue -> Assembler ()
option Engine
ks OptionType
optType OptionValue
optValue = do
    Error
err <- IO Error -> ExceptT Error IO Error
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Error -> ExceptT Error IO Error)
-> IO Error -> ExceptT Error IO Error
forall a b. (a -> b) -> a -> b
$ Engine -> OptionType -> OptionValue -> IO Error
ksOption Engine
ks OptionType
optType OptionValue
optValue
    if Error
err Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
ErrOk then
        () -> Assembler ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else
        Error -> Assembler ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
err

-- | Assemble a list of statements.
assemble :: Engine                      -- ^ Keystone engine handle
         -> [String]                    -- ^ List of statements to assemble.
         -> Maybe Word64                -- ^ Optional address of the first
                                        -- assembly instruction
         -> Assembler (ByteString, Int) -- ^ Returns the encoded input assembly
                                        -- string and the number of statements
                                        -- successfully processed. Returns an
                                        -- 'Error' on failure
assemble :: Engine -> [String] -> Maybe Word64 -> Assembler (ByteString, Int)
assemble Engine
ks [String]
stmts Maybe Word64
addr = do
    let string :: String
string = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";" [String]
stmts
    (Int
res, Ptr CUChar
encPtr, Int
encSize, Int
statCount) <- IO (Int, Ptr CUChar, Int, Int)
-> ExceptT Error IO (Int, Ptr CUChar, Int, Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Int, Ptr CUChar, Int, Int)
 -> ExceptT Error IO (Int, Ptr CUChar, Int, Int))
-> IO (Int, Ptr CUChar, Int, Int)
-> ExceptT Error IO (Int, Ptr CUChar, Int, Int)
forall a b. (a -> b) -> a -> b
$ Engine -> String -> Word64 -> IO (Int, Ptr CUChar, Int, Int)
ksAsm Engine
ks String
string (Maybe Word64 -> Word64
maybeZ Maybe Word64
addr)
    if Int
res Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
        -- If ksAsm completed successfully, pack the encoded bytes into a
        -- ByteString. Once the encoded bytes have been packed the original
        -- encoded bytes can be freed. The ByteString is returned with the
        -- statement count
        ByteString
bs <- IO ByteString -> ExceptT Error IO ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ExceptT Error IO ByteString)
-> IO ByteString -> ExceptT Error IO ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
packCStringLen (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
encPtr, Int
encSize)
        IO () -> Assembler ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Assembler ()) -> IO () -> Assembler ()
forall a b. (a -> b) -> a -> b
$ Ptr CUChar -> IO ()
ksFree Ptr CUChar
encPtr
        (ByteString, Int) -> Assembler (ByteString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, Int
statCount)
    else do
        -- On failure, call errno for error code
        Error
err <- Engine -> ExceptT Error IO Error
errno Engine
ks
        Error -> Assembler (ByteString, Int)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
err
    where maybeZ :: Maybe Word64 -> Word64
maybeZ = Word64 -> (Word64 -> Word64) -> Maybe Word64 -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
0 Word64 -> Word64
forall a. a -> a
id

-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------

-- | Combined API version & major and minor version numbers. Returns a
-- hexadecimal number as (major << 8 | minor), which encodes both major and
-- minor versions.
version :: Int
version :: Int
version =
    Ptr CUInt -> Ptr CUInt -> Int
ksVersion Ptr CUInt
forall a. Ptr a
nullPtr Ptr CUInt
forall a. Ptr a
nullPtr

-- | Report the 'Error' number when some API function failed.
errno :: Engine             -- ^ Keystone engine handle
      -> Assembler Error    -- ^ The last 'Error' code
errno :: Engine -> ExceptT Error IO Error
errno =
    IO Error -> ExceptT Error IO Error
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Error -> ExceptT Error IO Error)
-> (Engine -> IO Error) -> Engine -> ExceptT Error IO Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> IO Error
ksErrno

-- | Return a string describing the given 'Error'.
strerror :: Error   -- ^ The 'Error' code
         -> String  -- ^ Description of the error code
strerror :: Error -> String
strerror =
    Error -> String
ksStrerror