{-# 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.Client.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 :: Char -> Map String String -> Options
camelToWithOverrides Char
c Map String String
overrides = Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
modifier
    , omitNothingFields :: Bool
omitNothingFields  = Bool
True
    }
    where modifier :: String -> String
modifier String
s = String -> String -> Map String String -> String
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Char -> String -> String
camelTo2 Char
c String
s) String
s Map String String
overrides

-- |Represents a kubeconfig.
data Config = Config
  { Config -> Maybe Text
kind           :: Maybe Text
  , Config -> Maybe Text
apiVersion     :: Maybe Text
  , Config -> Maybe Preferences
preferences    :: Maybe Preferences
  , Config -> [NamedEntity Cluster "cluster"]
clusters       :: [NamedEntity Cluster "cluster"]
  , Config -> [NamedEntity AuthInfo "user"]
authInfos      :: [NamedEntity AuthInfo "user"]
  , Config -> [NamedEntity Context "context"]
contexts       :: [NamedEntity Context "context"]
  , Config -> Text
currentContext :: Text
  } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic, Int -> Config -> String -> String
[Config] -> String -> String
Config -> String
(Int -> Config -> String -> String)
-> (Config -> String)
-> ([Config] -> String -> String)
-> Show Config
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Config] -> String -> String
$cshowList :: [Config] -> String -> String
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> String -> String
$cshowsPrec :: Int -> Config -> String -> String
Show)

configJSONOptions :: Options
configJSONOptions = Char -> Map String String -> Options
camelToWithOverrides
    Char
'-'
    ([(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"apiVersion", String
"apiVersion"), (String
"authInfos", String
"users")])

instance ToJSON Config where
  toJSON :: Config -> Value
toJSON = Options -> Config -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
configJSONOptions

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = Options -> Value -> Parser Config
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
configJSONOptions

newtype Preferences = Preferences
  { Preferences -> Maybe Bool
colors :: Maybe Bool
  } deriving (Preferences -> Preferences -> Bool
(Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Bool) -> Eq Preferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Preferences -> Preferences -> Bool
$c/= :: Preferences -> Preferences -> Bool
== :: Preferences -> Preferences -> Bool
$c== :: Preferences -> Preferences -> Bool
Eq, (forall x. Preferences -> Rep Preferences x)
-> (forall x. Rep Preferences x -> Preferences)
-> Generic Preferences
forall x. Rep Preferences x -> Preferences
forall x. Preferences -> Rep Preferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Preferences x -> Preferences
$cfrom :: forall x. Preferences -> Rep Preferences x
Generic, Int -> Preferences -> String -> String
[Preferences] -> String -> String
Preferences -> String
(Int -> Preferences -> String -> String)
-> (Preferences -> String)
-> ([Preferences] -> String -> String)
-> Show Preferences
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Preferences] -> String -> String
$cshowList :: [Preferences] -> String -> String
show :: Preferences -> String
$cshow :: Preferences -> String
showsPrec :: Int -> Preferences -> String -> String
$cshowsPrec :: Int -> Preferences -> String -> String
Show)

instance ToJSON Preferences where
  toJSON :: Preferences -> Value
toJSON = Options -> Preferences -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Preferences -> Value)
-> Options -> Preferences -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Map String String -> Options
camelToWithOverrides Char
'-' Map String String
forall k a. Map k a
Map.empty

instance FromJSON Preferences where
  parseJSON :: Value -> Parser Preferences
parseJSON = Options -> Value -> Parser Preferences
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Preferences)
-> Options -> Value -> Parser Preferences
forall a b. (a -> b) -> a -> b
$ Char -> Map String String -> Options
camelToWithOverrides Char
'-' Map String String
forall k a. Map k a
Map.empty

