Skip to content

Commit 2e16c8d

Browse files
akshaymankarakshaymankar
committed
Better variables all around!
1 parent 10ea926 commit 2e16c8d

File tree

4 files changed

+84
-81
lines changed

4 files changed

+84
-81
lines changed

‎kubernetes-client/src/Kubernetes/Client/Auth/GCP.hs

Lines changed: 18 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -46,12 +46,12 @@ instance AuthMethod GCPAuth where
4646

4747
-- |Detects if auth-provier name is gcp, if it is configures the 'KubernetesClientConfig' with GCPAuth 'AuthMethod'
4848
gcpAuth :: DetectAuth
49-
gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tls, kubecfg)
49+
gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tlsParams, kubecfg)
5050
= Just $ do
5151
configOrErr <- parseGCPAuthInfo cfg
5252
case configOrErr of
53-
Left e -> throwM e
54-
Right gcp -> pure (tls, addAuthMethod kubecfg gcp)
53+
Left err -> throwM err
54+
Right gcp -> pure (tlsParams, addAuthMethod kubecfg gcp)
5555
gcpAuth _ _ = Nothing
5656

5757
data GCPAuthParsingException = GCPAuthMissingInformation String
@@ -69,8 +69,8 @@ data GCPGetTokenException = GCPCmdProducedInvalidJSON String
6969
instance Exception GCPGetTokenException
7070

7171
getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
72-
getToken g@(GCPAuth{..}) = getCurrentToken g
73-
>>= maybe (fetchToken g) (return . Right)
72+
getToken auth@(GCPAuth{..}) = getCurrentToken auth
73+
>>= maybe (fetchToken auth) (return . Right)
7474

7575
getCurrentToken :: GCPAuth -> IO (Maybe Text)
7676
getCurrentToken (GCPAuth{..}) = do
@@ -87,12 +87,12 @@ fetchToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
8787
fetchToken GCPAuth{..} = do
8888
(stdOut, _) <- readProcess_ gcpCmd
8989
case parseTokenAndExpiry stdOut of
90+
Left err -> return $ Left err
9091
Right (token, expiry) -> do
9192
atomically $ do
9293
writeTVar gcpAccessToken (Just token)
9394
writeTVar gcpTokenExpiry (Just expiry)
9495
return $ Right token
95-
Left x -> return $ Left x
9696
where
9797
parseTokenAndExpiry credsStr = do
9898
credsJSON <- Aeson.eitherDecode credsStr
@@ -106,35 +106,31 @@ fetchToken GCPAuth{..} = do
106106
return (token, expiry)
107107

108108
parseGCPAuthInfo :: Map Text Text -> IO (Either GCPAuthParsingException GCPAuth)
109-
parseGCPAuthInfo m = do
110-
gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" m
109+
parseGCPAuthInfo authInfo = do
110+
gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" authInfo
111111
eitherGCPExpiryToken <- sequence $ fmap (atomically . newTVar) lookupAndParseExpiry
112112
return $ do
113113
gcpTokenExpiry <- mapLeft GCPAuthInvalidExpiry eitherGCPExpiryToken
114114
cmdPath <- Text.unpack <$> lookupEither "cmd-path"
115115
cmdArgs <- Text.splitOn " " <$> lookupEither "cmd-args"
116-
gcpTokenKey <- readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
116+
gcpTokenKey <- readJSONPath "token-key" [JSONPath [KeyChild "token_expiry"]]
117117
& mapLeft GCPAuthInvalidTokenJSONPath
118-
gcpExpiryKey <- readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
118+
gcpExpiryKey <- readJSONPath "expiry-key" [JSONPath [KeyChild "access_token"]]
119119
& mapLeft GCPAuthInvalidExpiryJSONPath
120120
let gcpCmd = proc cmdPath (map Text.unpack cmdArgs)
121121
pure $ GCPAuth{..}
122122
where
123123
lookupAndParseExpiry =
124-
case Map.lookup "expiry" m of
124+
case Map.lookup "expiry" authInfo of
125125
Nothing -> Right Nothing
126126
Just expiryText -> Just <$> parseExpiryTime expiryText
127-
lookupEither key = Map.lookup key m
127+
lookupEither key = Map.lookup key authInfo
128128
& maybeToRight (GCPAuthMissingInformation $ Text.unpack key)
129+
parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput)
130+
readJSONPath key defaultPath =
131+
maybe (Right defaultPath) parseK8sJSONPath $ Map.lookup key authInfo
129132

