{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward where

import Control.Monad.IO.Unlift
import Control.Monad.Logger
import qualified Data.List as L
import Data.String.Interpolate
import qualified Data.Text as T
import Network.URI
import Relude hiding (withFile)
import Safe
import Test.Sandwich
import Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
import Test.Sandwich.Contexts.Kubernetes.Types
import UnliftIO.Environment
import UnliftIO.Process


withForwardKubernetesService' :: (
  MonadUnliftIO m, MonadLoggerIO m
  , HasBaseContextMonad context m
  ) => KubernetesClusterContext -> FilePath -> Text -> Text -> (URI -> m a) -> m a
withForwardKubernetesService' :: forall (m :: * -> *) context a.
(MonadUnliftIO m, MonadLoggerIO m,
 HasBaseContextMonad context m) =>
KubernetesClusterContext
-> FilePath -> Text -> Text -> (URI -> m a) -> m a
withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType :: KubernetesClusterContext -> KubernetesClusterType
kubernetesClusterType=(KubernetesClusterKind {FilePath
Maybe [(FilePath, FilePath)]
Text
kubernetesClusterTypeKindBinary :: FilePath
kubernetesClusterTypeKindClusterName :: Text
kubernetesClusterTypeKindClusterDriver :: Text
kubernetesClusterTypeKindClusterEnvironment :: Maybe [(FilePath, FilePath)]
kubernetesClusterTypeKindClusterEnvironment :: KubernetesClusterType -> Maybe [(FilePath, FilePath)]
kubernetesClusterTypeKindClusterDriver :: KubernetesClusterType -> Text
kubernetesClusterTypeKindClusterName :: KubernetesClusterType -> Text
kubernetesClusterTypeKindBinary :: KubernetesClusterType -> FilePath
..}), Int
FilePath
(Manager, KubernetesClientConfig)
Text
kubernetesClusterName :: Text
kubernetesClusterKubeConfigPath :: FilePath
kubernetesClusterNumNodes :: Int
kubernetesClusterClientConfig :: (Manager, KubernetesClientConfig)
kubernetesClusterClientConfig :: KubernetesClusterContext -> (Manager, KubernetesClientConfig)
kubernetesClusterNumNodes :: KubernetesClusterContext -> Int
kubernetesClusterKubeConfigPath :: KubernetesClusterContext -> FilePath
kubernetesClusterName :: KubernetesClusterContext -> Text
..}) FilePath
kubectlBinary Text
namespace Text
service URI -> m a
action = do
  baseEnv <- m [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> m [(FilePath, FilePath)])
-> Maybe [(FilePath, FilePath)]
-> m [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m [(FilePath, FilePath)]
forall (m :: * -> *). MonadIO m => m [(FilePath, FilePath)]
getEnvironment [(FilePath, FilePath)] -> m [(FilePath, FilePath)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(FilePath, FilePath)]
kubernetesClusterTypeKindClusterEnvironment
  let env = ((FilePath, FilePath) -> (FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy (\(FilePath, FilePath)
x (FilePath, FilePath)
y -> (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
y) ((FilePath
"KUBECONFIG", FilePath
kubernetesClusterKubeConfigPath) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
baseEnv)

  portRaw <- (toString . T.strip . toText) <$> readCreateProcessWithLogging (
    (proc kubectlBinary [
      "get"
      , "service", toString service
      , "--namespace", toString namespace
      , [i|-o=jsonpath={.spec.ports[0].port}|]
      ]) { env = Just env }) ""

  port <- case readMay portRaw of
    Just PortNumber
p -> PortNumber -> m PortNumber
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PortNumber
p
    Maybe PortNumber
Nothing -> FilePath -> m PortNumber
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
expectationFailure [i|Failed to parse service port: #{portRaw}|]

  withKubectlPortForward' kubectlBinary kubernetesClusterKubeConfigPath namespace (const True) Nothing ("svc/" <> service) port $ \(KubectlPortForwardContext {PortNumber
kubectlPortForwardPort :: PortNumber
kubectlPortForwardPort :: KubectlPortForwardContext -> PortNumber
..}) -> do
    URI -> m a
action (URI -> m a) -> URI -> m a
forall a b. (a -> b) -> a -> b
$ URI
nullURI {
      uriScheme = "http:"
      , uriAuthority = Just (nullURIAuth {
                                uriRegName = "localhost"
                                , uriPort = ":" <> show kubectlPortForwardPort
                                })
      }

withForwardKubernetesService' KubernetesClusterContext
_ FilePath
_ Text
_ Text
_ URI -> m a
_ = Text -> m a
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"withForwardKubernetesService' must be called with a kind KubernetesClusterContext"