data Cluster = Cluster
  { Cluster -> Text
server                   :: Text
  , Cluster -> Maybe Bool
insecureSkipTLSVerify    :: Maybe Bool
  , Cluster -> Maybe Text
certificateAuthority     :: Maybe Text
  , Cluster -> Maybe Text
certificateAuthorityData :: Maybe Text
  } deriving (Cluster -> Cluster -> Bool
(Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Bool) -> Eq Cluster
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cluster -> Cluster -> Bool
$c/= :: Cluster -> Cluster -> Bool
== :: Cluster -> Cluster -> Bool
$c== :: Cluster -> Cluster -> Bool
Eq, (forall x. Cluster -> Rep Cluster x)
-> (forall x. Rep Cluster x -> Cluster) -> Generic Cluster
forall x. Rep Cluster x -> Cluster
forall x. Cluster -> Rep Cluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cluster x -> Cluster
$cfrom :: forall x. Cluster -> Rep Cluster x
Generic, Int -> Cluster -> String -> String
[Cluster] -> String -> String
Cluster -> String
(Int -> Cluster -> String -> String)
-> (Cluster -> String)
-> ([Cluster] -> String -> String)
-> Show Cluster
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cluster] -> String -> String
$cshowList :: [Cluster] -> String -> String
show :: Cluster -> String
$cshow :: Cluster -> String
showsPrec :: Int -> Cluster -> String -> String
$cshowsPrec :: Int -> Cluster -> String -> String
Show, Typeable)

instance ToJSON Cluster where
  toJSON :: Cluster -> Value
toJSON = Options -> Cluster -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> Cluster -> Value) -> Options -> Cluster -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Map String String -> Options
camelToWithOverrides Char
'-' Map String String
forall k a. Map k a
Map.empty

instance FromJSON Cluster where
  parseJSON :: Value -> Parser Cluster
parseJSON = Options -> Value -> Parser Cluster
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Cluster)
-> Options -> Value -> Parser Cluster
forall a b. (a -> b) -> a -> b
$ Char -> Map String String -> Options
camelToWithOverrides Char
'-' Map String String
forall k a. Map k a
Map.empty

data NamedEntity a (typeKey :: Symbol) = NamedEntity
  { NamedEntity a typeKey -> Text
name   :: Text
  , NamedEntity a typeKey -> a
entity :: a } deriving (NamedEntity a typeKey -> NamedEntity a typeKey -> Bool
(NamedEntity a typeKey -> NamedEntity a typeKey -> Bool)
-> (NamedEntity a typeKey -> NamedEntity a typeKey -> Bool)
-> Eq (NamedEntity a typeKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (typeKey :: Symbol).
Eq a =>
NamedEntity a typeKey -> NamedEntity a typeKey -> Bool
/= :: NamedEntity a typeKey -> NamedEntity a typeKey -> Bool
$c/= :: forall a (typeKey :: Symbol).
Eq a =>
NamedEntity a typeKey -> NamedEntity a typeKey -> Bool
== :: NamedEntity a typeKey -> NamedEntity a typeKey -> Bool
$c== :: forall a (typeKey :: Symbol).
Eq a =>
NamedEntity a typeKey -> NamedEntity a typeKey -> Bool
Eq, (forall x. NamedEntity a typeKey -> Rep (NamedEntity a typeKey) x)
-> (forall x.
    Rep (NamedEntity a typeKey) x -> NamedEntity a typeKey)
-> Generic (NamedEntity a typeKey)
forall x. Rep (NamedEntity a typeKey) x -> NamedEntity a typeKey
forall x. NamedEntity a typeKey -> Rep (NamedEntity a typeKey) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a (typeKey :: Symbol) x.
Rep (NamedEntity a typeKey) x -> NamedEntity a typeKey
forall a (typeKey :: Symbol) x.
NamedEntity a typeKey -> Rep (NamedEntity a typeKey) x
$cto :: forall a (typeKey :: Symbol) x.
Rep (NamedEntity a typeKey) x -> NamedEntity a typeKey
$cfrom :: forall a (typeKey :: Symbol) x.
NamedEntity a typeKey -> Rep (NamedEntity a typeKey) x
Generic, Int -> NamedEntity a typeKey -> String -> String
[NamedEntity a typeKey] -> String -> String
NamedEntity a typeKey -> String
(Int -> NamedEntity a typeKey -> String -> String)
-> (NamedEntity a typeKey -> String)
-> ([NamedEntity a typeKey] -> String -> String)
-> Show (NamedEntity a typeKey)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall a (typeKey :: Symbol).
Show a =>
Int -> NamedEntity a typeKey -> String -> String
forall a (typeKey :: Symbol).
Show a =>
[NamedEntity a typeKey] -> String -> String
forall a (typeKey :: Symbol).
Show a =>
NamedEntity a typeKey -> String
showList :: [NamedEntity a typeKey] -> String -> String
$cshowList :: forall a (typeKey :: Symbol).
Show a =>
[NamedEntity a typeKey] -> String -> String
show :: NamedEntity a typeKey -> String
$cshow :: forall a (typeKey :: Symbol).
Show a =>
NamedEntity a typeKey -> String
showsPrec :: Int -> NamedEntity a typeKey -> String -> String
$cshowsPrec :: forall a (typeKey :: Symbol).
Show a =>
Int -> NamedEntity a typeKey -> String -> String
Show)

instance (FromJSON a, Typeable a, KnownSymbol s) =>
         FromJSON (NamedEntity a s) where
  parseJSON :: Value -> Parser (NamedEntity a s)
parseJSON = String
-> (Object -> Parser (NamedEntity a s))
-> Value
-> Parser (NamedEntity a s)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"Named" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a))) ((Object -> Parser (NamedEntity a s))
 -> Value -> Parser (NamedEntity a s))
