diff --git a/examples/.gitignore b/examples/.gitignore new file mode 100644 index 0000000..403847d --- /dev/null +++ b/examples/.gitignore @@ -0,0 +1,4 @@ +dist +dist-newstyle +*.cabal +.stack-work diff --git a/examples/LICENSE b/examples/LICENSE new file mode 120000 index 0000000..ea5b606 --- /dev/null +++ b/examples/LICENSE @@ -0,0 +1 @@ +../LICENSE \ No newline at end of file diff --git a/examples/package.yaml b/examples/package.yaml new file mode 100644 index 0000000..513fb0c --- /dev/null +++ b/examples/package.yaml @@ -0,0 +1,29 @@ +name: kubernetes-examples +version: 0.1.0.1 +description: | + Examples to interact with Kubernetes using kubernetes-client and kubernetes-client-core +synopsis: Kubernetes examples with Haskell +maintainer: +- Shimin Guo +- Akshay Mankar +category: Examples, Kubernetes +license: Apache-2.0 +license-file: LICENSE + +executables: + simple: + main: Main.hs + source-dirs: simple + ghc-options: + - -Wall + +dependencies: +- base +- containers +- http-client +- http-types +- kubernetes-client +- kubernetes-client-core +- safe-exceptions +- stm +- text diff --git a/examples/simple/Main.hs b/examples/simple/Main.hs new file mode 100644 index 0000000..b3342c5 --- /dev/null +++ b/examples/simple/Main.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Concurrent.STM +import Control.Exception.Safe +import Kubernetes.Client +import Kubernetes.OpenAPI +import Kubernetes.OpenAPI.API.AppsV1 +import Kubernetes.OpenAPI.API.CoreV1 +import Network.HTTP.Client +import Network.HTTP.Types.Status +import System.Environment + +import qualified Data.Map as Map +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + kubeConfigFile <- getEnv "KUBECONFIG" + oidcCache <- newTVarIO $ Map.fromList [] + (manager, cfg) <- mkKubeClientConfig oidcCache + $ KubeConfigFile kubeConfigFile + let createNamespaceRequest = + createNamespace (ContentType MimeJSON) (Accept MimeJSON) testNamespace + createdNS <- assertMimeSuccess =<< dispatchMime manager cfg createNamespaceRequest + nsName <- assertJust "Expected K8s to generate name for namespace, but it didn't" + $ (v1ObjectMetaName =<< v1NamespaceMetadata createdNS) + T.putStrLn $ "Created Namespace: " <> nsName + + let createDeploymentRequest = + createNamespacedDeployment (ContentType MimeJSON) (Accept MimeJSON) testDeployment (Namespace nsName) + deployment <- assertMimeSuccess =<< dispatchMime manager cfg createDeploymentRequest + T.putStrLn $ "Created Deployment: " <> maybe "No name!?" id (v1DeploymentMetadata deployment >>= v1ObjectMetaName) + + let listDeploymentsRequest = + listNamespacedDeployment (Accept MimeJSON) (Namespace nsName) + listedDeployments <- assertMimeSuccess =<< dispatchMime manager cfg listDeploymentsRequest + let numberOfDeployments = length $ v1DeploymentListItems listedDeployments + if numberOfDeployments /= 1 + then throwM $ AssertionFailure $ "Expected 1 deployment, found: " <> show numberOfDeployments + else putStrLn "Test successful!" + + -- NOTE: We cannot use dispatchMime due to this issue: https://github.com/kubernetes/kubernetes/issues/59501 + let deleteNamespaceRequest = + deleteNamespace (ContentType MimeJSON) (Accept MimeJSON) (Name nsName) + deleteNamespaceResponse <- dispatchLbs manager cfg deleteNamespaceRequest + if responseStatus deleteNamespaceResponse /= status200 + then throwM $ AssertionFailure + $ "Failed to cleanup namespace: " <> T.unpack nsName + <> "\nStatus Code: " <> show (responseStatus deleteNamespaceResponse) + <> "\nBody: " <> show (responseBody deleteNamespaceResponse) + else return () + putStrLn "Clenaup complete!" + +testDeployment :: V1Deployment +testDeployment = + let labelSelector = + mkV1LabelSelector + { v1LabelSelectorMatchLabels = + Just $ Map.fromList [("app", "test")] } + container = + (mkV1Container "container-name") + { v1ContainerImage = Just $ "nginx" } + podTemplate = + mkV1PodTemplateSpec + { v1PodTemplateSpecMetadata = + Just $ mkV1ObjectMeta + { v1ObjectMetaLabels = Just $ Map.fromList [("app", "test")] } + , v1PodTemplateSpecSpec = + Just $ + mkV1PodSpec [container] + } + in mkV1Deployment + { v1DeploymentMetadata = + Just $ mkV1ObjectMeta { v1ObjectMetaName = Just "test-deployment" } + , v1DeploymentSpec = + Just + $ (mkV1DeploymentSpec labelSelector podTemplate) + } + +testNamespace :: V1Namespace +testNamespace = + let nsMetadata = + mkV1ObjectMeta + { v1ObjectMetaGenerateName = Just "haskell-client-test-" } + in mkV1Namespace + { v1NamespaceMetadata = Just nsMetadata } + +assertMimeSuccess :: MonadThrow m => MimeResult a -> m a +assertMimeSuccess (MimeResult (Right res) _) = pure res +assertMimeSuccess (MimeResult (Left err) _) = + throwM $ AssertionFailure $ "Unexpected MimeError: " ++ show err + +assertJust :: MonadThrow m => String -> Maybe a -> m a +assertJust err Nothing = throwM $ AssertionFailure err +assertJust _ (Just x) = return x + +data AssertionFailure = AssertionFailure String + deriving Show + +instance Exception AssertionFailure diff --git a/examples/stack.yaml b/examples/stack.yaml new file mode 100644 index 0000000..42c637f --- /dev/null +++ b/examples/stack.yaml @@ -0,0 +1,11 @@ +resolver: lts-13.9 +packages: +- . +- ../kubernetes-client +- ../kubernetes +extra-deps: +- jsonpath-0.1.0.1 +- jwt-0.10.0 +- katip-0.8.0.0 +- oidc-client-0.4.0.0 +- string-random-0.1.2.0 diff --git a/examples/stack.yaml.lock b/examples/stack.yaml.lock new file mode 100644 index 0000000..2e7e483 --- /dev/null +++ b/examples/stack.yaml.lock @@ -0,0 +1,47 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: jsonpath-0.1.0.1@sha256:55718ac52b25cd8ce80fbdc9079a112344f032b056cfaf30737a29b6bd1a5c12,2377 + pantry-tree: + size: 1097 + sha256: 027749c943abaa6a78adc58e5abd4b3f42644c17c5fb7edf816557424a79448b + original: + hackage: jsonpath-0.1.0.1 +- completed: + hackage: jwt-0.10.0@sha256:d14551b0c357424fb9441ec9a7a9d5b90b13f805fcc9327ba49db548cd64fc29,4180 + pantry-tree: + size: 1027 + sha256: e0cf95e834d99768ad8a3f7e99246948f0cdd2cfa18813517f540144aea6c3e5 + original: + hackage: jwt-0.10.0 +- completed: + hackage: katip-0.8.0.0@sha256:8a74858b692edfdbe83ac377b116111f81b4dcda774024615967d764f9f474b8,4097 + pantry-tree: + size: 1140 + sha256: f6baad9ee2edc7ed02d71bd8433872403500ebbdfaead9e4ef226dc47b3c4b97 + original: + hackage: katip-0.8.0.0 +- completed: + hackage: oidc-client-0.4.0.0@sha256:f72a496ab27d9a5071be44e750718c539118ac52c2f1535a5fb3dde7f9874a55,3306 + pantry-tree: + size: 1153 + sha256: 68c285c6365360975d50bbb18cb07755d5ef19af8bf0e998d3ea46d35ef4a4e1 + original: + hackage: oidc-client-0.4.0.0 +- completed: + hackage: string-random-0.1.2.0@sha256:db4f801dec1ec72cba7d662b9774da60ff54de6d05478e94478d6d730dc5034f,2439 + pantry-tree: + size: 489 + sha256: 21c7e61fceea98d14b453fc74c947b715ce33fe4c665c65b1f28c6f417d4ab7e + original: + hackage: string-random-0.1.2.0 +snapshots: +- completed: + size: 496697 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/9.yaml + sha256: 3846ba7d13dd1b2679426dc3f450332a3b8a181063b0f3fc2d0c7d55db2e9c24 + original: lts-13.9