-- |
-- Module      : Data.ELF.Headers
-- Description : Parse headers and table entries of ELF files
-- Copyright   : (c) Aleksey Makarov, 2021
-- License     : BSD 3-Clause License
-- Maintainer  : aleksey.makarov@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- Parse headers and table entries of ELF files

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module Data.Elf.Headers (
    -- * Data definition
      elfMagic
    , ElfClass(..)
    , SElfClass (..)
    , ElfData(..)

    , IsElfClass(..)
    , wordSize
    , withElfClass

    -- * Types of ELF header
    , HeaderXX(..)
    , headerSize
    , Header

    -- * Types of ELF tables

    -- ** Section table
    , SectionXX(..)
    , sectionTableEntrySize

    -- ** Segment table
    , SegmentXX(..)
    , segmentTableEntrySize

    -- ** Sybmol table
    , SymbolXX(..)
    , symbolTableEntrySize

    -- ** Relocation table
    , RelaXX(..)
    , relocationTableAEntrySize

    -- * Parse header and section and segment tables
    , HeadersXX (..)
    , parseHeaders

    -- * Parse/serialize array of data

    -- | BList is an internal newtype for @[a]@ that is an instance of `Data.Binary.Binary`.
    -- When serializing, the @Binary@ instance for BList does not write the length of the array to the stream.
    -- Instead, parser just reads all the stream till the end.

    , parseBList
    , serializeBList

    -- * Misc helpers
    , sectionIsSymbolTable

    ) where

-- import Control.Lens hiding (at)
-- import Control.Arrow
import Control.Monad
import Control.Monad.Catch
-- import Control.Monad.State hiding (get, put)
-- import qualified Control.Monad.State as S
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.ByteString       as BS
import Data.ByteString.Lazy  as BSL
-- import Data.ByteString.Char8 as BSC
import Data.Data (Data)
import Data.Kind
-- import Data.Kind
import qualified Data.List as L
import Data.Singletons.Sigma
import Data.Singletons.TH
import Data.Typeable (Typeable)
-- import Numeric.Interval as I
-- import Numeric.Interval.NonEmpty as INE

import Control.Exception.ChainedException
import Data.BList
import Data.Endian
import Data.Elf.Constants

-- | ELF class.  Tells if ELF defines 32- or 64-bit objects
$(singletons [d|
    data ElfClass
        = ELFCLASS32 -- ^ 32-bit ELF format
        | ELFCLASS64 -- ^ 64-bit ELF format
        deriving (Eq, Show)
    |])

instance Binary ElfClass where
    get :: Get ElfClass
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ElfClass) -> Get ElfClass
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get ElfClass
forall a (m :: * -> *).
(Eq a, Num a, MonadFail m) =>
a -> m ElfClass
getElfClass_
        where
            getElfClass_ :: a -> m ElfClass
getElfClass_ a
1 = ElfClass -> m ElfClass
forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS32
            getElfClass_ a
2 = ElfClass -> m ElfClass
forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS64
            getElfClass_ a
_ = String -> m ElfClass
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF class"
    put :: ElfClass -> Put
put ElfClass
ELFCLASS32 = Word8 -> Put
putWord8 Word8
1
    put ElfClass
ELFCLASS64 = Word8 -> Put
putWord8 Word8
2

-- | ELF data. Specifies the endianness of the ELF data
data ElfData
    = ELFDATA2LSB -- ^ Little-endian ELF format
    | ELFDATA2MSB -- ^ Big-endian ELF format
    deriving (ElfData -> ElfData -> Bool
(ElfData -> ElfData -> Bool)
-> (ElfData -> ElfData -> Bool) -> Eq ElfData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfData -> ElfData -> Bool
$c/= :: ElfData -> ElfData -> Bool
== :: ElfData -> ElfData -> Bool
$c== :: ElfData -> ElfData -> Bool
Eq, Int -> ElfData -> ShowS
[ElfData] -> ShowS
ElfData -> String
(Int -> ElfData -> ShowS)
-> (ElfData -> String) -> ([ElfData] -> ShowS) -> Show ElfData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfData] -> ShowS
$cshowList :: [ElfData] -> ShowS
show :: ElfData -> String
$cshow :: ElfData -> String
showsPrec :: Int -> ElfData -> ShowS
$cshowsPrec :: Int -> ElfData -> ShowS
Show)

instance Binary ElfData where
    get :: Get ElfData
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ElfData) -> Get ElfData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get ElfData
forall a (m :: * -> *).
(Eq a, Num a, MonadFail m) =>
a -> m ElfData
getElfData_
        where
            getElfData_ :: a -> m ElfData
getElfData_ a
1 = ElfData -> m ElfData
forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2LSB
            getElfData_ a
2 = ElfData -> m ElfData
forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2MSB
            getElfData_ a
_ = String -> m ElfData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF data"
    put :: ElfData -> Put
put ElfData
ELFDATA2LSB = Word8 -> Put
putWord8 Word8
1
    put ElfData
ELFDATA2MSB = Word8 -> Put
putWord8 Word8
2

elfSupportedVersion :: Word8
elfSupportedVersion :: Word8
elfSupportedVersion = Word8
1

-- at :: (Integral i) => [a] -> i -> Maybe a
-- at (x : _)  0             = Just x
-- at (_ : xs) n | n > 0     = xs `at` (n - 1)
--               | otherwise = Nothing
-- at _        _             = Nothing

-- nameToString :: Maybe BS.ByteString -> String
-- nameToString bs = maybe "" id $ BSC.unpack <$> bs

-- cut :: BS.ByteString -> Int -> Int -> BS.ByteString
-- cut content offset size = BS.take size $ BS.drop offset content

