-- |
-- Module      : Binja.Function
-- Description : Function interface
-- License     : MIT
-- Maintainer  : hello@bloombit.dev
-- Stability   : alpha
--
-- @Binja.Function@ extracts metadata given function handles and converts function handles between
-- intermediate language types.
module Binja.Function
  ( Binja.Function.start,
    Binja.Function.highestAddress,
    Binja.Function.lowestAddress,
    Binja.Function.symbol,
    Binja.Function.auto,
    Binja.Function.architecture,
    Binja.Function.hasUserAnnotations,
    Binja.Function.hasExplicitlyDefinedType,
    Binja.Function.needsUpdate,
    Binja.Function.hasUnresolvedIndirectBranches,
    Binja.Function.getComment,
    Binja.Function.setComment,
    Binja.Function.ssaVars,
    Binja.Function.aliasedVars,
    Binja.Function.parameterVars,
    Binja.Function.llil,
    Binja.Function.mlil,
    Binja.Function.mlilToSSA,
    Binja.Function.mlilSSA,
    Binja.Function.mlilToRawFunction,
    Binja.Function.print,
  )
where

import Binja.FFI
import Binja.Symbol
import Binja.Types (Architecture (..), BNFunctionPtr, BNLlilFunctionPtr, BNMlilFunctionPtr, BNMlilSSAFunctionPtr, BNParameterVariablesWithConfidence (..), BNSSAVariable (..), BNVariable, CSize, ParameterVars (..), Symbol, Word64, alloca, getArch, newCString, nullPtr, peek, peekArray, peekCString, rawVar, version, when)
import Binja.Utils
import Control.Monad (unless)

start :: BNFunctionPtr -> IO Word64
start :: BNFunctionPtr -> IO Word64
start = BNFunctionPtr -> IO Word64
c_BNGetFunctionStart

highestAddress :: BNFunctionPtr -> IO Word64
highestAddress :: BNFunctionPtr -> IO Word64
highestAddress = BNFunctionPtr -> IO Word64
c_BNGetFunctionHighestAddress

lowestAddress :: BNFunctionPtr -> IO Word64
lowestAddress :: BNFunctionPtr -> IO Word64
lowestAddress = BNFunctionPtr -> IO Word64
c_BNGetFunctionLowestAddress

symbol :: BNFunctionPtr -> IO Symbol
symbol :: BNFunctionPtr -> IO Symbol
symbol BNFunctionPtr
func = do
  p <- BNFunctionPtr -> IO BNSymbolPtr
c_BNGetFunctionSymbol BNFunctionPtr
func
  if p == nullPtr
    then error "c_BNGetFunctionSymbol evaluated to null"
    else Binja.Symbol.create p

auto :: BNFunctionPtr -> IO Bool
auto :: BNFunctionPtr -> IO Bool
auto = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
Binja.Utils.toBool (IO CBool -> IO Bool)
-> (BNFunctionPtr -> IO CBool) -> BNFunctionPtr -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BNFunctionPtr -> IO CBool
c_BNWasFunctionAutomaticallyDiscovered

hasUserAnnotations :: BNFunctionPtr -> IO Bool
hasUserAnnotations :: BNFunctionPtr -> IO Bool
hasUserAnnotations = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
Binja.Utils.toBool (IO CBool -> IO Bool)
-> (BNFunctionPtr -> IO CBool) -> BNFunctionPtr -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BNFunctionPtr -> IO CBool
c_BNFunctionHasUserAnnotations

hasExplicitlyDefinedType :: BNFunctionPtr -> IO Bool
hasExplicitlyDefinedType :: BNFunctionPtr -> IO Bool
hasExplicitlyDefinedType = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
Binja.Utils.toBool (IO CBool -> IO Bool)
-> (BNFunctionPtr -> IO CBool) -> BNFunctionPtr -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BNFunctionPtr -> IO CBool
c_BNFunctionHasExplicitlyDefinedType