-> (Object -> Parser (NamedEntity a s))
-> Value
-> Parser (NamedEntity a s)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> a -> NamedEntity a s
forall a (typeKey :: Symbol). Text -> a -> NamedEntity a typeKey
NamedEntity (Text -> a -> NamedEntity a s)
-> Parser Text -> Parser (a -> NamedEntity a s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name" Parser (a -> NamedEntity a s)
-> Parser a -> Parser (NamedEntity a s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: String -> Text
T.pack (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))

instance (ToJSON a, KnownSymbol s) =>
         ToJSON (NamedEntity a s) where
  toJSON :: NamedEntity a s -> Value
toJSON (NamedEntity {a
Text
entity :: a
name :: Text
$sel:entity:NamedEntity :: forall a (typeKey :: Symbol). NamedEntity a typeKey -> a
$sel:name:NamedEntity :: forall a (typeKey :: Symbol). NamedEntity a typeKey -> Text
..}) = [Pair] -> Value
object
      [Text
"name" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
name, String -> Text
T.pack (Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)) Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
entity]

toMap :: [NamedEntity a s] -> Map.Map Text a
toMap :: [NamedEntity a s] -> Map Text a
toMap = [(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, a)] -> Map Text a)
-> ([NamedEntity a s] -> [(Text, a)])
-> [NamedEntity a s]
-> Map Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedEntity a s -> (Text, a)) -> [NamedEntity a s] -> [(Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NamedEntity {a
Text
entity :: a
name :: Text
$sel:entity:NamedEntity :: forall a (typeKey :: Symbol). NamedEntity a typeKey -> a
$sel:name:NamedEntity :: forall a (typeKey :: Symbol). NamedEntity a typeKey -> Text
..} -> (Text
name, a
entity))

data AuthInfo = AuthInfo
  { AuthInfo -> Maybe String
clientCertificate     :: Maybe FilePath
  , AuthInfo -> Maybe Text
clientCertificateData :: Maybe Text
  , AuthInfo -> Maybe String
clientKey             :: Maybe FilePath
  , AuthInfo -> Maybe Text
clientKeyData         :: Maybe Text
  , AuthInfo -> Maybe Text
token                 :: Maybe Text
  , AuthInfo -> Maybe String
tokenFile             :: Maybe FilePath
  , AuthInfo -> Maybe Text
impersonate           :: Maybe Text
  , AuthInfo -> Maybe [Text]
impersonateGroups     :: Maybe [Text]
  , AuthInfo -> Maybe (Map Text [Text])
impersonateUserExtra  :: Maybe (Map.Map Text [Text])
  , AuthInfo -> Maybe Text
username              :: Maybe Text
  , AuthInfo -> Maybe Text
password              :: Maybe Text
  , AuthInfo -> Maybe AuthProviderConfig
authProvider          :: Maybe AuthProviderConfig
  } deriving (AuthInfo -> AuthInfo -> Bool
(AuthInfo -> AuthInfo -> Bool)
-> (AuthInfo -> AuthInfo -> Bool) -> Eq AuthInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthInfo -> AuthInfo -> Bool
$c/= :: AuthInfo -> AuthInfo -> Bool
== :: AuthInfo -> AuthInfo -> Bool
$c== :: AuthInfo -> AuthInfo -> Bool
Eq, (forall x. AuthInfo -> Rep AuthInfo x)
-> (forall x. Rep AuthInfo x -> AuthInfo) -> Generic AuthInfo
forall x. Rep AuthInfo x -> AuthInfo
forall x. AuthInfo -> Rep AuthInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthInfo x -> AuthInfo
$cfrom :: forall x. AuthInfo -> Rep AuthInfo x
Generic, Int -> AuthInfo -> String -> String
[AuthInfo] -> String -> String
AuthInfo -> String
(Int -> AuthInfo -> String -> String)
-> (AuthInfo -> String)
-> ([AuthInfo] -> String -> String)
-> Show AuthInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AuthInfo] -> String -> String
$cshowList :: [AuthInfo] -> String -> String
show :: AuthInfo -> String
$cshow :: AuthInfo -> String
showsPrec :: Int -> AuthInfo -> String -> String
$cshowsPrec :: Int -> AuthInfo -> String -> String
Show, Typeable)