130133
parseExpiryTime :: Text -> Either String UTCTime
131-
parseExpiryTime s = zonedTimeToUTC <$> parseTimeRFC3339 s
132-
& maybeToRight ("failed to parse token expiry time " <> Text.unpack s)
133-
134-
readJSONPath :: Map Text Text
135-
-> Text
136-
-> [K8sPathElement]
137-
-> Either String [K8sPathElement]
138-
readJSONPath m key def = case Map.lookup key m of
139-
Nothing -> pure def
140-
Just str -> parseOnly (k8sJSONPath <* endOfInput) str
134+
parseExpiryTime expiryText =
135+
zonedTimeToUTC <$> parseTimeRFC3339 expiryText
136+
& maybeToRight ("failed to parse token expiry time " <> Text.unpack expiryText)

‎kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs

Lines changed: 22 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -66,30 +66,30 @@ instance Exception OIDCAuthParsingException
6666

6767
-- TODO: Consider a token expired few seconds before actual expiry to account for time skew
6868
getToken :: OIDCAuth -> IO Text
69-
getToken o@(OIDCAuth{..}) = do
69+
getToken auth@(OIDCAuth{..}) = do
7070
now <- getPOSIXTime
7171
maybeIdToken <- readTVarIO idTokenTVar
7272
case maybeIdToken of
73-
Nothing -> fetchToken o
73+
Nothing -> fetchToken auth
7474
Just idToken -> do
7575
let maybeExp = decodeClaims (Text.encodeUtf8 idToken)
7676
& rightToMaybe
7777
& fmap snd
7878
& (>>= jwtExp)
7979
case maybeExp of
80-
Nothing -> fetchToken o
80+
Nothing -> fetchToken auth
8181
Just (IntDate expiryDate) -> if now < expiryDate
8282
then pure idToken
83-
else fetchToken o
83+
else fetchToken auth
8484

8585
fetchToken :: OIDCAuth -> IO Text
86-
fetchToken o@(OIDCAuth{..}) = do
86+
fetchToken auth@(OIDCAuth{..}) = do
8787
mgr <- newManager tlsManagerSettings
8888
maybeToken <- readTVarIO refreshTokenTVar
8989
case maybeToken of
9090
Nothing -> throwM $ OIDCGetTokenException "cannot refresh id-token without a refresh token"
9191
Just token -> do
92-
tokenEndpoint <- fetchTokenEndpoint mgr o
92+
tokenEndpoint <- fetchTokenEndpoint mgr auth
9393
tokenURI <- parseURI strictURIParserOptions (Text.encodeUtf8 tokenEndpoint)
9494
& either (throwM . OIDCURIException) pure
9595
let oauth = OAuth2{ oauthClientId = clientID
@@ -147,36 +147,38 @@ cachedOIDCAuth cache AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Jus
147147
cachedOIDCAuth _ _ _ = Nothing
148148

149149
parseOIDCAuthInfo :: Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)
150-
parseOIDCAuthInfo m = do
151-
eitherTLSParams <- parseCA m
152-
idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" m
153-
refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" m
150+
parseOIDCAuthInfo authInfo = do
151+
eitherTLSParams <- parseCA authInfo
152+
idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" authInfo
153+
refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" authInfo
154154
return $ do
155155
tlsParams <- mapLeft OIDCAuthCAParsingFailed eitherTLSParams
156156
issuerURL <- lookupEither "idp-issuer-url"
157157
clientID <- lookupEither "client-id"
158158
clientSecret <- lookupEither "client-secret"
159159
return OIDCAuth{..}
160-
where lookupEither k = Map.lookup k m
160+
where lookupEither k = Map.lookup k authInfo
161161
& maybeToRight (OIDCAuthMissingInformation $ Text.unpack k)
162162

