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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    IO (Ptr EthjetContext)
ethjet_init forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr EthjetContext -> IO ())
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 Int
contract ByteString
input Int
outputSize =

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

  forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
input forall a b. (a -> b) -> a -> b
$
    \(Ptr CChar
inputPtr, Int
inputSize) -> do
       ForeignPtr CChar
outputForeignPtr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
outputSize
       forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
outputForeignPtr forall a b. (a -> b) -> a -> b
$ \Ptr CChar
outputPtr -> do
         CInt
status <-
           forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EthjetContext
globalContext forall a b. (a -> b) -> a -> b
$ \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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contract)
               Ptr CChar
inputPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inputSize)
               Ptr CChar
outputPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outputSize)

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