authInfoJSONOptions :: Options
authInfoJSONOptions = Char -> Map String String -> Options
camelToWithOverrides
    Char
'-'
    ( [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (String
"tokenFile"           , String
"tokenFile")
        , (String
"impersonate"         , String
"as")
        , (String
"impersonateGroups"   , String
"as-groups")
        , (String
"impersonateUserExtra", String
"as-user-extra")
        ]
    )

instance ToJSON AuthInfo where
  toJSON :: AuthInfo -> Value
toJSON = Options -> AuthInfo -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
authInfoJSONOptions

instance FromJSON AuthInfo where
  parseJSON :: Value -> Parser AuthInfo
parseJSON = Options -> Value -> Parser AuthInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
authInfoJSONOptions

data Context = Context
  { Context -> Text
cluster   :: Text
  , Context -> Text
authInfo  :: Text
  , Context -> Maybe Text
namespace :: Maybe Text
  } deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, (forall x. Context -> Rep Context x)
-> (forall x. Rep Context x -> Context) -> Generic Context
forall x. Rep Context x -> Context
forall x. Context -> Rep Context x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Context x -> Context
$cfrom :: forall x. Context -> Rep Context x
Generic, Int -> Context -> String -> String
[Context] -> String -> String
Context -> String
(Int -> Context -> String -> String)
-> (Context -> String)
-> ([Context] -> String -> String)
-> Show Context
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Context] -> String -> String
$cshowList :: [Context] -> String -> String
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> String -> String
$cshowsPrec :: Int -> Context -> String -> String
Show, Typeable)

contextJSONOptions :: Options
contextJSONOptions =
    Char -> Map String String -> Options
camelToWithOverrides Char
'-' ([(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"authInfo", String
"user")])

instance ToJSON Context where
  toJSON :: Context -> Value
toJSON = Options -> Context -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
contextJSONOptions

instance FromJSON Context where
  parseJSON :: Value -> Parser Context
parseJSON = Options -> Value -> Parser Context
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
contextJSONOptions

