{-# Language ForeignFunctionInterface #-}

module EVM.Precompiled (execute) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr

import System.IO.Unsafe

-- | Opaque representation of the C library's context struct.
data EthjetContext

foreign import ccall "ethjet_init"
  ethjet_init :: IO (Ptr EthjetContext)
foreign import ccall "&ethjet_free"
  ethjet_free :: FunPtr (Ptr EthjetContext -> IO ())
foreign import ccall "ethjet"
  ethjet
    :: Ptr EthjetContext     -- initialized context
    -> CInt                  -- operation
    -> Ptr CChar -> CInt     -- input
    -> Ptr CChar -> CInt     -- output
    -> IO CInt               -- 1 if good

-- Lazy evaluation ensures this context is only initialized once,
-- and `unsafePerformIO` in such situations is a common pattern.
--
-- We use a "foreign pointer" annotated with a finalizer.
globalContext :: ForeignPtr EthjetContext
{-# NOINLINE globalContext #-}
globalContext :: ForeignPtr EthjetContext
globalContext =
  IO (ForeignPtr EthjetContext) -> ForeignPtr EthjetContext
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr EthjetContext) -> ForeignPtr EthjetContext)
-> IO (ForeignPtr EthjetContext) -> ForeignPtr EthjetContext
forall a b. (a -> b) -> a -> b
$
    IO (Ptr EthjetContext)
ethjet_init IO (Ptr EthjetContext)
-> (Ptr EthjetContext -> IO (ForeignPtr EthjetContext))
-> IO (ForeignPtr EthjetContext)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr EthjetContext
-> Ptr EthjetContext -> IO (ForeignPtr EthjetContext)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr EthjetContext
ethjet_free

-- | Run a given precompiled contract using the C library.
execute
  :: Int                -- ^ The number of the precompiled contract
  -> ByteString         -- ^ The input buffer
  -> Int                -- ^ The desired output size
  -> Maybe ByteString   -- ^ Hopefully, the output buffer
execute :: Int -> ByteString -> Int -> Maybe ByteString
execute contract :: Int
contract input :: ByteString
input outputSize :: Int
outputSize =

  -- This code looks messy because of the pointer handling,
  -- but it's actually simple.
  --
  -- We use `unsafePerformIO` because the contracts are pure.

  IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString))
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
input ((CStringLen -> IO (Maybe ByteString)) -> Maybe ByteString)
-> (CStringLen -> IO (Maybe ByteString)) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
    \(inputPtr :: Ptr CChar
inputPtr, inputSize :: Int
inputSize) -> do
       ForeignPtr CChar
outputForeignPtr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
outputSize
       ForeignPtr CChar
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
outputForeignPtr ((Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \outputPtr :: Ptr CChar
outputPtr -> do
         CInt
status <-
           ForeignPtr EthjetContext
-> (Ptr EthjetContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EthjetContext
globalContext ((Ptr EthjetContext -> IO CInt) -> IO CInt)
-> (Ptr EthjetContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \contextPtr :: Ptr EthjetContext
contextPtr ->
             -- Finally, we can invoke the C library.
             Ptr EthjetContext
-> CInt -> Ptr CChar -> CInt -> Ptr CChar -> CInt -> IO CInt
ethjet Ptr EthjetContext
contextPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contract)
               Ptr CChar
inputPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inputSize)
               Ptr CChar
outputPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outputSize)

         case CInt
status of
           1 -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
outputPtr, Int
outputSize)
           _ -> Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing