{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Temporal.Core.EphemeralServer where

import Control.Monad
import Data.Aeson
import Data.Aeson.TH
import Data.ByteString (ByteString, useAsCString)
import qualified Data.ByteString.Lazy as BL
import Data.Word
import Foreign.C.String hiding (withCString)
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import Temporal.Core.CTypes
import Temporal.Internal.FFI
import Temporal.Runtime


data SDKDefault = SDKDefault {SDKDefault -> String
sdkName :: String, SDKDefault -> String
sdkVersion :: String}


data EphemeralExeVersion
  = -- | Use a default version for the given SDK name and version.
    Default SDKDefault
  | -- | Specific version.
    Fixed String


instance ToJSON EphemeralExeVersion where
  toJSON :: EphemeralExeVersion -> Value
toJSON (Default (SDKDefault String
name String
version)) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SDKDefault"
      , Key
"contents"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [ Key
"sdk_name" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
name
            , Key
"sdk_version" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
version
            ]
      ]
  toJSON (Fixed String
version) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Fixed"
      , Key
"contents" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
version
      ]


data EphemeralExe
  = -- | Existing path on the filesystem for the executable.
    ExistingPath FilePath
  | -- | Download the executable if not already there.
    CachedDownload EphemeralExeVersion (Maybe FilePath)


instance ToJSON EphemeralExe where
  toJSON :: EphemeralExe -> Value
toJSON (ExistingPath String
path) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ExistingPath"
      , Key
"contents" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
path
      ]
  toJSON (CachedDownload EphemeralExeVersion
version Maybe String
destDir) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CachedDownload"
      , Key
"contents"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [ Key
"version" Key -> EphemeralExeVersion -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EphemeralExeVersion
version
            , Key
"dest_dir" Key -> Maybe String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe String
destDir
            ]
      ]


data TemporalDevServerConfig = TemporalDevServerConfig
  { TemporalDevServerConfig -> EphemeralExe
exe :: EphemeralExe
  , TemporalDevServerConfig -> String
namespace :: FilePath
  , TemporalDevServerConfig -> String
ip :: String
  , TemporalDevServerConfig -> Maybe Word16
port :: Maybe Word16
  , TemporalDevServerConfig -> Maybe String
dbFilename :: Maybe FilePath
  , TemporalDevServerConfig -> Bool
ui :: Bool
  , TemporalDevServerConfig -> Maybe Word16
uiPort :: Maybe Word16
  , TemporalDevServerConfig -> (String, String)
log :: (String, String)
  , TemporalDevServerConfig -> [String]
extraArgs :: [String]
  }


deriveToJSON (defaultOptions {fieldLabelModifier = camelTo2 '_'}) ''TemporalDevServerConfig


defaultTemporalDevServerConfig :: TemporalDevServerConfig
defaultTemporalDevServerConfig :: TemporalDevServerConfig
defaultTemporalDevServerConfig =
  TemporalDevServerConfig
    { exe :: EphemeralExe
exe = EphemeralExeVersion -> Maybe String -> EphemeralExe
CachedDownload (SDKDefault -> EphemeralExeVersion
Default (SDKDefault -> EphemeralExeVersion)
-> SDKDefault -> EphemeralExeVersion
forall a b. (a -> b) -> a -> b
$ String -> String -> SDKDefault
SDKDefault String
"community-haskell" String
"0.1.0.0") Maybe String
forall a. Maybe a
Nothing
    , namespace :: String
namespace = String
"default"
    , ip :: String
ip = String
"127.0.0.1"
    , port :: Maybe Word16
port = Maybe Word16
forall a. Maybe a
Nothing
    , dbFilename :: Maybe String
dbFilename = Maybe String
forall a. Maybe a
Nothing
    , ui :: Bool
ui = Bool
False
    , uiPort :: Maybe Word16
uiPort = Maybe Word16
forall a. Maybe a
Nothing
    , log :: (String, String)
log = (String
"pretty", String
"warn")
    , extraArgs :: [String]
extraArgs = []
    }


newtype EphemeralServer = EphemeralServer {EphemeralServer -> ForeignPtr EphemeralServer
ephemeralServerPtr :: ForeignPtr EphemeralServer}


foreign import ccall "hs_temporal_start_dev_server"
  raw_startDevServer
    :: Ptr Runtime
    -> CString
    -> TokioCall (CArray Word8) EphemeralServer