-- | The first 4 bytes of the ELF file
elfMagic :: Be Word32
elfMagic :: Be Word32
elfMagic = Word32 -> Be Word32
forall a. a -> Be a
Be Word32
0x7f454c46 -- "\DELELF"

verify :: (Binary a, Eq a) => String -> a -> Get ()
verify :: String -> a -> Get ()
verify String
msg a
orig = do
    a
a <- Get a
forall t. Binary t => Get t
get
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
orig a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall a. HasCallStack => String -> a
error (String
"verification failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)

-- getTable :: (Binary (Le a), Binary (Be a)) => ElfData -> Word64 -> Word16 -> Word16 -> Get [a]
-- getTable endianness offset entrySize entryNumber = lookAhead $ do
--     skip $ fromIntegral offset
--     getTable' entryNumber
--     where
--         getTable' 0 = return []
--         getTable' n = do
--             a <- isolate (fromIntegral entrySize) $ getEndian endianness
--             (a :) <$> getTable' (n - 1)

getEndian :: (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian :: ElfData -> Get a
getEndian ElfData
ELFDATA2LSB = Le a -> a
forall a. Le a -> a
fromLe (Le a -> a) -> Get (Le a) -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Le a)
forall t. Binary t => Get t
get
getEndian ElfData
ELFDATA2MSB = Be a -> a
forall a. Be a -> a
fromBe (Be a -> a) -> Get (Be a) -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Be a)
forall t. Binary t => Get t
get

getBe :: (Binary (Le b), Binary (Be b)) => Get b
getBe :: Get b
getBe = ElfData -> Get b
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
ELFDATA2MSB

getLe :: (Binary (Le b), Binary (Be b)) => Get b
getLe :: Get b
getLe = ElfData -> Get b
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
ELFDATA2LSB

putEndian :: (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian :: ElfData -> a -> Put
putEndian ElfData
ELFDATA2LSB = Le a -> Put
forall t. Binary t => t -> Put
put (Le a -> Put) -> (a -> Le a) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Le a
forall a. a -> Le a
Le
putEndian ElfData
ELFDATA2MSB = Be a -> Put
forall t. Binary t => t -> Put
put (Be a -> Put) -> (a -> Be a) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Be a
forall a. a -> Be a
Be

putBe :: (Binary (Le b), Binary (Be b)) => b -> Put
putBe :: b -> Put
putBe = ElfData -> b -> Put
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
ELFDATA2MSB

putLe :: (Binary (Le b), Binary (Be b)) => b -> Put
putLe :: b -> Put
putLe = ElfData -> b -> Put
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
ELFDATA2LSB

--------------------------------------------------------------------------
-- WordXX
--------------------------------------------------------------------------

-- | @IsElfClass a@ is defined for each constructor of `ElfClass`.
--   It defines @WordXX a@, which is `Word32` for `ELFCLASS32` and `Word64` for `ELFCLASS64`.
type IsElfClass :: ElfClass -> Constraint
class ( SingI c
      , Typeable c
      , Typeable (WordXX c)
      , Data (WordXX c)
      , Show (WordXX c)
      , Read (WordXX c)
      , Eq (WordXX c)
      , Ord (WordXX c)
      , Bounded (WordXX c)
      , Enum (WordXX c)
      , Num (WordXX c)
      , Integral (WordXX c)
      , Real (WordXX c)
      , Bits (WordXX c)
      , FiniteBits (WordXX c)
      , Binary (Be (WordXX c))
      , Binary (Le (WordXX c))
      ) => IsElfClass c where
    type WordXX c = r | r -> c

instance IsElfClass 'ELFCLASS32 where
    type WordXX 'ELFCLASS32 = Word32

instance IsElfClass 'ELFCLASS64 where
    type WordXX 'ELFCLASS64 = Word64

--------------------------------------------------------------------------
-- Header
--------------------------------------------------------------------------

-- | Parsed ELF header
type HeaderXX :: ElfClass -> Type
data HeaderXX c =
    HeaderXX
        { HeaderXX c -> ElfData
hData       :: ElfData    -- ^ Data encoding (big- or little-endian)
        , HeaderXX c -> ElfOSABI
hOSABI      :: ElfOSABI   -- ^ OS/ABI identification
        , HeaderXX c -> Word8
hABIVersion :: Word8      -- ^ ABI version
        , HeaderXX c -> ElfType
hType       :: ElfType    -- ^ Object file type
        , HeaderXX c -> ElfMachine
hMachine    :: ElfMachine -- ^ Machine type
        , HeaderXX c -> WordXX c
hEntry      :: WordXX c   -- ^ Entry point address
        , HeaderXX c -> WordXX c
hPhOff      :: WordXX c   -- ^ Program header offset
        , HeaderXX c -> WordXX c
hShOff      :: WordXX c   -- ^ Section header offset
        , HeaderXX c -> Word32
hFlags      :: Word32     -- ^ Processor-specific flags
        , HeaderXX c -> Word16
hPhEntSize  :: Word16     -- ^ Size of program header entry
        , HeaderXX c -> Word16
hPhNum      :: Word16     -- ^ Number of program header entries
        , HeaderXX c -> Word16
hShEntSize  :: Word16     -- ^ Size of section header entry
        , HeaderXX c -> Word16
hShNum      :: Word16     -- ^ Number of section header entries
        , HeaderXX c -> ElfSectionIndex
hShStrNdx   :: ElfSectionIndex -- ^ Section name string table index
        }

-- | Sigma type where `ElfClass` defines the type of `HeaderXX`
type Header = Sigma ElfClass (TyCon1 HeaderXX)

-- | Size of ELF header.
headerSize :: Num a => ElfClass -> a
headerSize :: ElfClass -> a
headerSize ElfClass
ELFCLASS64 = a
64
headerSize ElfClass
ELFCLASS32 = a
52

-- | Size of section table entry.
sectionTableEntrySize :: Num a => ElfClass -> a
sectionTableEntrySize :: ElfClass -> a
sectionTableEntrySize ElfClass
ELFCLASS64 = a
64
sectionTableEntrySize ElfClass
ELFCLASS32 = a
40

-- | Size of segment table entry.
segmentTableEntrySize :: Num a => ElfClass -> a
segmentTableEntrySize :: ElfClass -> a
segmentTableEntrySize ElfClass
ELFCLASS64 = a
56
segmentTableEntrySize ElfClass
ELFCLASS32 = a
32

-- | Size of symbol table entry.
symbolTableEntrySize :: Num a => ElfClass -> a
symbolTableEntrySize :: ElfClass -> a
symbolTableEntrySize ElfClass
ELFCLASS64 = a
24
symbolTableEntrySize ElfClass
ELFCLASS32 = a
16

-- | Size of @WordXX a@ in bytes.
wordSize :: Num a => ElfClass -> a
wordSize :: ElfClass -> a
wordSize ElfClass
ELFCLASS64 = a
8
wordSize ElfClass
ELFCLASS32 = a
4

-- | Convenience function for creating a context with an implicit ElfClass available.
withElfClass :: Sing c -> (IsElfClass c => a) -> a
withElfClass :: Sing c -> (IsElfClass c => a) -> a
withElfClass Sing c
SELFCLASS64 IsElfClass c => a
x = a
IsElfClass c => a
x
withElfClass Sing c
SELFCLASS32 IsElfClass c => a
x = a
IsElfClass c => a
x

getHeader' :: IsElfClass c => Sing c -> Get Header
getHeader' :: Sing c -> Get Header
getHeader' Sing c
classS = do

    ElfData
hData <- Get ElfData
forall t. Binary t => Get t
get
    String -> Word8 -> Get ()
forall a. (Binary a, Eq a) => String -> a -> Get ()
verify String
"version1" Word8
elfSupportedVersion
    ElfOSABI
hOSABI <- Get ElfOSABI
forall t. Binary t => Get t
get
    Word8
hABIVersion <- Get Word8
forall t. Binary t => Get t
get
    Int -> Get ()
skip Int
7

    let
        getE :: (Binary (Le b), Binary (Be b)) => Get b
        getE :: Get b
getE = ElfData -> Get b
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
hData

    ElfType
hType <- Get ElfType
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfMachine
hMachine <- Get ElfMachine
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    (Word32
hVersion2 :: Word32) <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
hVersion2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
1) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall a. HasCallStack => String -> a
error String
"verification failed: version2"

    WordXX c
