{- |
Module: Temporal.EphemeralServer
Description: Run an Temporal server in a programatically for testing and development.

Run an Temporal server in a programatically for testing and development.
-}
module Temporal.EphemeralServer (
  launchTestServer,
  launchDevServer,
  withDevServer,
  withTestServer,
  getFreePort,
  openFreePort,
  EphemeralServerError (..),

  -- * Core configuration
  EphemeralExeVersion (..),
  EphemeralExe (..),
  SDKDefault (..),
  TemporalDevServerConfig (..),
  defaultTemporalDevServerConfig,
  EphemeralServer,
  shutdownEphemeralServer,
  N.PortNumber,
) where

import qualified Control.Exception as E
import Data.Bifunctor
import Data.ByteString (ByteString)
import qualified Network.Socket as N
import qualified System.IO.Error as Error
import Temporal.Core.EphemeralServer
import Temporal.Runtime
import UnliftIO


data EphemeralServerError = EphemeralServerError ByteString
  deriving stock (Int -> EphemeralServerError -> ShowS
[EphemeralServerError] -> ShowS
EphemeralServerError -> String
(Int -> EphemeralServerError -> ShowS)
-> (EphemeralServerError -> String)
-> ([EphemeralServerError] -> ShowS)
-> Show EphemeralServerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EphemeralServerError -> ShowS
showsPrec :: Int -> EphemeralServerError -> ShowS
$cshow :: EphemeralServerError -> String
show :: EphemeralServerError -> String
$cshowList :: [EphemeralServerError] -> ShowS
showList :: [EphemeralServerError] -> ShowS
Show)


instance E.Exception EphemeralServerError


withDevServer :: MonadUnliftIO m => Runtime -> TemporalDevServerConfig -> (EphemeralServer -> m a) -> m a
withDevServer :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Runtime
-> TemporalDevServerConfig -> (EphemeralServer -> m a) -> m a
withDevServer Runtime
rt TemporalDevServerConfig
conf =
  m EphemeralServer
-> (EphemeralServer -> m ()) -> (EphemeralServer -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (IO (Either ByteString EphemeralServer)
-> m (Either ByteString EphemeralServer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Runtime
-> TemporalDevServerConfig
-> IO (Either ByteString EphemeralServer)
startDevServer Runtime
rt TemporalDevServerConfig
conf) m (Either ByteString EphemeralServer)
-> (Either ByteString EphemeralServer -> m EphemeralServer)
-> m EphemeralServer
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> m EphemeralServer)
-> (EphemeralServer -> m EphemeralServer)
-> Either ByteString EphemeralServer
-> m EphemeralServer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EphemeralServerError -> m EphemeralServer
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (EphemeralServerError -> m EphemeralServer)
-> (ByteString -> EphemeralServerError)
-> ByteString
-> m EphemeralServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> EphemeralServerError
EphemeralServerError) EphemeralServer -> m EphemeralServer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    (\EphemeralServer
e -> IO (Either ByteString ()) -> m (Either ByteString ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EphemeralServer -> IO (Either ByteString ())
shutdownEphemeralServer EphemeralServer
e) m (Either ByteString ()) -> (Either ByteString () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> m ())
-> (() -> m ()) -> Either ByteString () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EphemeralServerError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (EphemeralServerError -> m ())
-> (ByteString -> EphemeralServerError) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> EphemeralServerError
EphemeralServerError) () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)


withTestServer :: MonadUnliftIO m => Runtime -> TestServerConfig -> (EphemeralServer -> m a) -> m a
withTestServer :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Runtime -> TestServerConfig -> (EphemeralServer -> m a) -> m a
withTestServer Runtime
rt TestServerConfig
conf =
  m EphemeralServer
-> (EphemeralServer -> m ()) -> (EphemeralServer -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (IO (Either ByteString EphemeralServer)
-> m (Either ByteString EphemeralServer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Runtime
-> TestServerConfig -> IO (Either ByteString EphemeralServer)
startTestServer Runtime
rt TestServerConfig
conf) m (Either ByteString EphemeralServer)
-> (Either ByteString EphemeralServer -> m EphemeralServer)
-> m EphemeralServer
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> m EphemeralServer)
-> (EphemeralServer -> m EphemeralServer)
-> Either ByteString EphemeralServer
-> m EphemeralServer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EphemeralServerError -> m EphemeralServer
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (EphemeralServerError -> m EphemeralServer)
-> (ByteString -> EphemeralServerError)
-> ByteString
-> m EphemeralServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> EphemeralServerError
EphemeralServerError) EphemeralServer -> m EphemeralServer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    (\EphemeralServer
e -> IO (Either ByteString ()) -> m (Either ByteString ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (EphemeralServer -> IO (Either ByteString ())
shutdownEphemeralServer EphemeralServer
e) m (Either ByteString ()) -> (Either ByteString () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> m ())
-> (() -> m ()) -> Either ByteString () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EphemeralServerError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (EphemeralServerError -> m ())
-> (ByteString -> EphemeralServerError) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> EphemeralServerError
EphemeralServerError) () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)