163163
parseCA :: Map Text Text -> IO (Either ParseCertException TLS.ClientParams)
164-
parseCA m = do
165-
t <- defaultTLSClientParams
166-
fromMaybe (pure $ pure t) (parseCAFile t m <|> parseCAData t m)
164+
parseCA authInfo = do
165+
tlsParams <- defaultTLSClientParams
166+
let maybeNewParams = (parseCAFile tlsParams authInfo
167+
<|> parseCAData tlsParams authInfo)
168+
fromMaybe (pure $ Right tlsParams) maybeNewParams
167169

168170
parseCAFile :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))
169-
parseCAFile t m = do
170-
caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" m
171+
parseCAFile tlsParams authInfo = do
172+
caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" authInfo
171173
Just $ do
172174
caText <- BS.readFile caFile
173-
return $ updateClientParams t caText
175+
return $ updateClientParams tlsParams caText
174176

175177
parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))
176-
parseCAData t m = do
177-
caBase64 <- Map.lookup "idp-certificate-authority-data" m
178+
parseCAData tlsParams authInfo = do
179+
caBase64 <- Map.lookup "idp-certificate-authority-data" authInfo
178180
Just $ pure $ do
179181
caText <- Text.encodeUtf8 caBase64
180182
& B64.decode
181183
& mapLeft Base64ParsingFailed
182-
updateClientParams t caText
184+
updateClientParams tlsParams caText

‎kubernetes-client/src/Kubernetes/Client/Config.hs

Lines changed: 32 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -69,20 +69,20 @@ kubeClient
6969
-> IO (NH.Manager, K.KubernetesClientConfig)
7070
kubeClient oidcCache (KubeConfigFile f) = do
7171
kubeConfigFile <- decodeFileThrow f
72-
uri <- getCluster kubeConfigFile
72+
masterURI <- getCluster kubeConfigFile
7373
& fmap server
7474
& either (const $ pure "localhost:8080") return
75-
t <- defaultTLSClientParams
76-
& fmap (tlsValidation kubeConfigFile)
77-
& (>>= (addCACertData kubeConfigFile))
78-
& (>>= addCACertFile kubeConfigFile (takeDirectory f))
79-
c <- K.newConfig & fmap (setMasterURI uri)
80-
(tlsParams, cfg) <-
75+
tlsParams <- defaultTLSClientParams
76+
& fmap (tlsValidation kubeConfigFile)
77+
& (>>= (addCACertData kubeConfigFile))
78+
& (>>= addCACertFile kubeConfigFile (takeDirectory f))
79+
clientConfig <- K.newConfig & fmap (setMasterURI masterURI)
80+
(tlsParamsWithAuth, clientConfigWithAuth) <-
8181
case getAuthInfo kubeConfigFile of
82-
Left _ -> return (t,c)
83-
Right (_, auth) -> applyAuthSettings oidcCache auth (t, c)
84-
mgr <- newManager tlsParams
85-
return (mgr, cfg)
82+
Left _ -> return (tlsParams,clientConfig)
83+
Right (_, auth) -> applyAuthSettings oidcCache auth (tlsParams, clientConfig)
84+
mgr <- newManager tlsParamsWithAuth
85+
return (mgr, clientConfigWithAuth)
8686
kubeClient _ (KubeConfigCluster) = Kubernetes.Client.Config.cluster
8787

8888
-- |Creates 'NH.Manager' and 'K.KubernetesClientConfig' assuming it is being executed in a pod
@@ -113,37 +113,39 @@ serviceAccountDir :: FilePath
113113
serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount"
114114

115115
tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams
116-
tlsValidation cfg t = case getCluster cfg of
117-
Left _ -> t
118-
Right c -> case insecureSkipTLSVerify c of
119-
Just True -> disableServerCertValidation t
120-
_ -> t
116+
tlsValidation cfg tlsParams =
117+
case getCluster cfg of
118+
Left _ -> tlsParams
119+
Right c ->
120+
case insecureSkipTLSVerify c of
121+
Just True -> disableServerCertValidation tlsParams
122+
_ -> tlsParams
121123