needsUpdate :: BNFunctionPtr -> IO Bool
needsUpdate :: BNFunctionPtr -> IO Bool
needsUpdate = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
Binja.Utils.toBool (IO CBool -> IO Bool)
-> (BNFunctionPtr -> IO CBool) -> BNFunctionPtr -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BNFunctionPtr -> IO CBool
c_BNIsFunctionUpdateNeeded

hasUnresolvedIndirectBranches :: BNFunctionPtr -> IO Bool
hasUnresolvedIndirectBranches :: BNFunctionPtr -> IO Bool
hasUnresolvedIndirectBranches = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
Binja.Utils.toBool (IO CBool -> IO Bool)
-> (BNFunctionPtr -> IO CBool) -> BNFunctionPtr -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BNFunctionPtr -> IO CBool
c_BNHasUnresolvedIndirectBranches

getComment :: BNFunctionPtr -> IO String
getComment :: BNFunctionPtr -> IO [Char]
getComment BNFunctionPtr
func = do
  cStr <- BNFunctionPtr -> IO CString
c_BNGetFunctionComment BNFunctionPtr
func
  peekCString cStr

architecture :: BNMlilSSAFunctionPtr -> IO Architecture
architecture :: BNMlilSSAFunctionPtr -> IO Architecture
architecture BNMlilSSAFunctionPtr
ssaHandle' = do
  rawHandle' <- BNMlilSSAFunctionPtr -> IO BNFunctionPtr
Binja.Function.mlilToRawFunction BNMlilSSAFunctionPtr
ssaHandle'
  archHandle <- c_BNGetFunctionArchitecture rawHandle'
  cStr <- c_BNGetArchitectureName archHandle
  resolvedStr <- peekCString cStr
  getArch resolvedStr

setComment :: BNFunctionPtr -> String -> IO ()
setComment :: BNFunctionPtr -> [Char] -> IO ()
setComment BNFunctionPtr
func [Char]
comment = do
  cStr <- [Char] -> IO CString
newCString [Char]
comment
  c_BNSetFunctionComment func cStr

ssaVars :: BNMlilSSAFunctionPtr -> IO [BNSSAVariable]
ssaVars :: BNMlilSSAFunctionPtr -> IO [BNSSAVariable]
ssaVars BNMlilSSAFunctionPtr
func = do
  (Ptr CSize -> IO [BNSSAVariable]) -> IO [BNSSAVariable]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO [BNSSAVariable]) -> IO [BNSSAVariable])
-> (Ptr CSize -> IO [BNSSAVariable]) -> IO [BNSSAVariable]
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
countVarPtr -> do
    rawVarPtr <- BNMlilSSAFunctionPtr -> Ptr CSize -> IO (Ptr BNVariable)
c_BNGetMediumLevelILVariables BNMlilSSAFunctionPtr
func Ptr CSize
countVarPtr
    countVar <- fromIntegral <$> peek countVarPtr
    rawVarList <-
      if rawVarPtr == nullPtr || countVar == 0
        then pure []
        else peekArray countVar rawVarPtr
    alloca $ \Ptr CSize
countVersionPtr -> do
      rawVersionPtr <- BNMlilSSAFunctionPtr
-> Ptr BNVariable -> Ptr CSize -> IO (Ptr CSize)
c_BNGetMediumLevelILVariableSSAVersions BNMlilSSAFunctionPtr
func Ptr BNVariable
rawVarPtr Ptr CSize
countVersionPtr
      countVersion <- fromIntegral <$> peek countVersionPtr
      rawVersionList <-
        if rawVersionPtr == nullPtr
          then pure []
          else peekArray countVersion rawVersionPtr
      when (rawVarPtr /= nullPtr) $ c_BNFreeVariableList rawVarPtr
      when (rawVersionPtr /= nullPtr) $ c_BNFreeILInstructionList rawVersionPtr
      pure $ zipWith createSSAVar rawVarList rawVersionList
  where
    createSSAVar :: BNVariable -> CSize -> BNSSAVariable
    createSSAVar :: BNVariable -> CSize -> BNSSAVariable
