Merge pull request #15 from guoshimin/kubeconfig

adding a package for working with kubeconfig files

kubeconfig/.gitignore

@@ -0,0 +1,9 @@
+.stack-work
+src/highlight.js
+src/style.css
+dist
+dist-newstyle
+cabal.project.local
+.cabal-sandbox
+cabal.sandbox.config
+*.cabal

kubeconfig/package.yaml

@@ -0,0 +1,23 @@
+name: kubeconfig
+version: 0.1.0.0
+description: |
+  This package contains functions for working with kubeconfig files.
+
+  Usage of kubeconfig files are described at https://kubernetes.io/docs/concepts/configuration/organize-cluster-access-kubeconfig/
+library:
+  source-dirs: src
+tests:
+  spec:
+    main: Spec.hs
+    source-dirs: test
+    dependencies:
+      - hspec
+      - yaml
+      - kubeconfig
+extra-source-files:
+  - test/testdata/*
+dependencies:
+  - base >=4.7 && <5.0
+  - aeson
+  - containers
+  - text

kubeconfig/src/Kubernetes/KubeConfig.hs

@@ -0,0 +1,184 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+
+{-|
+Module      : Kubernetes.KubeConfig
+Description : Data model for the kubeconfig.
+
+This module contains the definition of the data model of the kubeconfig.
+
+The official definition of the kubeconfig is defined in https://github.com/kubernetes/client-go/blob/master/tools/clientcmd/api/v1/types.go.
+
+This is a mostly straightforward translation into Haskell, with 'FromJSON' and 'ToJSON' instances defined.
+-}
+module Kubernetes.KubeConfig where
+
+import           Data.Aeson     (FromJSON (..), Options, ToJSON (..),
+                                 Value (..), camelTo2, defaultOptions,
+                                 fieldLabelModifier, genericParseJSON,
+                                 genericToJSON, object, omitNothingFields,
+                                 withObject, (.:), (.=))
+import qualified Data.Map       as Map
+import           Data.Proxy
+import           Data.Semigroup ((<>))
+import           Data.Text      (Text)
+import qualified Data.Text      as T
+import           Data.Typeable
+import           GHC.Generics
+import           GHC.TypeLits
+
+camelToWithOverrides :: Char -> Map.Map String String -> Options
+camelToWithOverrides c overrides = defaultOptions
+    { fieldLabelModifier = modifier
+    , omitNothingFields  = True
+    }
+    where modifier s = Map.findWithDefault (camelTo2 c s) s overrides
+
+-- |Represents a kubeconfig.
+data Config = Config
+  { kind           :: Maybe Text
+  , apiVersion     :: Maybe Text
+  , preferences    :: Preferences
+  , clusters       :: [NamedEntity Cluster "cluster"]
+  , authInfos      :: [NamedEntity AuthInfo "user"]
+  , contexts       :: [NamedEntity Context "context"]
+  , currentContext :: Text
+  } deriving (Eq, Generic, Show)
+
+configJSONOptions = camelToWithOverrides
+    '-'
+    (Map.fromList [("apiVersion", "apiVersion"), ("authInfos", "users")])
+
+instance ToJSON Config where
+  toJSON = genericToJSON configJSONOptions
+
+instance FromJSON Config where
+  parseJSON = genericParseJSON configJSONOptions
+
+newtype Preferences = Preferences
+  { colors :: Maybe Bool
+  } deriving (Eq, Generic, Show)
+
+instance ToJSON Preferences where
+  toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty
+
+instance FromJSON Preferences where
+  parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty
+
+data Cluster = Cluster
+  { server                   :: Text
+  , insecureSkipTLSVerify    :: Maybe Bool
+  , certificateAuthority     :: Maybe Text
+  , certificateAuthorityData :: Maybe Text
+  } deriving (Eq, Generic, Show, Typeable)
+
+instance ToJSON Cluster where
+  toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty
+
+instance FromJSON Cluster where
+  parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty
+
+data NamedEntity a (typeKey :: Symbol) = NamedEntity
+  { name   :: Text
+  , entity :: a } deriving (Eq, Generic, Show)
+
+instance (FromJSON a, Typeable a, KnownSymbol s) =>
+         FromJSON (NamedEntity a s) where
+  parseJSON = withObject ("Named" <> (show $ typeOf (undefined :: a))) $ \v ->
+    NamedEntity <$> v .: "name" <*> v .: T.pack (symbolVal (Proxy :: Proxy s))
+
+instance (ToJSON a, KnownSymbol s) =>
+         ToJSON (NamedEntity a s) where
+  toJSON (NamedEntity {..}) = object
+      ["name" .= toJSON name, T.pack (symbolVal (Proxy :: Proxy s)) .= toJSON entity]
+
+toMap :: [NamedEntity a s] -> Map.Map Text a
+toMap = Map.fromList . fmap (\NamedEntity {..} -> (name, entity))
+
+data AuthInfo = AuthInfo
+  { clientCertificate     :: Maybe FilePath
+  , clientCertificateData :: Maybe Text
+  , clientKey             :: Maybe FilePath
+  , clientKeyData         :: Maybe Text
+  , token                 :: Maybe Text
+  , tokenFile             :: Maybe FilePath
+  , impersonate           :: Maybe Text
+  , impersonateGroups     :: Maybe [Text]
+  , impersonateUserExtra  :: Maybe (Map.Map Text [Text])
+  , username              :: Maybe Text
+  , password              :: Maybe Text
+  , authProvider          :: Maybe AuthProviderConfig
+  } deriving (Eq, Generic, Show, Typeable)
+
+authInfoJSONOptions = camelToWithOverrides
+    '-'
+    ( Map.fromList
+        [ ("tokenFile"           , "tokenFile")
+        , ("impersonate"         , "as")
+        , ("impersonateGroups"   , "as-groups")
+        , ("impersonateUserExtra", "as-user-extra")
+        ]
+    )
+
+instance ToJSON AuthInfo where
+  toJSON = genericToJSON authInfoJSONOptions
+
+instance FromJSON AuthInfo where
+  parseJSON = genericParseJSON authInfoJSONOptions
+
+data Context = Context
+  { cluster   :: Text
+  , authInfo  :: Text
+  , namespace :: Maybe Text
+  } deriving (Eq, Generic, Show, Typeable)
+
+contextJSONOptions =
+    camelToWithOverrides '-' (Map.fromList [("authInfo", "user")])
+
+instance ToJSON Context where
+  toJSON = genericToJSON contextJSONOptions
+
+instance FromJSON Context where
+  parseJSON = genericParseJSON contextJSONOptions
+
+data AuthProviderConfig = AuthProviderConfig
+  { name   :: Text
+  , config :: Maybe (Map.Map Text Text)
+  } deriving (Eq, Generic, Show)
+
+instance ToJSON AuthProviderConfig where
+  toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty
+
+instance FromJSON AuthProviderConfig where
+  parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty
+
+-- |Returns the currently active context.
+getContext :: Config -> Either String Context
+getContext Config {..} =
+    let maybeContext = Map.lookup currentContext (toMap contexts)
+    in  case maybeContext of
+            Just ctx -> Right ctx
+            Nothing  -> Left ("No context named " <> T.unpack currentContext)
+
+-- |Returns the currently active user.
+getAuthInfo :: Config -> Either String (Text, AuthInfo)
+getAuthInfo cfg@Config {..} = do
+    Context {..} <- getContext cfg
+    let maybeAuth = Map.lookup authInfo (toMap authInfos)
+    case maybeAuth of
+        Just auth -> Right (authInfo, auth)
+        Nothing   -> Left ("No user named " <> T.unpack authInfo)
+
+-- |Returns the currently active cluster.
+getCluster :: Config -> Either String Cluster
+getCluster cfg@Config {clusters=clusters} = do
+    Context {cluster=clusterName} <- getContext cfg
+    let maybeCluster = Map.lookup clusterName (toMap clusters)
+    case maybeCluster of
+        Just cluster -> Right cluster
+        Nothing      -> Left ("No cluster named " <> T.unpack clusterName)

kubeconfig/test/Spec.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import           Data.Aeson            (decode, encode, parseJSON, toJSON)
+import           Data.Maybe            (fromJust)
+import           Data.Yaml             (decodeFile)
+import           Kubernetes.KubeConfig (AuthInfo (..), Cluster (..), Config,
+                                        Context (..), getAuthInfo, getCluster,
+                                        getContext)
+import           Test.Hspec
+
+main :: IO ()
+main = do
+  config :: Config <- fromJust <$> decodeFile "test/testdata/kubeconfig.yaml"
+  hspec $ do
+    describe "FromJSON and ToJSON instances" $ do
+      it "roundtrips successfully" $ do
+        decode (encode (toJSON config)) `shouldBe` Just config
+    describe "getContext" $ do
+      it "returns the correct context" $ do
+        getContext config `shouldBe` (Right (Context "cluster-aaa" "user-aaa" Nothing))
+
+    describe "getCluster" $ do
+      it "returns the correct cluster" $ do
+        server <$> getCluster config `shouldBe` (Right "https://aaa.example.com")
+
+    describe "getAuthInfo" $ do
+      it "returns the correct authInfo" $ do
+        fst <$> getAuthInfo config `shouldBe` (Right "user-aaa")

kubeconfig/test/testdata/kubeconfig.yaml

@@ -0,0 +1,35 @@
+apiVersion: v1
+clusters:
+- cluster:
+    certificate-authority-data: fake-ca-data
+    server: https://aaa.example.com
+  name: cluster-aaa
+- cluster:
+    certificate-authority-data: fake-ca-data
+    server: https://bbb.example.com
+  name: cluster-bbb
+contexts:
+- context:
+    cluster: cluster-aaa
+    user: user-aaa
+  name: aaa
+- context:
+    cluster: cluster-bbb
+    user: user-bbb
+  name: bbb
+current-context: aaa
+kind: Config
+preferences: {}
+users:
+- name: user-aaa
+  user:
+    auth-provider:
+      config:
+        access-token: fake-token
+        expiry: 2017-06-06 22:53:31
+        expiry-key: '{.credential.token_expiry}'
+        token-key: '{.credential.access_token}'
+      name: gcp
+- name: user-bbb
+  user:
+    token: fake-token

stack.yaml

@@ -4,3 +4,4 @@ packages:
 - kubernetes
 - kubernetes-client-helper
 - kubernetes-watch
+- kubeconfig