data AuthProviderConfig = AuthProviderConfig
  { AuthProviderConfig -> Text
name   :: Text
  , AuthProviderConfig -> Maybe (Map Text Text)
config :: Maybe (Map.Map Text Text)
  } deriving (AuthProviderConfig -> AuthProviderConfig -> Bool
(AuthProviderConfig -> AuthProviderConfig -> Bool)
-> (AuthProviderConfig -> AuthProviderConfig -> Bool)
-> Eq AuthProviderConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthProviderConfig -> AuthProviderConfig -> Bool
$c/= :: AuthProviderConfig -> AuthProviderConfig -> Bool
== :: AuthProviderConfig -> AuthProviderConfig -> Bool
$c== :: AuthProviderConfig -> AuthProviderConfig -> Bool
Eq, (forall x. AuthProviderConfig -> Rep AuthProviderConfig x)
-> (forall x. Rep AuthProviderConfig x -> AuthProviderConfig)
-> Generic AuthProviderConfig
forall x. Rep AuthProviderConfig x -> AuthProviderConfig
forall x. AuthProviderConfig -> Rep AuthProviderConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthProviderConfig x -> AuthProviderConfig
$cfrom :: forall x. AuthProviderConfig -> Rep AuthProviderConfig x
Generic, Int -> AuthProviderConfig -> String -> String
[AuthProviderConfig] -> String -> String
AuthProviderConfig -> String
(Int -> AuthProviderConfig -> String -> String)
-> (AuthProviderConfig -> String)
-> ([AuthProviderConfig] -> String -> String)
-> Show AuthProviderConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AuthProviderConfig] -> String -> String
$cshowList :: [AuthProviderConfig] -> String -> String
show :: AuthProviderConfig -> String
$cshow :: AuthProviderConfig -> String
showsPrec :: Int -> AuthProviderConfig -> String -> String
$cshowsPrec :: Int -> AuthProviderConfig -> String -> String
Show)

instance ToJSON AuthProviderConfig where
  toJSON :: AuthProviderConfig -> Value
toJSON = Options -> AuthProviderConfig -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> AuthProviderConfig -> Value)
-> Options -> AuthProviderConfig -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Map String String -> Options
camelToWithOverrides Char
'-' Map String String
forall k a. Map k a
Map.empty

instance FromJSON AuthProviderConfig where
  parseJSON :: Value -> Parser AuthProviderConfig
parseJSON = Options -> Value -> Parser AuthProviderConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser AuthProviderConfig)
-> Options -> Value -> Parser AuthProviderConfig
forall a b. (a -> b) -> a -> b
$ Char -> Map String String -> Options
camelToWithOverrides Char
'-' Map String String
forall k a. Map k a
Map.empty

-- |Returns the currently active context.
getContext :: Config -> Either String Context
getContext :: Config -> Either String Context
getContext Config {[NamedEntity Context "context"]
[NamedEntity AuthInfo "user"]
[NamedEntity Cluster "cluster"]
Maybe Text
Maybe Preferences
Text
currentContext :: Text
contexts :: [NamedEntity Context "context"]
authInfos :: [NamedEntity AuthInfo "user"]
clusters :: [NamedEntity Cluster "cluster"]
preferences :: Maybe Preferences
apiVersion :: Maybe Text
kind :: Maybe Text
$sel:currentContext:Config :: Config -> Text
$sel:contexts:Config :: Config -> [NamedEntity Context "context"]
$sel:authInfos:Config :: Config -> [NamedEntity AuthInfo "user"]
$sel:clusters:Config :: Config -> [NamedEntity Cluster "cluster"]
$sel:preferences:Config :: Config -> Maybe Preferences
$sel:apiVersion:Config :: Config -> Maybe Text
$sel:kind:Config :: Config -> Maybe Text
..} =
    let maybeContext :: Maybe Context
