Skip to content

Commit 662e346

Browse files
brendandburnsbrendandburns
authored
Merge pull request #15 from guoshimin/kubeconfig
adding a package for working with kubeconfig files
2 parents dee2a32 + a8bdaa0 commit 662e346

File tree

6 files changed

+281
-0
lines changed

6 files changed

+281
-0
lines changed

‎kubeconfig/.gitignore

+9
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
.stack-work
2+
src/highlight.js
3+
src/style.css
4+
dist
5+
dist-newstyle
6+
cabal.project.local
7+
.cabal-sandbox
8+
cabal.sandbox.config
9+
*.cabal

‎kubeconfig/package.yaml

+23
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
name: kubeconfig
2+
version: 0.1.0.0
3+
description: |
4+
This package contains functions for working with kubeconfig files.
5+
6+
Usage of kubeconfig files are described at https://kubernetes.io/docs/concepts/configuration/organize-cluster-access-kubeconfig/
7+
library:
8+
source-dirs: src
9+
tests:
10+
spec:
11+
main: Spec.hs
12+
source-dirs: test
13+
dependencies:
14+
- hspec
15+
- yaml
16+
- kubeconfig
17+
extra-source-files:
18+
- test/testdata/*
19+
dependencies:
20+
- base >=4.7 && <5.0
21+
- aeson
22+
- containers
23+
- text

‎kubeconfig/src/Kubernetes/KubeConfig.hs

+184
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,184 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE KindSignatures #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE RecordWildCards #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
8+
9+
{-|
10+
Module : Kubernetes.KubeConfig
11+
Description : Data model for the kubeconfig.
12+
13+
This module contains the definition of the data model of the kubeconfig.
14+
15+
The official definition of the kubeconfig is defined in https://github.com/kubernetes/client-go/blob/master/tools/clientcmd/api/v1/types.go.
16+
17+
This is a mostly straightforward translation into Haskell, with 'FromJSON' and 'ToJSON' instances defined.
18+
-}
19+
module Kubernetes.KubeConfig where
20+
21+
import Data.Aeson (FromJSON (..), Options, ToJSON (..),
22+
Value (..), camelTo2, defaultOptions,
23+
fieldLabelModifier, genericParseJSON,
24+
genericToJSON, object, omitNothingFields,
25+
withObject, (.:), (.=))
26+
import qualified Data.Map as Map
27+
import Data.Proxy
28+
import Data.Semigroup ((<>))
29+
import Data.Text (Text)
30+
import qualified Data.Text as T
31+
import Data.Typeable
32+
import GHC.Generics
33+
import GHC.TypeLits
34+
35+
camelToWithOverrides :: Char -> Map.Map String String -> Options
36+
camelToWithOverrides c overrides = defaultOptions
37+
{ fieldLabelModifier = modifier
38+
, omitNothingFields = True
39+
}
40+
where modifier s = Map.findWithDefault (camelTo2 c s) s overrides
41+
42+
-- |Represents a kubeconfig.
43+
data Config = Config
44+
{ kind :: Maybe Text
45+
, apiVersion :: Maybe Text
46+
, preferences :: Preferences
47+
, clusters :: [NamedEntity Cluster "cluster"]
48+
, authInfos :: [NamedEntity AuthInfo "user"]
49+
, contexts :: [NamedEntity Context "context"]
50+
, currentContext :: Text
51+
} deriving (Eq, Generic, Show)
52+
53+
configJSONOptions = camelToWithOverrides
54+
'-'
55+
(Map.fromList [("apiVersion", "apiVersion"), ("authInfos", "users")])
56+
57+
instance ToJSON Config where
58+
toJSON = genericToJSON configJSONOptions
59+
60+
instance FromJSON Config where
61+
parseJSON = genericParseJSON configJSONOptions
62+
63+
newtype Preferences = Preferences
64+
{ colors :: Maybe Bool
65+
} deriving (Eq, Generic, Show)
66+
67+
instance ToJSON Preferences where
68+
toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty
69+
70+
instance FromJSON Preferences where
71+
parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty
72+
73+
data Cluster = Cluster
74+
{ server :: Text
75+
, insecureSkipTLSVerify :: Maybe Bool
76+
, certificateAuthority :: Maybe Text
77+
, certificateAuthorityData :: Maybe Text
78+
} deriving (Eq, Generic, Show, Typeable)
79+
80+
instance ToJSON Cluster where
81+
toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty
82+
83+
instance FromJSON Cluster where
84+
parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty
85+
86+
data NamedEntity a (typeKey :: Symbol) = NamedEntity
87+
{ name :: Text
88+
, entity :: a } deriving (Eq, Generic, Show)
89+
90+
instance (FromJSON a, Typeable a, KnownSymbol s) =>
91+
FromJSON (NamedEntity a s) where
92+
parseJSON = withObject ("Named" <> (show $ typeOf (undefined :: a))) $ \v ->
93+
NamedEntity <$> v .: "name" <*> v .: T.pack (symbolVal (Proxy :: Proxy s))
94+
95+
instance (ToJSON a, KnownSymbol s) =>
96+
ToJSON (NamedEntity a s) where
97+
toJSON (NamedEntity {..}) = object
98+
["name" .= toJSON name, T.pack (symbolVal (Proxy :: Proxy s)) .= toJSON entity]
99+
100+
toMap :: [NamedEntity a s] -> Map.Map Text a
101+
toMap = Map.fromList . fmap (\NamedEntity {..} -> (name, entity))
102+
103+
data AuthInfo = AuthInfo
104+
{ clientCertificate :: Maybe FilePath
105+
, clientCertificateData :: Maybe Text
106+
, clientKey :: Maybe FilePath
107+
, clientKeyData :: Maybe Text
108+
, token :: Maybe Text
109+
, tokenFile :: Maybe FilePath
110+
, impersonate :: Maybe Text
111+
, impersonateGroups :: Maybe [Text]
112+
, impersonateUserExtra :: Maybe (Map.Map Text [Text])
113+
, username :: Maybe Text
114+
, password :: Maybe Text
115+
, authProvider :: Maybe AuthProviderConfig
116+
} deriving (Eq, Generic, Show, Typeable)
117+
118+
authInfoJSONOptions = camelToWithOverrides
119+
'-'
120+
( Map.fromList
121+
[ ("tokenFile" , "tokenFile")
122+
, ("impersonate" , "as")
123+
, ("impersonateGroups" , "as-groups")
124+
, ("impersonateUserExtra", "as-user-extra")
125+
]
126+
)
127+
128+
instance ToJSON AuthInfo where
129+
toJSON = genericToJSON authInfoJSONOptions
130+
131+
instance FromJSON AuthInfo where
132+
parseJSON = genericParseJSON authInfoJSONOptions
133+
134+
data Context = Context
135+
{ cluster :: Text
136+
, authInfo :: Text
137+
, namespace :: Maybe Text
138+
} deriving (Eq, Generic, Show, Typeable)
139+
140+
contextJSONOptions =
141+
camelToWithOverrides '-' (Map.fromList [("authInfo", "user")])
142+
143+
instance ToJSON Context where
144+
toJSON = genericToJSON contextJSONOptions
145+
146+
instance FromJSON Context where
147+
parseJSON = genericParseJSON contextJSONOptions
148+
149+
data AuthProviderConfig = AuthProviderConfig
150+
{ name :: Text
151+
, config :: Maybe (Map.Map Text Text)
152+
} deriving (Eq, Generic, Show)
153+
154+
instance ToJSON AuthProviderConfig where
155+
toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty
156+
157+
instance FromJSON AuthProviderConfig where
158+
parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty
159+
160+
-- |Returns the currently active context.
161+
getContext :: Config -> Either String Context
162+
getContext Config {..} =
163+
let maybeContext = Map.lookup currentContext (toMap contexts)
164+
in case maybeContext of
165+
Just ctx -> Right ctx
166+
Nothing -> Left ("No context named " <> T.unpack currentContext)
167+
168+
-- |Returns the currently active user.
169+
getAuthInfo :: Config -> Either String (Text, AuthInfo)
170+
getAuthInfo cfg@Config {..} = do
171+
Context {..} <- getContext cfg
172+
let maybeAuth = Map.lookup authInfo (toMap authInfos)
173+
case maybeAuth of
174+
Just auth -> Right (authInfo, auth)
175+
Nothing -> Left ("No user named " <> T.unpack authInfo)
176+
177+
-- |Returns the currently active cluster.
178+
getCluster :: Config -> Either String Cluster
179+
getCluster cfg@Config {clusters=clusters} = do
180+
Context {cluster=clusterName} <- getContext cfg
181+
let maybeCluster = Map.lookup clusterName (toMap clusters)
182+
case maybeCluster of
183+
Just cluster -> Right cluster
184+
Nothing -> Left ("No cluster named " <> T.unpack clusterName)

‎kubeconfig/test/Spec.hs

+29
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
4+
import Data.Aeson (decode, encode, parseJSON, toJSON)
5+
import Data.Maybe (fromJust)
6+
import Data.Yaml (decodeFile)
7+
import Kubernetes.KubeConfig (AuthInfo (..), Cluster (..), Config,
8+
Context (..), getAuthInfo, getCluster,
9+
getContext)
10+
import Test.Hspec
11+
12+
main :: IO ()
13+
main = do
14+
config :: Config <- fromJust <$> decodeFile "test/testdata/kubeconfig.yaml"
15+
hspec $ do
16+
describe "FromJSON and ToJSON instances" $ do
17+
it "roundtrips successfully" $ do
18+
decode (encode (toJSON config)) `shouldBe` Just config
19+
describe "getContext" $ do
20+
it "returns the correct context" $ do
21+
getContext config `shouldBe` (Right (Context "cluster-aaa" "user-aaa" Nothing))
22+
23+
describe "getCluster" $ do
24+
it "returns the correct cluster" $ do
25+
server <$> getCluster config `shouldBe` (Right "https://aaa.example.com")
26+
27+
describe "getAuthInfo" $ do
28+
it "returns the correct authInfo" $ do
29+
fst <$> getAuthInfo config `shouldBe` (Right "user-aaa")

‎kubeconfig/test/testdata/kubeconfig.yaml

+35
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
apiVersion: v1
2+
clusters:
3+
- cluster:
4+
certificate-authority-data: fake-ca-data
5+
server: https://aaa.example.com
6+
name: cluster-aaa
7+
- cluster:
8+
certificate-authority-data: fake-ca-data
9+
server: https://bbb.example.com
10+
name: cluster-bbb
11+
contexts:
12+
- context:
13+
cluster: cluster-aaa
14+
user: user-aaa
15+
name: aaa
16+
- context:
17+
cluster: cluster-bbb
18+
user: user-bbb
19+
name: bbb
20+
current-context: aaa
21+
kind: Config
22+
preferences: {}
23+
users:
24+
- name: user-aaa
25+
user:
26+
auth-provider:
27+
config:
28+
access-token: fake-token
29+
expiry: 2017-06-06 22:53:31
30+
expiry-key: '{.credential.token_expiry}'
31+
token-key: '{.credential.access_token}'
32+
name: gcp
33+
- name: user-bbb
34+
user:
35+
token: fake-token

‎stack.yaml

+1
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,4 @@ packages:
44
- kubernetes
55
- kubernetes-client-helper
66
- kubernetes-watch
7+
- kubeconfig

0 commit comments

Comments
 (0)