startDevServer :: Runtime -> TemporalDevServerConfig -> IO (Either ByteString EphemeralServer)
startDevServer :: Runtime
-> TemporalDevServerConfig
-> IO (Either ByteString EphemeralServer)
startDevServer Runtime
r TemporalDevServerConfig
c = Runtime
-> (Ptr Runtime -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a. Runtime -> (Ptr Runtime -> IO a) -> IO a
withRuntime Runtime
r ((Ptr Runtime -> IO (Either ByteString EphemeralServer))
 -> IO (Either ByteString EphemeralServer))
-> (Ptr Runtime -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a b. (a -> b) -> a -> b
$ \Ptr Runtime
rp -> ByteString
-> (CString -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (LazyByteString -> ByteString
BL.toStrict (TemporalDevServerConfig -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encode TemporalDevServerConfig
c)) ((CString -> IO (Either ByteString EphemeralServer))
 -> IO (Either ByteString EphemeralServer))
-> (CString -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> do
  res <-
    TokioCall (CArray Word8) EphemeralServer
-> Maybe (FinalizerPtr (CArray Word8))
-> Maybe (FinalizerPtr EphemeralServer)
-> IO
     (Either (ForeignPtr (CArray Word8)) (ForeignPtr EphemeralServer))
forall err res.
TokioCall err res
-> Maybe (FinalizerPtr err)
-> Maybe (FinalizerPtr res)
-> IO (Either (ForeignPtr err) (ForeignPtr res))
makeTokioAsyncCall
      (Ptr Runtime -> CString -> TokioCall (CArray Word8) EphemeralServer
raw_startDevServer Ptr Runtime
rp CString
cstr)
      (FinalizerPtr (CArray Word8) -> Maybe (FinalizerPtr (CArray Word8))
forall a. a -> Maybe a
Just FinalizerPtr (CArray Word8)
rust_dropByteArray)
      Maybe (FinalizerPtr EphemeralServer)
forall a. Maybe a
Nothing
  case res of
    Left ForeignPtr (CArray Word8)
err -> ByteString -> Either ByteString EphemeralServer
forall a b. a -> Either a b
Left (ByteString -> Either ByteString EphemeralServer)
-> IO ByteString -> IO (Either ByteString EphemeralServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr (CArray Word8)
-> (Ptr (CArray Word8) -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CArray Word8)
err (Ptr (CArray Word8) -> IO (CArray Word8)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (CArray Word8) -> IO (CArray Word8))
-> (CArray Word8 -> IO ByteString)
-> Ptr (CArray Word8)
-> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CArray Word8 -> IO ByteString
cArrayToByteString)
    Right ForeignPtr EphemeralServer
srv -> Either ByteString EphemeralServer
-> IO (Either ByteString EphemeralServer)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString EphemeralServer
 -> IO (Either ByteString EphemeralServer))
-> Either ByteString EphemeralServer
-> IO (Either ByteString EphemeralServer)
forall a b. (a -> b) -> a -> b
$ EphemeralServer -> Either ByteString EphemeralServer
forall a b. b -> Either a b
Right (EphemeralServer -> Either ByteString EphemeralServer)
-> EphemeralServer -> Either ByteString EphemeralServer
forall a b. (a -> b) -> a -> b
$ ForeignPtr EphemeralServer -> EphemeralServer
EphemeralServer ForeignPtr EphemeralServer
srv


foreign import ccall "hs_temporal_shutdown_ephemeral_server" raw_shutdownEphemeralServer :: Ptr EphemeralServer -> TokioCall (CArray Word8) CUnit


shutdownEphemeralServer :: EphemeralServer -> IO (Either ByteString ())
shutdownEphemeralServer :: EphemeralServer -> IO (Either ByteString ())
shutdownEphemeralServer (EphemeralServer ForeignPtr EphemeralServer
e) = ForeignPtr EphemeralServer
-> (Ptr EphemeralServer -> IO (Either ByteString ()))
-> IO (Either ByteString ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EphemeralServer
e ((Ptr EphemeralServer -> IO (Either ByteString ()))
 -> IO (Either ByteString ()))
-> (Ptr EphemeralServer -> IO (Either ByteString ()))
-> IO (Either ByteString ())
forall a b. (a -> b) -> a -> b
$ \Ptr EphemeralServer
ep -> do
  res <-
    TokioCall (CArray Word8) CUnit
-> Maybe (FinalizerPtr (CArray Word8))
-> Maybe (FinalizerPtr CUnit)
-> IO (Either (ForeignPtr (CArray Word8)) (ForeignPtr CUnit))
forall err res.
TokioCall err res
-> Maybe (FinalizerPtr err)
-> Maybe (FinalizerPtr res)
-> IO (Either (ForeignPtr err) (ForeignPtr res))
makeTokioAsyncCall
      (Ptr EphemeralServer -> TokioCall (CArray Word8) CUnit
raw_shutdownEphemeralServer Ptr EphemeralServer
ep)
      (FinalizerPtr (CArray Word8) -> Maybe (FinalizerPtr (CArray Word8))
forall a. a -> Maybe a
Just FinalizerPtr (CArray Word8)
rust_dropByteArray)
      (FinalizerPtr CUnit -> Maybe (FinalizerPtr CUnit)
forall a. a -> Maybe a
Just FinalizerPtr CUnit
rust_dropUnit)
  case res of
    Left ForeignPtr (CArray Word8)
err -> ByteString -> Either ByteString ()
forall a b. a -> Either a b
Left (ByteString -> Either ByteString ())
-> IO ByteString -> IO (Either ByteString ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr (CArray Word8)
-> (Ptr (CArray Word8) -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CArray Word8)
err (Ptr (CArray Word8) -> IO (CArray Word8)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (CArray Word8) -> IO (CArray Word8))
-> (CArray Word8 -> IO ByteString)
-> Ptr (CArray Word8)
-> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CArray Word8 -> IO ByteString
cArrayToByteString)
    Right ForeignPtr CUnit
_ -> Either ByteString () -> IO (Either ByteString ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString () -> IO (Either ByteString ()))
-> Either ByteString () -> IO (Either ByteString ())
forall a b. (a -> b) -> a -> b
$ () -> Either ByteString ()
forall a b. b -> Either a b
Right ()


-- TODO
-- startDevServerWithOutput

data TestServerConfig = TestServerConfig
  { TestServerConfig -> EphemeralExe
exe :: EphemeralExe
  , TestServerConfig -> Maybe Word16
port :: Maybe Word16
  , TestServerConfig -> [String]
extraArgs :: [String]
  }


deriveToJSON (defaultOptions {fieldLabelModifier = camelTo2 '_'}) ''TestServerConfig


foreign import ccall "hs_temporal_start_test_server"
  raw_startTestServer
    :: Ptr Runtime
    -> CString
    -> TokioCall (CArray Word8) EphemeralServer


startTestServer :: Runtime -> TestServerConfig -> IO (Either ByteString EphemeralServer)
startTestServer :: Runtime
-> TestServerConfig -> IO (Either ByteString EphemeralServer)
startTestServer Runtime
r TestServerConfig
conf = Runtime
-> (Ptr Runtime -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a. Runtime -> (Ptr Runtime -> IO a) -> IO a
withRuntime Runtime
r ((Ptr Runtime -> IO (Either ByteString EphemeralServer))
 -> IO (Either ByteString EphemeralServer))
-> (Ptr Runtime -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a b. (a -> b) -> a -> b
$ \Ptr Runtime
rp -> ByteString
-> (CString -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TestServerConfig -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encode TestServerConfig
conf) ((CString -> IO (Either ByteString EphemeralServer))
 -> IO (Either ByteString EphemeralServer))
-> (CString -> IO (Either ByteString EphemeralServer))
-> IO (Either ByteString EphemeralServer)
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> do
  res <-
    TokioCall (CArray Word8) EphemeralServer
-> Maybe (FinalizerPtr (CArray Word8))
-> Maybe (FinalizerPtr EphemeralServer)
-> IO
     (Either (ForeignPtr (CArray Word8)) (ForeignPtr EphemeralServer))
forall err res.
TokioCall err res
-> Maybe (FinalizerPtr err)
-> Maybe (FinalizerPtr res)
-> IO (Either (ForeignPtr err) (ForeignPtr res))
makeTokioAsyncCall
      (Ptr Runtime -> CString -> TokioCall (CArray Word8) EphemeralServer
raw_startTestServer Ptr Runtime
rp CString
cstr)
      (FinalizerPtr (CArray Word8) -> Maybe (FinalizerPtr (CArray Word8))
forall a. a -> Maybe a
Just FinalizerPtr (CArray Word8)
rust_dropByteArray)
      Maybe (FinalizerPtr EphemeralServer)
forall a. Maybe a
Nothing
  case res of
    Left ForeignPtr (CArray Word8)
err -> ByteString -> Either ByteString EphemeralServer
forall a b. a -> Either a b
Left (ByteString -> Either ByteString EphemeralServer)
-> IO ByteString -> IO (Either ByteString EphemeralServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr (CArray Word8)
-> (Ptr (CArray Word8) -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CArray Word8)
err (Ptr (CArray Word8) -> IO (CArray Word8)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (CArray Word8) -> IO (CArray Word8))
-> (CArray Word8 -> IO ByteString)
-> Ptr (CArray Word8)
-> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CArray Word8 -> IO ByteString
cArrayToByteString)
    Right ForeignPtr EphemeralServer
srv -> Either ByteString EphemeralServer
-> IO (Either ByteString EphemeralServer)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString EphemeralServer
 -> IO (Either ByteString EphemeralServer))
-> Either ByteString EphemeralServer
-> IO (Either ByteString EphemeralServer)
forall a b. (a -> b) -> a -> b
$ EphemeralServer -> Either ByteString EphemeralServer
forall a b. b -> Either a b
Right (EphemeralServer -> Either ByteString EphemeralServer)
-> EphemeralServer -> Either ByteString EphemeralServer
forall a b. (a -> b) -> a -> b
$ ForeignPtr EphemeralServer -> EphemeralServer
EphemeralServer ForeignPtr EphemeralServer
srv