122124
addCACertData :: (MonadThrow m) => Config -> TLS.ClientParams -> m TLS.ClientParams
123-
addCACertData cfg t =
125+
addCACertData cfg tlsParams =
124126
let eitherCertText = getCluster cfg
125127
& (>>= (maybeToRight "cert data not provided" . certificateAuthorityData))
126128
in case eitherCertText of
127-
Left _ -> pure t
129+
Left _ -> pure tlsParams
128130
Right certBase64 -> do
129131
certText <- B64.decode (T.encodeUtf8 certBase64)
130132
& either (throwM . Base64ParsingFailed) pure
131-
updateClientParams t certText
133+
updateClientParams tlsParams certText
132134
& either throwM return
133135

134136
addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams
135-
addCACertFile cfg dir t = do
136-
let certFile = getCluster cfg
137-
>>= maybeToRight "cert file not provided" . certificateAuthority
138-
& fmap T.unpack
139-
& fmap (dir </>)
140-
case certFile of
141-
Left _ -> return t
142-
Right f -> do
143-
certText <- B.readFile f
137+
addCACertFile cfg dir tlsParams = do
138+
let eitherCertFile = getCluster cfg
139+
>>= maybeToRight "cert file not provided" . certificateAuthority
140+
& fmap T.unpack
141+
& fmap (dir </>)
142+
case eitherCertFile of
143+
Left _ -> return tlsParams
144+
Right certFile -> do
145+
certText <- B.readFile certFile
144146
return
145-
$ updateClientParams t certText
146-
& (fromRight t)
147+
$ updateClientParams tlsParams certText
148+
& (fromRight tlsParams)
147149

148150
applyAuthSettings
149151
:: OIDCCache

‎kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,8 @@ defaultTLSClientParams = do
3939

4040
-- |Parses a PEM-encoded @ByteString@ into a list of certificates.
4141
parsePEMCerts :: B.ByteString -> Either ParseCertException [SignedCertificate]
42-
parsePEMCerts b = do
43-
pems <- pemParseBS b
42+
parsePEMCerts pemBS = do
43+
pems <- pemParseBS pemBS
4444
& mapLeft PEMParsingFailed
4545
return $ rights $ map (decodeSignedCertificate . pemContent) pems
4646

@@ -51,11 +51,8 @@ updateClientParams cp certText = parsePEMCerts certText
5151

5252
-- |Use a custom CA store.
5353
setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams
54-
setCAStore certs cp = cp
55-
{ TLS.clientShared = (TLS.clientShared cp)
56-
{ TLS.sharedCAStore = (makeCertificateStore certs)
57-
}
58-
}
54+
setCAStore certs tlsParams =
55+
tlsParams & clientSharedL . sharedCAStoreL .~ makeCertificateStore certs
5956

6057
-- |Use a client cert for authentication.
6158
setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams
@@ -68,6 +65,12 @@ onServerCertificateL :: Lens' TLS.ClientParams (CertificateStore -> TLS.Validati
6865
onServerCertificateL =
6966
clientHooksL . lens TLS.onServerCertificate (\ch osc -> ch { TLS.onServerCertificate = osc })
7067

68+
clientSharedL :: Lens' TLS.ClientParams TLS.Shared
69+
clientSharedL = lens TLS.clientShared (\tlsParams cs -> tlsParams {TLS.clientShared = cs} )
70+
71+
sharedCAStoreL :: Lens' TLS.Shared CertificateStore
72+
sharedCAStoreL = lens TLS.sharedCAStore (\shared store -> shared{TLS.sharedCAStore = store})
73+
7174
-- |Don't check whether the cert presented by the server matches the name of the server you are connecting to.
7275
-- This is necessary if you specify the server host by its IP address.
7376
disableServerNameValidation :: TLS.ClientParams -> TLS.ClientParams
@@ -84,8 +87,8 @@ onCertificateRequestL =
8487

8588
-- |Loads certificates from a PEM-encoded file.
8689
loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]
87-
loadPEMCerts p = do
88-
liftIO (B.readFile p)
90+
loadPEMCerts pemFile = do
91+
liftIO (B.readFile pemFile)
8992
>>= (either throwM return)
9093
. parsePEMCerts
9194

0 commit comments

Comments
 (0)