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

module Test.Sandwich.Contexts.Kubernetes.KindCluster.Setup (
  setUpKindCluster
  , getNodes
  ) where

import Control.Monad
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import qualified Data.List as L
import qualified Data.Map as M
import Data.String.Interpolate
import Relude
import System.Exit
import Test.Sandwich
import Test.Sandwich.Contexts.Kubernetes.Types
import Test.Sandwich.Contexts.Kubernetes.Waits
import UnliftIO.Environment
import UnliftIO.Process


setUpKindCluster :: (
  MonadLoggerIO m, MonadUnliftIO m
  ) => KubernetesClusterContext -> FilePath -> FilePath -> Maybe [(String, String)] -> Text -> m ()
setUpKindCluster :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
KubernetesClusterContext
-> FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> Text
-> m ()
setUpKindCluster kcc :: KubernetesClusterContext
kcc@(KubernetesClusterContext {Int
FilePath
(Manager, KubernetesClientConfig)
Text
KubernetesClusterType
kubernetesClusterName :: Text
kubernetesClusterKubeConfigPath :: FilePath
kubernetesClusterNumNodes :: Int
kubernetesClusterClientConfig :: (Manager, KubernetesClientConfig)
kubernetesClusterType :: KubernetesClusterType
kubernetesClusterType :: KubernetesClusterContext -> KubernetesClusterType
kubernetesClusterClientConfig :: KubernetesClusterContext -> (Manager, KubernetesClientConfig)
kubernetesClusterNumNodes :: KubernetesClusterContext -> Int
kubernetesClusterKubeConfigPath :: KubernetesClusterContext -> FilePath
kubernetesClusterName :: KubernetesClusterContext -> Text
..}) FilePath
kindBinary FilePath
kubectlBinary Maybe [(FilePath, FilePath)]
environmentToUse Text
driver = 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)]
environmentToUse
  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)
  let runWithKubeConfig FilePath
cmd = CreateProcess -> m ProcessHandle
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> m ProcessHandle
createProcessWithLogging ((FilePath -> CreateProcess
shell FilePath
cmd) { env = Just env, delegate_ctlc = True })

  info [i|Installing ingress-nginx|]
  runWithKubeConfig [i|#{kubectlBinary} apply -f https://raw.githubusercontent.com/kubernetes/ingress-nginx/main/deploy/static/provider/kind/deploy.yaml|]
    >>= waitForProcess >>= (`shouldBe` ExitSuccess)
  -- void $ runWithKubeConfig [i|kubectl patch deployments -n ingress-nginx nginx-ingress-controller -p '{"spec":{"template":{"spec":{"containers":[{"name":"nginx-ingress-controller","ports":[{"containerPort":80,"hostPort":0},{"containerPort":443,"hostPort":0}]}],"nodeSelector":{"ingress-ready":"true"},"tolerations":[{"key":"node-role.kubernetes.io/master","operator":"Equal","effect":"NoSchedule"}]}}}}'|]
  info [i|Waiting for ingress-nginx|]
  flip runReaderT (LabelValue @"kubernetesCluster" kcc) $
    waitForPodsToExist "ingress-nginx" (M.singleton "app.kubernetes.io/component" "controller") 120.0 Nothing
  info [i|controller pod existed|]
  runWithKubeConfig [iii|#{kubectlBinary} wait pod
                         --namespace ingress-nginx
                         --for=condition=ready
                         --selector=app.kubernetes.io/component=controller
                         --timeout=300s|]
    >>= waitForProcess >>= (`shouldBe` ExitSuccess)

  -- info [i|Installing metrics server using helm|]
  -- void $ runWithKubeConfig [i|helm repo add bitnami https://charts.bitnami.com/bitnami|]
  -- void $ runWithKubeConfig [i|helm install metrics-server-release bitnami/metrics-server|]

  info [i|Installing metrics server|]
  runWithKubeConfig [i|#{kubectlBinary} apply -f https://github.com/kubernetes-sigs/metrics-server/releases/download/v0.6.4/components.yaml|]
    >>= waitForProcess >>= (`shouldBe` ExitSuccess)
  runWithKubeConfig [i|#{kubectlBinary} patch -n kube-system deployment metrics-server --type=json -p '[{"op":"add","path":"/spec/template/spec/containers/0/args/-","value":"--kubelet-insecure-tls"}]'|]
    >>= waitForProcess >>= (`shouldBe` ExitSuccess)

  when (driver == "docker") $ do
    info [i|Fixing perms on /dev/fuse|] -- Needed on NixOS where it gets mounted 0600, don't know why
    nodes <- getNodes kcc kindBinary environmentToUse
    forM_ nodes $ \Text
node -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|  (#{node}) Fixing /dev/fuse|]
      m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> m FilePath
forall (m :: * -> *).
MonadIO m =>
CreateProcess -> FilePath -> m FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|#{driver} exec "#{node}" chmod 0666 /dev/fuse|]) FilePath
""


getNodes :: MonadUnliftIO m => KubernetesClusterContext -> FilePath -> Maybe [(String, String)] -> m [Text]
getNodes :: forall (m :: * -> *).
MonadUnliftIO m =>
KubernetesClusterContext
-> FilePath -> Maybe [(FilePath, FilePath)] -> m [Text]
getNodes (KubernetesClusterContext {Int
FilePath
(Manager, KubernetesClientConfig)
Text
KubernetesClusterType
kubernetesClusterType :: KubernetesClusterContext -> KubernetesClusterType
kubernetesClusterClientConfig :: KubernetesClusterContext -> (Manager, KubernetesClientConfig)
kubernetesClusterNumNodes :: KubernetesClusterContext -> Int
kubernetesClusterKubeConfigPath :: KubernetesClusterContext -> FilePath
kubernetesClusterName :: KubernetesClusterContext -> Text
kubernetesClusterName :: Text
kubernetesClusterKubeConfigPath :: FilePath
kubernetesClusterNumNodes :: Int
kubernetesClusterClientConfig :: (Manager, KubernetesClientConfig)
kubernetesClusterType :: KubernetesClusterType
..}) FilePath
kindBinary Maybe [(FilePath, FilePath)]
environmentToUse = 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)]
environmentToUse
  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)
  ((words . toText) <$> (readCreateProcess ((shell [i|#{kindBinary} get nodes --name "#{kubernetesClusterName}"|]) { env = Just env }) ""))