{- | Open a TCP socket on a random free port. This is like 'warp''s
  openFreePort.
-}
openFreePort :: IO (N.PortNumber, N.Socket)
openFreePort :: IO (PortNumber, Socket)
openFreePort =
  IO Socket
-> (Socket -> IO ())
-> (Socket -> IO (PortNumber, Socket))
-> IO (PortNumber, Socket)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (Family -> SocketType -> ProtocolNumber -> IO Socket
N.socket Family
N.AF_INET SocketType
N.Stream ProtocolNumber
N.defaultProtocol) Socket -> IO ()
N.close ((Socket -> IO (PortNumber, Socket)) -> IO (PortNumber, Socket))
-> (Socket -> IO (PortNumber, Socket)) -> IO (PortNumber, Socket)
forall a b. (a -> b) -> a -> b
$
    \Socket
sock -> do
      Socket -> SockAddr -> IO ()
N.bind Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostAddress -> SockAddr
N.SockAddrInet PortNumber
0 (HostAddress -> SockAddr) -> HostAddress -> SockAddr
forall a b. (a -> b) -> a -> b
$ (Word8, Word8, Word8, Word8) -> HostAddress
N.tupleToHostAddress (Word8
127, Word8
0, Word8
0, Word8
1)
      Socket -> IO SockAddr
N.getSocketName Socket
sock IO SockAddr
-> (SockAddr -> IO (PortNumber, Socket)) -> IO (PortNumber, Socket)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        N.SockAddrInet PortNumber
port HostAddress
_ -> (PortNumber, Socket) -> IO (PortNumber, Socket)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PortNumber
port, Socket
sock)
        SockAddr
addr ->
          IOError -> IO (PortNumber, Socket)
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (IOError -> IO (PortNumber, Socket))
-> IOError -> IO (PortNumber, Socket)
forall a b. (a -> b) -> a -> b
$
            IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
Error.mkIOError
              IOErrorType
Error.userErrorType
              ( String
"openFreePort was unable to create socket with a SockAddrInet. "
                  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Got "
                  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SockAddr -> String
forall a. Show a => a -> String
show SockAddr
addr
              )
              Maybe Handle
forall a. Maybe a
Nothing
              Maybe String
forall a. Maybe a
Nothing


{- | Open a TCP socket, get its port and close the socket.
  Useful when you have an external service that needs a fresh port.

  There is a small race condition present:
  It's possible to get a free port only for it to
  be bound by some other process or thread before used
-}
getFreePort :: IO N.PortNumber
getFreePort :: IO PortNumber
getFreePort = do
  (port, socket) <- IO (PortNumber, Socket)
openFreePort
  N.close socket
  pure port


launchTestServer :: Runtime -> [String] -> IO (Either EphemeralServerError (N.PortNumber, EphemeralServer))
launchTestServer :: Runtime
-> [String]
-> IO (Either EphemeralServerError (PortNumber, EphemeralServer))
launchTestServer Runtime
rt [String]
extraArgs = do
  freePort <- IO PortNumber
getFreePort
  bimap EphemeralServerError (\EphemeralServer
srv -> (PortNumber
freePort, EphemeralServer
srv)) <$> startTestServer rt (hackyConfig freePort)
  where
    hackyConfig :: PortNumber -> TestServerConfig
hackyConfig PortNumber
port =
      TestServerConfig
        { 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
        , port :: Maybe Word16
port = Word16 -> Maybe Word16
forall a. a -> Maybe a
Just (Word16 -> Maybe Word16) -> Word16 -> Maybe Word16
forall a b. (a -> b) -> a -> b
$ PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port
        , [String]
extraArgs :: [String]
extraArgs :: [String]
extraArgs
        }


launchDevServer :: Runtime -> TemporalDevServerConfig -> IO (Either EphemeralServerError EphemeralServer)
launchDevServer :: Runtime
-> TemporalDevServerConfig
-> IO (Either EphemeralServerError EphemeralServer)
launchDevServer Runtime
rt TemporalDevServerConfig
conf = (ByteString -> EphemeralServerError)
-> Either ByteString EphemeralServer
-> Either EphemeralServerError EphemeralServer
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> EphemeralServerError
EphemeralServerError (Either ByteString EphemeralServer
 -> Either EphemeralServerError EphemeralServer)
-> IO (Either ByteString EphemeralServer)
-> IO (Either EphemeralServerError EphemeralServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime
-> TemporalDevServerConfig
-> IO (Either ByteString EphemeralServer)
startDevServer Runtime
rt TemporalDevServerConfig
conf