{-# LANGUAGE PartialTypeSignatures , FlexibleContexts, Strict, StandaloneDeriving, DeriveGeneric, ExistentialQuantification #-}

module Data.Binary where

import Base


import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Word 

import GHC.Generics
import qualified Data.Serialize as Cereal hiding (get,put)


-- |  Information on the sections in the binary
data SectionsInfo = SectionsInfo {
  SectionsInfo -> [(String, String, Word64, Word64)]
si_sections    :: [(String,String,Word64,Word64)], -- ^ Sections: segment names, section names, addresses and sizes.
  SectionsInfo -> Word64
si_min_address :: Word64,
  SectionsInfo -> Word64
si_max_address :: Word64
 }
 deriving (Int -> SectionsInfo -> ShowS
[SectionsInfo] -> ShowS
SectionsInfo -> String
(Int -> SectionsInfo -> ShowS)
-> (SectionsInfo -> String)
-> ([SectionsInfo] -> ShowS)
-> Show SectionsInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SectionsInfo] -> ShowS
$cshowList :: [SectionsInfo] -> ShowS
show :: SectionsInfo -> String
$cshow :: SectionsInfo -> String
showsPrec :: Int -> SectionsInfo -> ShowS
$cshowsPrec :: Int -> SectionsInfo -> ShowS
Show,(forall x. SectionsInfo -> Rep SectionsInfo x)
-> (forall x. Rep SectionsInfo x -> SectionsInfo)
-> Generic SectionsInfo
forall x. Rep SectionsInfo x -> SectionsInfo
forall x. SectionsInfo -> Rep SectionsInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SectionsInfo x -> SectionsInfo
$cfrom :: forall x. SectionsInfo -> Rep SectionsInfo x
Generic,SectionsInfo -> SectionsInfo -> Bool
(SectionsInfo -> SectionsInfo -> Bool)
-> (SectionsInfo -> SectionsInfo -> Bool) -> Eq SectionsInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SectionsInfo -> SectionsInfo -> Bool
$c/= :: SectionsInfo -> SectionsInfo -> Bool
== :: SectionsInfo -> SectionsInfo -> Bool
$c== :: SectionsInfo -> SectionsInfo -> Bool
Eq)


-- | Relocations
data Relocation = R_X86_64_RELATIVE Word64 Word64 -- ^ At address a0, address a1 has been written
 deriving (Int -> Relocation -> ShowS
[Relocation] -> ShowS
Relocation -> String
(Int -> Relocation -> ShowS)
-> (Relocation -> String)
-> ([Relocation] -> ShowS)
-> Show Relocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relocation] -> ShowS
$cshowList :: [Relocation] -> ShowS
show :: Relocation -> String
$cshow :: Relocation -> String
showsPrec :: Int -> Relocation -> ShowS
$cshowsPrec :: Int -> Relocation -> ShowS
Show,(forall x. Relocation -> Rep Relocation x)
-> (forall x. Rep Relocation x -> Relocation) -> Generic Relocation
forall x. Rep Relocation x -> Relocation
forall x. Relocation -> Rep Relocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relocation x -> Relocation
$cfrom :: forall x. Relocation -> Rep Relocation x
Generic,Relocation -> Relocation -> Bool
(Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool) -> Eq Relocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relocation -> Relocation -> Bool
$c/= :: Relocation -> Relocation -> Bool
== :: Relocation -> Relocation -> Bool
$c== :: Relocation -> Relocation -> Bool
Eq,Eq Relocation
Eq Relocation
-> (Relocation -> Relocation -> Ordering)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Relocation)
-> (Relocation -> Relocation -> Relocation)
-> Ord Relocation
Relocation -> Relocation -> Bool
Relocation -> Relocation -> Ordering
Relocation -> Relocation -> Relocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Relocation -> Relocation -> Relocation
$cmin :: Relocation -> Relocation -> Relocation
max :: Relocation -> Relocation -> Relocation
$cmax :: Relocation -> Relocation -> Relocation
>= :: Relocation -> Relocation -> Bool
$c>= :: Relocation -> Relocation -> Bool
> :: Relocation -> Relocation -> Bool
$c> :: Relocation -> Relocation -> Bool
<= :: Relocation -> Relocation -> Bool
$c<= :: Relocation -> Relocation -> Bool
< :: Relocation -> Relocation -> Bool
$c< :: Relocation -> Relocation -> Bool
compare :: Relocation -> Relocation -> Ordering
$ccompare :: Relocation -> Relocation -> Ordering
$cp1Ord :: Eq Relocation
Ord)


pp_reloc :: Relocation -> String
pp_reloc (R_X86_64_RELATIVE Word64
a0 Word64
a1) = Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a1


-- | Symbol Table
type SymbolTable = IM.IntMap String



class BinaryClass a where
  binary_read_ro_data :: a -> Word64 -> Int -> Maybe [Word8]
  binary_read_data :: a -> Word64 -> Int -> Maybe [Word8]
  binary_get_sections_info :: a -> SectionsInfo
  binary_get_relocs :: a -> [Relocation]
  binary_get_symbols :: a -> SymbolTable
  binary_pp :: a -> String
  binary_entry :: a -> Word64



data Binary = forall b . BinaryClass b => Binary b


instance BinaryClass Binary where
  binary_read_ro_data :: Binary -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data (Binary b
b) = b -> Word64 -> Int -> Maybe [Word8]
forall a. BinaryClass a => a -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data b
b
  binary_read_data :: Binary -> Word64 -> Int -> Maybe [Word8]
binary_read_data (Binary b
b) = b -> Word64 -> Int -> Maybe [Word8]
forall a. BinaryClass a => a -> Word64 -> Int -> Maybe [Word8]
binary_read_data b
b
  binary_get_sections_info :: Binary -> SectionsInfo
binary_get_sections_info (Binary b
b) = b -> SectionsInfo
forall a. BinaryClass a => a -> SectionsInfo
binary_get_sections_info b
b
  binary_get_relocs :: Binary -> [Relocation]
binary_get_relocs (Binary b
b) = b -> [Relocation]
forall a. BinaryClass a => a -> [Relocation]
binary_get_relocs b
b
  binary_get_symbols :: Binary -> SymbolTable
binary_get_symbols (Binary b
b) = b -> SymbolTable
forall a. BinaryClass a => a -> SymbolTable
binary_get_symbols b
b
  binary_pp :: Binary -> String
binary_pp (Binary b
b) = b -> String
forall a. BinaryClass a => a -> String
binary_pp b
b
  binary_entry :: Binary -> Word64
binary_entry (Binary b
b) = b -> Word64
forall a. BinaryClass a => a -> Word64
binary_entry b
b