createSSAVar BNVariable
var CSize
ver =
      BNSSAVariable
        { rawVar :: BNVariable
rawVar = BNVariable
var,
          version :: Int
version = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
ver
        }

aliasedVars :: BNMlilSSAFunctionPtr -> IO [BNVariable]
aliasedVars :: BNMlilSSAFunctionPtr -> IO [BNVariable]
aliasedVars BNMlilSSAFunctionPtr
func = do
  (Ptr CSize -> IO [BNVariable]) -> IO [BNVariable]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO [BNVariable]) -> IO [BNVariable])
-> (Ptr CSize -> IO [BNVariable]) -> IO [BNVariable]
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
countVarPtr -> do
    rawVarPtr <- BNMlilSSAFunctionPtr -> Ptr CSize -> IO (Ptr BNVariable)
c_BNGetMediumLevelILAliasedVariables BNMlilSSAFunctionPtr
func Ptr CSize
countVarPtr
    countVar <- fromIntegral <$> peek countVarPtr
    rawVarList <-
      if rawVarPtr == nullPtr || countVar == 0
        then pure []
        else peekArray countVar rawVarPtr
    when (rawVarPtr /= nullPtr) $ c_BNFreeVariableList rawVarPtr
    pure rawVarList

parameterVars :: BNMlilSSAFunctionPtr -> IO ParameterVars
parameterVars :: BNMlilSSAFunctionPtr -> IO ParameterVars
parameterVars BNMlilSSAFunctionPtr
func =
  (Ptr BNParameterVariablesWithConfidence -> IO ParameterVars)
-> IO ParameterVars
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr BNParameterVariablesWithConfidence -> IO ParameterVars)
 -> IO ParameterVars)
-> (Ptr BNParameterVariablesWithConfidence -> IO ParameterVars)
-> IO ParameterVars
forall a b. (a -> b) -> a -> b
$ \Ptr BNParameterVariablesWithConfidence
pv -> do
    rawFuncHandle <- BNMlilSSAFunctionPtr -> IO BNFunctionPtr
Binja.Function.mlilToRawFunction BNMlilSSAFunctionPtr
func
    _ <- c_BNGetFunctionParameterVariablesPtr pv rawFuncHandle
    result <- do
      bnParameterVar <- peek pv
      if pvCount bnParameterVar == 0
        then
          pure $
            ParameterVars
              { vars = [],
                confidence = fromIntegral $ pvConfidence bnParameterVar
              }
        else do
          vars' <- peekArray (fromIntegral $ pvCount bnParameterVar) (pvVarPtr bnParameterVar)
          pure $
            ParameterVars
              { vars = vars',
                confidence = fromIntegral $ pvConfidence bnParameterVar
              }
    when (pv /= nullPtr) $ c_BNFreeParameterVariables pv
    pure result

llil :: BNFunctionPtr -> IO BNLlilFunctionPtr
llil :: BNFunctionPtr -> IO BNLlilFunctionPtr
llil BNFunctionPtr
func = do
  if BNFunctionPtr
func BNFunctionPtr -> BNFunctionPtr -> Bool
forall a. Eq a => a -> a -> Bool
== BNFunctionPtr
forall a. Ptr a
nullPtr
    then [Char] -> IO BNLlilFunctionPtr
forall a. HasCallStack => [Char] -> a
error [Char]
"llil: func == nullPtr"
    else do
      llilFuncPtr <- BNFunctionPtr -> IO BNLlilFunctionPtr
c_BNGetFunctionLowLevelIL BNFunctionPtr
func
      if llilFuncPtr == nullPtr
        then error "llil: c_BNGetFunctionLowLevelIL evaluated to nullPtr"
        else pure llilFuncPtr