hEntry <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
hPhOff <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
hShOff <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    Word32
hFlags <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    (Word16
hSize :: Word16) <- Get Word16
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
hSize Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= ElfClass -> Word16
forall a. Num a => ElfClass -> a
headerSize (Sing c -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing c
classS)) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall a. HasCallStack => String -> a
error String
"incorrect size of elf header"
    Word16
hPhEntSize <- Get Word16
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word16
hPhNum <- Get Word16
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word16
hShEntSize <- Get Word16
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word16
hShNum <- Get Word16
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSectionIndex
hShStrNdx <- Get ElfSectionIndex
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    Header -> Get Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ Sing c
classS Sing c -> (TyCon1 HeaderXX @@ c) -> Header
forall s (t :: s ~> *) (fst :: s).
Sing fst -> (t @@ fst) -> Sigma s t
:&: HeaderXX :: forall (c :: ElfClass).
ElfData
-> ElfOSABI
-> Word8
-> ElfType
-> ElfMachine
-> WordXX c
-> WordXX c
-> WordXX c
-> Word32
-> Word16
-> Word16
-> Word16
-> Word16
-> ElfSectionIndex
-> HeaderXX c
HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX c
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX c
hPhOff :: WordXX c
hEntry :: WordXX c
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX c
hPhOff :: WordXX c
hEntry :: WordXX c
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
..}

getHeader :: Get Header
getHeader :: Get Header
getHeader = do
    String -> Be Word32 -> Get ()
forall a. (Binary a, Eq a) => String -> a -> Get ()
verify String
"magic" Be Word32
elfMagic
    Demote ElfClass
hClass <- Get (Demote ElfClass)
forall t. Binary t => Get t
get
    let
        f2 :: forall (c :: ElfClass) . Sing c -> Get Header
        f2 :: Sing c -> Get Header
f2 Sing c
x = Sing c -> (IsElfClass c => Get Header) -> Get Header
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass Sing c
x (Sing c -> Get Header
forall (c :: ElfClass). IsElfClass c => Sing c -> Get Header
getHeader' Sing c
x)

    Demote ElfClass
-> (forall (a :: ElfClass). Sing a -> Get Header) -> Get Header
forall k r.
SingKind k =>
Demote k -> (forall (a :: k). Sing a -> r) -> r
withSomeSing Demote ElfClass
hClass forall (a :: ElfClass). Sing a -> Get Header
f2

putHeader :: Header -> Put
putHeader :: Header -> Put
putHeader (Sing fst
classS :&: HeaderXX{..}) = Sing fst -> (IsElfClass fst => Put) -> Put
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass Sing fst
classS do

    Be Word32 -> Put
forall t. Binary t => t -> Put
put Be Word32
elfMagic
    ElfClass -> Put
forall t. Binary t => t -> Put
put (ElfClass -> Put) -> ElfClass -> Put
forall a b. (a -> b) -> a -> b
$ Sing fst -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing fst
classS
    ElfData -> Put