maybeContext = Text -> Map Text Context -> Maybe Context
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
currentContext ([NamedEntity Context "context"] -> Map Text Context
forall a (s :: Symbol). [NamedEntity a s] -> Map Text a
toMap [NamedEntity Context "context"]
contexts)
    in  case Maybe Context
maybeContext of
            Just Context
ctx -> Context -> Either String Context
forall a b. b -> Either a b
Right Context
ctx
            Maybe Context
Nothing  -> String -> Either String Context
forall a b. a -> Either a b
Left (String
"No context named " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
currentContext)

-- |Returns the currently active user.
getAuthInfo :: Config -> Either String (Text, AuthInfo)
getAuthInfo :: Config -> Either String (Text, AuthInfo)
getAuthInfo cfg :: Config
cfg@Config {[NamedEntity Context "context"]
[NamedEntity AuthInfo "user"]
[NamedEntity Cluster "cluster"]
Maybe Text
Maybe Preferences
Text
currentContext :: Text
contexts :: [NamedEntity Context "context"]
authInfos :: [NamedEntity AuthInfo "user"]
clusters :: [NamedEntity Cluster "cluster"]
preferences :: Maybe Preferences
apiVersion :: Maybe Text
kind :: Maybe Text
$sel:currentContext:Config :: Config -> Text
$sel:contexts:Config :: Config -> [NamedEntity Context "context"]
$sel:authInfos:Config :: Config -> [NamedEntity AuthInfo "user"]
$sel:clusters:Config :: Config -> [NamedEntity Cluster "cluster"]
$sel:preferences:Config :: Config -> Maybe Preferences
$sel:apiVersion:Config :: Config -> Maybe Text
$sel:kind:Config :: Config -> Maybe Text
..} = do
    Context {Maybe Text
Text
namespace :: Maybe Text
authInfo :: Text
cluster :: Text
$sel:namespace:Context :: Context -> Maybe Text
$sel:authInfo:Context :: Context -> Text
$sel:cluster:Context :: Context -> Text
..} <- Config -> Either String Context
getContext Config
cfg
    let maybeAuth :: Maybe AuthInfo
maybeAuth = Text -> Map Text AuthInfo -> Maybe AuthInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
authInfo ([NamedEntity AuthInfo "user"] -> Map Text AuthInfo
forall a (s :: Symbol). [NamedEntity a s] -> Map Text a
toMap [NamedEntity AuthInfo "user"]
authInfos)
    case Maybe AuthInfo
maybeAuth of
        Just AuthInfo
auth -> (Text, AuthInfo) -> Either String (Text, AuthInfo)
forall a b. b -> Either a b
Right (Text
authInfo, AuthInfo
auth)
        Maybe AuthInfo
Nothing   -> String -> Either String (Text, AuthInfo)
forall a b. a -> Either a b
Left (String
"No user named " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
authInfo)

-- |Returns the currently active cluster.
getCluster :: Config -> Either String Cluster
getCluster :: Config -> Either String Cluster
getCluster cfg :: Config
cfg@Config {$sel:clusters:Config :: Config -> [NamedEntity Cluster "cluster"]
clusters=[NamedEntity Cluster "cluster"]
clusters} = do
    Context {$sel:cluster:Context :: Context -> Text
cluster=Text
clusterName} <- Config -> Either String Context
getContext Config
cfg
    let maybeCluster :: Maybe Cluster
maybeCluster = Text -> Map Text Cluster -> Maybe Cluster
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
clusterName ([NamedEntity Cluster "cluster"] -> Map Text Cluster
forall a (s :: Symbol). [NamedEntity a s] -> Map Text a
toMap [NamedEntity Cluster "cluster"]
clusters)
    case Maybe Cluster
maybeCluster of
        Just Cluster
cluster -> Cluster -> Either String Cluster
forall a b. b -> Either a b
Right Cluster
cluster
        Maybe Cluster
Nothing      -> String -> Either String Cluster
forall a b. a -> Either a b
Left (String
"No cluster named " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
clusterName)