mlil :: BNFunctionPtr -> IO BNMlilFunctionPtr
mlil :: BNFunctionPtr -> IO BNMlilFunctionPtr
mlil BNFunctionPtr
func = do
  if BNFunctionPtr
func BNFunctionPtr -> BNFunctionPtr -> Bool
forall a. Eq a => a -> a -> Bool
== BNFunctionPtr
forall a. Ptr a
nullPtr
    then [Char] -> IO BNMlilFunctionPtr
forall a. HasCallStack => [Char] -> a
error [Char]
"mlil: func == nullPtr"
    else do
      mlilFuncPtr <- BNFunctionPtr -> IO BNMlilFunctionPtr
c_BNGetFunctionMediumLevelIL BNFunctionPtr
func
      if mlilFuncPtr == nullPtr
        then do
          Binja.Function.print func
          error "Binja.Function.mlil: c_BNGetFunctionMediumLevelIL evaluated to nullPtr"
        else pure mlilFuncPtr

mlilToSSA :: BNMlilFunctionPtr -> IO BNMlilSSAFunctionPtr
mlilToSSA :: BNMlilFunctionPtr -> IO BNMlilSSAFunctionPtr
mlilToSSA BNMlilFunctionPtr
func = do
  p <- BNMlilFunctionPtr -> IO BNMlilSSAFunctionPtr
c_BNGetMediumLevelILSSAForm BNMlilFunctionPtr
func
  if p == nullPtr
    then error "mlilToSSA: c_BNGetMediumLevelILSSAForm evaluated to nullPtr"
    else pure p

mlilSSA :: BNFunctionPtr -> IO BNMlilSSAFunctionPtr
mlilSSA :: BNFunctionPtr -> IO BNMlilSSAFunctionPtr
mlilSSA BNFunctionPtr
func = do
  mlilFunc <- BNFunctionPtr -> IO BNMlilFunctionPtr
mlil BNFunctionPtr
func
  c_BNGetMediumLevelILSSAForm mlilFunc

mlilToRawFunction :: BNMlilSSAFunctionPtr -> IO BNFunctionPtr
mlilToRawFunction :: BNMlilSSAFunctionPtr -> IO BNFunctionPtr
mlilToRawFunction BNMlilSSAFunctionPtr
func = do
  rawFunc <- BNMlilSSAFunctionPtr -> IO BNFunctionPtr
c_BNGetMediumLevelILOwnerFunction BNMlilSSAFunctionPtr
func
  if rawFunc == nullPtr
    then error "mlilToRawFunction: BNGetMediumLevelILOwnerFunction evaluated to null"
    else pure rawFunc

print :: BNFunctionPtr -> IO ()
print :: BNFunctionPtr -> IO ()
print BNFunctionPtr
func = do
  s <- BNFunctionPtr -> IO Word64
start BNFunctionPtr
func
  hi <- highestAddress func
  lo <- lowestAddress func
  mSym <- symbol func
  isAuto <- Binja.Function.auto func
  userAnn <- hasUserAnnotations func
  explTy <- hasExplicitlyDefinedType func
  upd <- needsUpdate func
  indBr <- hasUnresolvedIndirectBranches func
  cmt <- getComment func
  putStrLn "== BNFunction =="
  putStrLn $ "  start: " ++ show s
  putStrLn $ "  lowestAddress: " ++ show lo
  putStrLn $ "  highestAddress: " ++ show hi
  putStrLn $ "  symbol: " ++ show mSym
  putStrLn $ "  automaticallyDiscovered: " ++ show isAuto
  putStrLn $ "  hasUserAnnotations: " ++ show userAnn
  putStrLn $ "  hasExplicitlyDefinedType: " ++ show explTy
  putStrLn $ "  needsUpdate: " ++ show upd
  putStrLn $ "  unresolvedIndirectBranches: " ++ show indBr
  unless (null cmt) $
    putStrLn $
      "  comment:  " ++ cmt