forall t. Binary t => t -> Put
put ElfData
hData
    Word8 -> Put
forall t. Binary t => t -> Put
put Word8
elfSupportedVersion
    ElfOSABI -> Put
forall t. Binary t => t -> Put
put ElfOSABI
hOSABI
    Word8 -> Put
forall t. Binary t => t -> Put
put Word8
hABIVersion

    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
7 Word8
0

    let
        putE :: (Binary (Le b), Binary (Be b)) => b -> Put
        putE :: b -> Put
putE = ElfData -> b -> Put
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
hData

    ElfType -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfType
hType
    ElfMachine -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfMachine
hMachine
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (Word32
1 :: Word32)
    WordXX fst -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX fst
hEntry
    WordXX fst -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX fst
hPhOff
    WordXX fst -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX fst
hShOff
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
hFlags
    Word16 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (ElfClass -> Word16
forall a. Num a => ElfClass -> a
headerSize (ElfClass -> Word16) -> ElfClass -> Word16
forall a b. (a -> b) -> a -> b
$ Sing fst -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing fst
classS :: Word16)
    Word16 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hPhEntSize
    Word16 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hPhNum
    Word16 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hShEntSize
    Word16 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hShNum
    ElfSectionIndex -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionIndex
hShStrNdx

instance Binary Header where
    put :: Header -> Put
put = Header -> Put
putHeader
    get :: Get Header
get = Get Header
getHeader

--------------------------------------------------------------------------
-- Section
--------------------------------------------------------------------------

-- | Parsed ELF section table entry
data SectionXX (c :: ElfClass) =
    SectionXX
        { SectionXX c -> Word32
sName      :: Word32         -- ^ Section name
        , SectionXX c -> ElfSectionType
sType      :: ElfSectionType -- ^ Section type
        , SectionXX c -> WordXX c
sFlags     :: WordXX c       -- ^ Section attributes
        , SectionXX c -> WordXX c
sAddr      :: WordXX c       -- ^ Virtual address in memory
        , SectionXX c -> WordXX c
sOffset    :: WordXX c       -- ^ Offset in file
        , SectionXX c -> WordXX c
sSize      :: WordXX c       -- ^ Size of section
        , SectionXX c -> Word32
sLink      :: Word32         -- ^ Link to other section
        , SectionXX c -> Word32
sInfo      :: Word32         -- ^ Miscellaneous information
        , SectionXX c -> WordXX c
sAddrAlign :: WordXX c       -- ^ Address alignment boundary
        , SectionXX c -> WordXX c
sEntSize   :: WordXX c       -- ^ Size of entries, if section has table
        }

getSection ::                               IsElfClass c =>
    (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (SectionXX c)
getSection :: (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    Word32
sName      <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSectionType
sType      <- Get ElfSectionType
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sFlags     <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sAddr      <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sOffset    <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sSize      <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
sLink      <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
sInfo      <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sAddrAlign <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sEntSize   <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    SectionXX c -> Get (SectionXX c)
forall (m :: * -> *) a. Monad m => a -> m a
return SectionXX :: forall (c :: ElfClass).
Word32
-> ElfSectionType
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> Word32
-> Word32
-> WordXX c
-> WordXX c
-> SectionXX c
SectionXX {Word32
ElfSectionType
WordXX c
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
..}

putSection ::                                  IsElfClass c =>
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                                SectionXX c -> Put
putSection :: (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SectionXX{Word32
ElfSectionType
WordXX c
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
..}) = do

    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sName
    ElfSectionType -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionType
sType
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sFlags
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sAddr
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sOffset
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sSize
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sLink
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sInfo
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sAddrAlign
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sEntSize

instance forall (a :: ElfClass) . SingI a => Binary (Be (SectionXX a)) where
    put :: Be (SectionXX a) -> Put
put = Sing a
-> (IsElfClass a => SectionXX a -> Put) -> SectionXX a -> Put
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX a -> Put
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe) (SectionXX a -> Put)
-> (Be (SectionXX a) -> SectionXX a) -> Be (SectionXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (SectionXX a) -> SectionXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (SectionXX a))
get = SectionXX a -> Be (SectionXX a)
forall a. a -> Be a
Be (SectionXX a -> Be (SectionXX a))
-> Get (SectionXX a) -> Get (Be (SectionXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a -> (IsElfClass a => Get (SectionXX a)) -> Get (SectionXX a)
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX a)
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe)

instance forall (a :: ElfClass) . SingI a => Binary (Le (SectionXX a)) where
    put :: Le (SectionXX a) -> Put
put = Sing a
-> (IsElfClass a => SectionXX a -> Put) -> SectionXX a -> Put
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX a -> Put
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe) (SectionXX a -> Put)
-> (Le (SectionXX a) -> SectionXX a) -> Le (SectionXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (SectionXX a) -> SectionXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (SectionXX a))
get = SectionXX a -> Le (SectionXX a)
forall a. a -> Le a
Le (SectionXX a -> Le (SectionXX a))
-> Get (SectionXX a) -> Get (Le (SectionXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a -> (IsElfClass a => Get (SectionXX a)) -> Get (SectionXX a)
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX a)
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe)

--------------------------------------------------------------------------
-- Segment
--------------------------------------------------------------------------

-- | Parsed ELF segment table entry
data SegmentXX (c :: ElfClass) =
    SegmentXX
        { SegmentXX c -> ElfSegmentType
pType     :: ElfSegmentType -- ^ Type of segment
        , SegmentXX c -> ElfSegmentFlag
pFlags    :: ElfSegmentFlag -- ^ Segment attributes
        , SegmentXX c -> WordXX c
pOffset   :: WordXX c       -- ^ Offset in file
        , SegmentXX c -> WordXX c
pVirtAddr :: WordXX c       -- ^ Virtual address in memory
        , SegmentXX c -> WordXX c
pPhysAddr :: WordXX c       -- ^ Physical address
        , SegmentXX c -> WordXX c
pFileSize :: WordXX c       -- ^ Size of segment in file
        , SegmentXX c -> WordXX c
pMemSize  :: WordXX c       -- ^ Size of segment in memory
        , SegmentXX c -> WordXX c
pAlign    :: WordXX c       -- ^ Alignment of segment
        }

getSegment ::            forall (c :: ElfClass) . Sing c ->
    (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (SegmentXX c)
getSegment :: Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment Sing c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    ElfSegmentType
pType     <- Get ElfSegmentType
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSegmentFlag
pFlags    <- Get ElfSegmentFlag
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pOffset   <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pVirtAddr <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pPhysAddr <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pFileSize <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pMemSize  <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pAlign    <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    SegmentXX c -> Get (SegmentXX c)
forall (m :: * -> *) a. Monad m => a -> m a
return SegmentXX :: forall (c :: ElfClass).
ElfSegmentType
-> ElfSegmentFlag
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> SegmentXX c
SegmentXX{Word64
ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: Word64
pMemSize :: Word64
pFileSize :: Word64
pPhysAddr :: Word64
pVirtAddr :: Word64
pOffset :: Word64
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
..}

getSegment Sing c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    ElfSegmentType
pType     <- Get ElfSegmentType
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pOffset   <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pVirtAddr <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pPhysAddr <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pFileSize <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pMemSize  <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSegmentFlag
pFlags    <- Get ElfSegmentFlag
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pAlign    <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    SegmentXX c -> Get (SegmentXX c)
forall (m :: * -> *) a. Monad m => a -> m a
return SegmentXX :: forall (c :: ElfClass).
ElfSegmentType
-> ElfSegmentFlag
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> SegmentXX c
SegmentXX{Word32
ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: Word32
pFlags :: ElfSegmentFlag
pMemSize :: Word32
pFileSize :: Word32
pPhysAddr :: Word32
pVirtAddr :: Word32
pOffset :: Word32
pType :: ElfSegmentType
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
..}

putSegment ::               forall (c :: ElfClass) . Sing c ->
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                                SegmentXX c -> Put
putSegment :: Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment Sing c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..}) = do

    ElfSegmentType -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentType
pType
    ElfSegmentFlag -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentFlag
pFlags
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
pOffset
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
pVirtAddr
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
pPhysAddr
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
pFileSize
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
pMemSize
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
pAlign

putSegment Sing c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..}) = do

    ElfSegmentType -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentType
pType
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
pOffset
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
pVirtAddr
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
pPhysAddr
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
pFileSize
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
pMemSize
    ElfSegmentFlag -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentFlag
pFlags
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
pAlign


instance forall (a :: ElfClass) . SingI a => Binary (Be (SegmentXX a)) where
    put :: Be (SegmentXX a) -> Put
put = Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX a
-> Put
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe (SegmentXX a -> Put)
-> (Be (SegmentXX a) -> SegmentXX a) -> Be (SegmentXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (SegmentXX a) -> SegmentXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (SegmentXX a))
get = SegmentXX a -> Be (SegmentXX a)
forall a. a -> Be a
Be (SegmentXX a -> Be (SegmentXX a))
-> Get (SegmentXX a) -> Get (Be (SegmentXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX a)
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe

instance forall (a :: ElfClass) . SingI a => Binary (Le (SegmentXX a)) where
    put :: Le (SegmentXX a) -> Put
put = Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX a
-> Put
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe (SegmentXX a -> Put)
-> (Le (SegmentXX a) -> SegmentXX a) -> Le (SegmentXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (SegmentXX a) -> SegmentXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (SegmentXX a))
get = SegmentXX a -> Le (SegmentXX a)
forall a. a -> Le a
Le (SegmentXX a -> Le (SegmentXX a))
-> Get (SegmentXX a) -> Get (Le (SegmentXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX a)
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe

--------------------------------------------------------------------------
-- Symbol table entry
--------------------------------------------------------------------------

-- | Test if the section with such integer value of section type field (`sType`)
--   contains symbol table
sectionIsSymbolTable :: ElfSectionType -> Bool
sectionIsSymbolTable :: ElfSectionType -> Bool
sectionIsSymbolTable ElfSectionType
sType  = ElfSectionType
sType ElfSectionType -> [ElfSectionType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [ElfSectionType
SHT_SYMTAB, ElfSectionType
SHT_DYNSYM]

-- | Parsed ELF symbol table entry
data SymbolXX (c :: ElfClass) =
    SymbolXX
        { SymbolXX c -> Word32
stName  :: Word32          -- ^ Symbol name
        , SymbolXX c -> Word8
stInfo  :: Word8           -- ^ Type and Binding attributes
        , SymbolXX c -> Word8
stOther :: Word8           -- ^ Reserved
        , SymbolXX c -> ElfSectionIndex
stShNdx :: ElfSectionIndex -- ^ Section table index
        , SymbolXX c -> WordXX c
stValue :: WordXX c        -- ^ Symbol value
        , SymbolXX c -> WordXX c
stSize  :: WordXX c        -- ^ Size of object
        }

getSymbolTableEntry ::    forall (c :: ElfClass) . Sing c ->
     (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (SymbolXX c)
getSymbolTableEntry :: Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry Sing c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    Word32
stName  <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word8
stInfo  <- Get Word8
forall t. Binary t => Get t
get
    Word8
stOther <- Get Word8
forall t. Binary t => Get t
get
    ElfSectionIndex
stShNdx <- Get ElfSectionIndex
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
stValue <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
stSize  <- Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    SymbolXX c -> Get (SymbolXX c)
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolXX :: forall (c :: ElfClass).
Word32
-> Word8
-> Word8
-> ElfSectionIndex
-> WordXX c
-> WordXX c
-> SymbolXX c
SymbolXX{Word8
Word32
Word64
ElfSectionIndex
WordXX c
stSize :: Word64
stValue :: Word64
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
..}

getSymbolTableEntry Sing c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    Word32
stName  <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
stValue <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
stSize  <- Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word8
stInfo  <- Get Word8
forall t. Binary t => Get t
get
    Word8
stOther <- Get Word8
forall t. Binary t => Get t
get
    ElfSectionIndex
stShNdx <- Get ElfSectionIndex
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    SymbolXX c -> Get (SymbolXX c)
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolXX :: forall (c :: ElfClass).
Word32
-> Word8
-> Word8
-> ElfSectionIndex
-> WordXX c
-> WordXX c
-> SymbolXX c
SymbolXX{Word8
Word32
ElfSectionIndex
WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stSize :: Word32
stValue :: Word32
stName :: Word32
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
..}

putSymbolTableEntry ::      forall (c :: ElfClass) . Sing c ->
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                       SymbolXX c -> Put
putSymbolTableEntry :: Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry Sing c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SymbolXX{Word8
Word32
ElfSectionIndex
WordXX c
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
..}) = do

    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
stName
    Word8 -> Put
forall t. Binary t => t -> Put
put  Word8
stInfo
    Word8 -> Put
forall t. Binary t => t -> Put
put  Word8
stOther
    ElfSectionIndex -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionIndex
stShNdx
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
stValue
    Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word64
WordXX c
stSize

putSymbolTableEntry Sing c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SymbolXX{Word8
Word32
ElfSectionIndex
WordXX c
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
..}) = do

    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
stName
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
stValue
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
stSize
    Word8 -> Put
forall t. Binary t => t -> Put
put  Word8
stInfo
    Word8 -> Put
forall t. Binary t => t -> Put
put  Word8
stOther
    ElfSectionIndex -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionIndex
stShNdx

instance forall (a :: ElfClass) . SingI a => Binary (Be (SymbolXX a)) where
    put :: Be (SymbolXX a) -> Put
put = Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX a
-> Put
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe (SymbolXX a -> Put)
-> (Be (SymbolXX a) -> SymbolXX a) -> Be (SymbolXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (SymbolXX a) -> SymbolXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (SymbolXX a))
get = SymbolXX a -> Be (SymbolXX a)
forall a. a -> Be a
Be (SymbolXX a -> Be (SymbolXX a))
-> Get (SymbolXX a) -> Get (Be (SymbolXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX a)
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe

instance forall (a :: ElfClass) . SingI a => Binary (Le (SymbolXX a)) where
    put :: Le (SymbolXX a) -> Put
put = Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX a
-> Put
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe (SymbolXX a -> Put)
-> (Le (SymbolXX a) -> SymbolXX a) -> Le (SymbolXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (SymbolXX a) -> SymbolXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (SymbolXX a))
get = SymbolXX a -> Le (SymbolXX a)
forall a. a -> Le a
Le (SymbolXX a -> Le (SymbolXX a))
-> Get (SymbolXX a) -> Get (Le (SymbolXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX a)
forall (c :: ElfClass).
Sing c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry Sing a
forall k (a :: k). SingI a => Sing a
sing forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe

--------------------------------------------------------------------------
-- relocation table entry
--------------------------------------------------------------------------

-- | Parsed relocation table entry (@ElfXX_Rela@)
data RelaXX (c :: ElfClass) =
    RelaXX
        { RelaXX c -> WordXX c
relaOffset :: WordXX c -- ^ Address of reference
        , RelaXX c -> Word32
relaSym    :: Word32   -- ^ Symbol table index
        , RelaXX c -> Word32
relaType   :: Word32   -- ^ Relocation type
        , RelaXX c -> WordXX c
relaAddend :: WordXX c -- ^ Constant part of expression
        }

relaSym32 :: Word32 -> Word32
relaSym32 :: Word32 -> Word32
relaSym32 Word32
v = Word32
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8

relaType32 :: Word32 -> Word32
relaType32 :: Word32 -> Word32
relaType32 Word32
v = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32
v Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff

relaSym64 :: Word64 -> Word32
relaSym64 :: Word64 -> Word32
relaSym64 Word64
v = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32

relaType64 :: Word64 -> Word32
relaType64 :: Word64 -> Word32
relaType64 Word64
v = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff

relaInfo32 :: Word32 -> Word32 -> Word32
relaInfo32 :: Word32 -> Word32 -> Word32
relaInfo32 Word32
s Word32
t = (Word32
t Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
s Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)

relaInfo64 :: Word32 -> Word32 -> Word64
relaInfo64 :: Word32 -> Word32 -> Word64
relaInfo64 Word32
s Word32
t = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
t Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)

getRelocationTableAEntry ::      forall c . IsElfClass c =>
    (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (RelaXX c)
getRelocationTableAEntry :: (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do
    WordXX c
relaOffset <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    (Word32
relaSym, Word32
relaType) <- case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @ c of
        Sing c
SELFCLASS64 -> (\Word64
x -> (Word64 -> Word32
relaSym64 Word64
x, Word64 -> Word32
relaType64 Word64
x)) (Word64 -> (Word32, Word32)) -> Get Word64 -> Get (Word32, Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
        Sing c
SELFCLASS32 -> (\Word32
x -> (Word32 -> Word32
relaSym32 Word32
x, Word32 -> Word32
relaType32 Word32
x)) (Word32 -> (Word32, Word32)) -> Get Word32 -> Get (Word32, Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
relaAddend <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    RelaXX c -> Get (RelaXX c)
forall (m :: * -> *) a. Monad m => a -> m a
return RelaXX :: forall (c :: ElfClass).
WordXX c -> Word32 -> Word32 -> WordXX c -> RelaXX c
RelaXX{Word32
WordXX c
relaAddend :: WordXX c
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX c
relaAddend :: WordXX c
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX c
..}

putRelocationTableAEntry ::         forall c . IsElfClass c =>
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                  RelaXX c -> Put
putRelocationTableAEntry :: (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (RelaXX{Word32
WordXX c
relaAddend :: WordXX c
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX c
relaAddend :: forall (c :: ElfClass). RelaXX c -> WordXX c
relaType :: forall (c :: ElfClass). RelaXX c -> Word32
relaSym :: forall (c :: ElfClass). RelaXX c -> Word32
relaOffset :: forall (c :: ElfClass). RelaXX c -> WordXX c
..}) = do
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
relaOffset
    (case SingI c => Sing c
forall k (a :: k). SingI a => Sing a
sing @ c of
        Sing c
SELFCLASS64 -> Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word64
relaInfo64 Word32
relaSym Word32
relaType
        Sing c
SELFCLASS32 -> Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
relaInfo32 Word32
relaSym Word32
relaType) :: Put
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
relaAddend

instance forall (a :: ElfClass) . SingI a => Binary (Be (RelaXX a)) where
    put :: Be (RelaXX a) -> Put
put = Sing a -> (IsElfClass a => RelaXX a -> Put) -> RelaXX a -> Put
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX a -> Put
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe) (RelaXX a -> Put)
-> (Be (RelaXX a) -> RelaXX a) -> Be (RelaXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (RelaXX a) -> RelaXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (RelaXX a))
get = RelaXX a -> Be (RelaXX a)
forall a. a -> Be a
Be (RelaXX a -> Be (RelaXX a))
-> Get (RelaXX a) -> Get (Be (RelaXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a -> (IsElfClass a => Get (RelaXX a)) -> Get (RelaXX a)
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX a)
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe)

instance forall (a :: ElfClass) . SingI a => Binary (Le (RelaXX a)) where
    put :: Le (RelaXX a) -> Put
put = Sing a -> (IsElfClass a => RelaXX a -> Put) -> RelaXX a -> Put
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX a -> Put
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe) (RelaXX a -> Put)
-> (Le (RelaXX a) -> RelaXX a) -> Le (RelaXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (RelaXX a) -> RelaXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (RelaXX a))
get = RelaXX a -> Le (RelaXX a)
forall a. a -> Le a
Le (RelaXX a -> Le (RelaXX a))
-> Get (RelaXX a) -> Get (Le (RelaXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a -> (IsElfClass a => Get (RelaXX a)) -> Get (RelaXX a)
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass (SingI a => Sing a
forall k (a :: k). SingI a => Sing a
sing @ a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX a)
forall (c :: ElfClass).
IsElfClass c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe)

-- | Size of @RelaXX a@ in bytes.
relocationTableAEntrySize :: forall a . IsElfClass a => WordXX a
relocationTableAEntrySize :: WordXX a
relocationTableAEntrySize = Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Le (RelaXX a) -> ByteString
forall a. Binary a => a -> ByteString
encode (Le (RelaXX a) -> ByteString) -> Le (RelaXX a) -> ByteString
forall a b. (a -> b) -> a -> b
$ RelaXX a -> Le (RelaXX a)
forall a. a -> Le a
Le (RelaXX a -> Le (RelaXX a)) -> RelaXX a -> Le (RelaXX a)
forall a b. (a -> b) -> a -> b
$ WordXX a -> Word32 -> Word32 -> WordXX a -> RelaXX a
forall (c :: ElfClass).
WordXX c -> Word32 -> Word32 -> WordXX c -> RelaXX c
RelaXX @ a WordXX a
0 Word32
0 Word32
0 WordXX a
0

--------------------------------------------------------------------------
-- parseHeaders
--------------------------------------------------------------------------

elfDecodeOrFail' :: (Binary a, MonadThrow m) => BSL.ByteString -> m (ByteOffset, a)
elfDecodeOrFail' :: ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs = case ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
decodeOrFail ByteString
bs of
    Left (ByteString
_, Int64
off, String
err) -> Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (Int64, a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
$chainedError (String -> m (Int64, a)) -> String -> m (Int64, a)
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" @" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
off
    Right (ByteString
_, Int64
off, a
a) -> (Int64, a) -> m (Int64, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
off, a
a)

elfDecodeOrFail :: (Binary a, MonadThrow m) => BSL.ByteString -> m a
elfDecodeOrFail :: ByteString -> m a
elfDecodeOrFail ByteString
bs = (Int64, a) -> a
forall a b. (a, b) -> b
snd ((Int64, a) -> a) -> m (Int64, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Int64, a)
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs

elfDecodeAllOrFail :: (Binary a, MonadThrow m) => BSL.ByteString -> m a
elfDecodeAllOrFail :: ByteString -> m a
elfDecodeAllOrFail ByteString
bs = do
    (Int64
off, a
a) <- ByteString -> m (Int64, a)
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs
    if Int64
off Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int64
BSL.length ByteString
bs then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a else Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m a
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
$chainedError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"leftover != 0 @" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
off

-- | Parse an array
parseBList :: (MonadThrow m, Binary (Le a), Binary (Be a))
           => ElfData        -- ^ Tells if parser should expect big or little endian data
           -> BSL.ByteString -- ^ Data for parsing
           -> m [a]
parseBList :: ElfData -> ByteString -> m [a]
parseBList ElfData
d ByteString
bs = case ElfData
d of
    ElfData
ELFDATA2LSB -> BList a -> [a]
forall a. BList a -> [a]
fromBList (BList a -> [a])
-> (Le (BList a) -> BList a) -> Le (BList a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (BList a) -> BList a
forall a. Le a -> a
fromLe (Le (BList a) -> [a]) -> m (Le (BList a)) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Le (BList a))
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeAllOrFail ByteString
bs
    ElfData
ELFDATA2MSB -> BList a -> [a]
forall a. BList a -> [a]
fromBList (BList a -> [a])
-> (Be (BList a) -> BList a) -> Be (BList a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (BList a) -> BList a
forall a. Be a -> a
fromBe (Be (BList a) -> [a]) -> m (Be (BList a)) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Be (BList a))
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeAllOrFail ByteString
bs

-- | Serialize an array
serializeBList :: (Binary (Le a), Binary (Be a))
               => ElfData -- ^ Tells if serializer should tread the data as bit or little endian
               -> [a]     -- ^ The array to serialize
               -> BSL.ByteString
serializeBList :: ElfData -> [a] -> ByteString
serializeBList ElfData
d [a]
as = case ElfData
d of
    ElfData
ELFDATA2LSB -> Le (BList a) -> ByteString
forall a. Binary a => a -> ByteString
encode (Le (BList a) -> ByteString) -> Le (BList a) -> ByteString
forall a b. (a -> b) -> a -> b
$ BList a -> Le (BList a)
forall a. a -> Le a
Le (BList a -> Le (BList a)) -> BList a -> Le (BList a)
forall a b. (a -> b) -> a -> b
$ [a] -> BList a
forall a. [a] -> BList a
BList [a]
as
    ElfData
ELFDATA2MSB -> Be (BList a) -> ByteString
forall a. Binary a => a -> ByteString
encode (Be (BList a) -> ByteString) -> Be (BList a) -> ByteString
forall a b. (a -> b) -> a -> b
$ BList a -> Be (BList a)
forall a. a -> Be a
Be (BList a -> Be (BList a)) -> BList a -> Be (BList a)
forall a b. (a -> b) -> a -> b
$ [a] -> BList a
forall a. [a] -> BList a
BList [a]
as

-- FIXME: how to get rid of this? (Can we use some combinators for Sigma)
-- | The type that helps to make the sigma type of the result
--   of the `parseHeaders` function
newtype HeadersXX a = HeadersXX (HeaderXX a, [SectionXX a], [SegmentXX a])

parseHeaders' :: (IsElfClass a, MonadThrow m) => HeaderXX a -> BSL.ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
parseHeaders' :: HeaderXX a -> ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
parseHeaders' hxx :: HeaderXX a
hxx@HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX a
hPhOff :: WordXX a
hEntry :: WordXX a
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..} ByteString
bs =
    let
        takeLen :: WordXX a -> Word16 -> ByteString
takeLen WordXX a
off Word16
len = Int64 -> ByteString -> ByteString
BSL.take (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
off) ByteString
bs
        bsSections :: ByteString
bsSections = WordXX a -> Word16 -> ByteString
takeLen WordXX a
hShOff (Word16
hShEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hShNum)
        bsSegments :: ByteString
bsSegments = WordXX a -> Word16 -> ByteString
takeLen WordXX a
hPhOff (Word16
hPhEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hPhNum)
    in do
        [SectionXX a]
ss <- ElfData -> ByteString -> m [SectionXX a]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
hData ByteString
bsSections
        [SegmentXX a]
ps <- ElfData -> ByteString -> m [SegmentXX a]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
hData ByteString
bsSegments
        Sigma ElfClass (TyCon1 HeadersXX)
-> m (Sigma ElfClass (TyCon1 HeadersXX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sigma ElfClass (TyCon1 HeadersXX)
 -> m (Sigma ElfClass (TyCon1 HeadersXX)))
-> Sigma ElfClass (TyCon1 HeadersXX)
-> m (Sigma ElfClass (TyCon1 HeadersXX))
forall a b. (a -> b) -> a -> b
$ Sing a
forall k (a :: k). SingI a => Sing a
sing Sing a
-> (TyCon1 HeadersXX @@ a) -> Sigma ElfClass (TyCon1 HeadersXX)
forall s (t :: s ~> *) (fst :: s).
Sing fst -> (t @@ fst) -> Sigma s t
:&: (HeaderXX a, [SectionXX a], [SegmentXX a]) -> HeadersXX a
forall (a :: ElfClass).
(HeaderXX a, [SectionXX a], [SegmentXX a]) -> HeadersXX a
HeadersXX (HeaderXX a
hxx, [SectionXX a]
ss, [SegmentXX a]
ps)

-- | Parse ELF file and produce header and section and segment tables
parseHeaders :: MonadThrow m => BSL.ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
parseHeaders :: ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
parseHeaders ByteString
bs = do
    ((Sing fst
classS :&: TyCon1 HeaderXX @@ fst
hxx) :: Header) <- ByteString -> m Header
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeOrFail ByteString
bs
    Sing fst
-> (IsElfClass fst =>
    HeaderXX fst
    -> ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX)))
-> HeaderXX fst
-> ByteString
-> m (Sigma ElfClass (TyCon1 HeadersXX))
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass Sing fst
classS IsElfClass fst =>
HeaderXX fst -> ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
forall (a :: ElfClass) (m :: * -> *).
(IsElfClass a, MonadThrow m) =>
HeaderXX a -> ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
parseHeaders' TyCon1 HeaderXX @@ fst
HeaderXX fst
hxx ByteString
bs