Better variables all around!

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

@@ -46,12 +46,12 @@ instance AuthMethod GCPAuth where
 
 -- |Detects if auth-provier name is gcp, if it is configures the 'KubernetesClientConfig' with GCPAuth 'AuthMethod'
 gcpAuth :: DetectAuth
-gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tls, kubecfg)
+gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tlsParams, kubecfg)
   = Just $ do
       configOrErr <- parseGCPAuthInfo cfg
       case configOrErr of
-        Left e    -> throwM e
+        Left err  -> throwM err
-        Right gcp -> pure (tls, addAuthMethod kubecfg gcp)
+        Right gcp -> pure (tlsParams, addAuthMethod kubecfg gcp)
 gcpAuth _ _ = Nothing
 
 data GCPAuthParsingException = GCPAuthMissingInformation String
@@ -69,8 +69,8 @@ data GCPGetTokenException = GCPCmdProducedInvalidJSON String
 instance Exception GCPGetTokenException
 
 getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
-getToken g@(GCPAuth{..}) = getCurrentToken g
+getToken auth@(GCPAuth{..}) = getCurrentToken auth
-                           >>= maybe (fetchToken g) (return . Right)
+                              >>= maybe (fetchToken auth) (return . Right)
 
 getCurrentToken :: GCPAuth -> IO (Maybe Text)
 getCurrentToken (GCPAuth{..}) = do
@@ -87,12 +87,12 @@ fetchToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
 fetchToken GCPAuth{..} = do
   (stdOut, _) <- readProcess_ gcpCmd
   case parseTokenAndExpiry stdOut of
+    Left err -> return $ Left err
     Right (token, expiry) -> do
       atomically $ do
         writeTVar gcpAccessToken (Just token)
         writeTVar gcpTokenExpiry (Just expiry)
       return $ Right token
-    Left x -> return $ Left x
   where
     parseTokenAndExpiry credsStr = do
       credsJSON <- Aeson.eitherDecode credsStr
@@ -106,35 +106,31 @@ fetchToken GCPAuth{..} = do
       return (token, expiry)
 
 parseGCPAuthInfo :: Map Text Text -> IO (Either GCPAuthParsingException GCPAuth)
-parseGCPAuthInfo m = do
+parseGCPAuthInfo authInfo = do
-  gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" m
+  gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" authInfo
   eitherGCPExpiryToken <- sequence $ fmap (atomically . newTVar) lookupAndParseExpiry
   return $ do
     gcpTokenExpiry <- mapLeft GCPAuthInvalidExpiry eitherGCPExpiryToken
     cmdPath <- Text.unpack <$> lookupEither "cmd-path"
     cmdArgs <- Text.splitOn " " <$> lookupEither "cmd-args"
-    gcpTokenKey <- readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
+    gcpTokenKey <- readJSONPath "token-key" [JSONPath [KeyChild "token_expiry"]]
                    & mapLeft GCPAuthInvalidTokenJSONPath
-    gcpExpiryKey <- readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
+    gcpExpiryKey <- readJSONPath "expiry-key" [JSONPath [KeyChild "access_token"]]
                     & mapLeft GCPAuthInvalidExpiryJSONPath
     let gcpCmd = proc cmdPath (map Text.unpack cmdArgs)
     pure $ GCPAuth{..}
   where
     lookupAndParseExpiry =
-      case Map.lookup "expiry" m of
+      case Map.lookup "expiry" authInfo of
         Nothing         -> Right Nothing
         Just expiryText -> Just <$> parseExpiryTime expiryText
-    lookupEither key = Map.lookup key m
+    lookupEither key = Map.lookup key authInfo
                        & maybeToRight (GCPAuthMissingInformation $ Text.unpack key)
+    parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput)
+    readJSONPath key defaultPath =
+      maybe (Right defaultPath) parseK8sJSONPath $ Map.lookup key authInfo
 
 parseExpiryTime :: Text -> Either String UTCTime
-parseExpiryTime s = zonedTimeToUTC <$> parseTimeRFC3339 s
+parseExpiryTime expiryText =
-                    & maybeToRight ("failed to parse token expiry time " <> Text.unpack s)
+  zonedTimeToUTC <$> parseTimeRFC3339 expiryText
-
+  & maybeToRight ("failed to parse token expiry time " <> Text.unpack expiryText)
-readJSONPath :: Map Text Text
-             -> Text
-             -> [K8sPathElement]
-             -> Either String [K8sPathElement]
-readJSONPath m key def = case Map.lookup key m of
-                           Nothing -> pure def
-                           Just str -> parseOnly (k8sJSONPath <* endOfInput) str

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

@@ -66,30 +66,30 @@ instance Exception OIDCAuthParsingException
 
 -- TODO: Consider a token expired few seconds before actual expiry to account for time skew
 getToken :: OIDCAuth -> IO Text
-getToken o@(OIDCAuth{..}) = do
+getToken auth@(OIDCAuth{..}) = do
   now <- getPOSIXTime
   maybeIdToken <- readTVarIO idTokenTVar
   case maybeIdToken of
-    Nothing -> fetchToken o
+    Nothing -> fetchToken auth
     Just idToken -> do
       let maybeExp = decodeClaims (Text.encodeUtf8 idToken)
                    & rightToMaybe
                    & fmap snd
                    & (>>= jwtExp)
       case maybeExp of
-        Nothing -> fetchToken o
+        Nothing -> fetchToken auth
         Just (IntDate expiryDate) -> if now < expiryDate
                                      then pure idToken
-                                     else fetchToken o
+                                     else fetchToken auth
 
 fetchToken :: OIDCAuth -> IO Text
-fetchToken o@(OIDCAuth{..}) = do
+fetchToken auth@(OIDCAuth{..}) = do
   mgr <- newManager tlsManagerSettings
   maybeToken <- readTVarIO refreshTokenTVar
   case maybeToken of
     Nothing -> throwM $ OIDCGetTokenException "cannot refresh id-token without a refresh token"
     Just token -> do
-      tokenEndpoint <- fetchTokenEndpoint mgr o
+      tokenEndpoint <- fetchTokenEndpoint mgr auth
       tokenURI <- parseURI strictURIParserOptions (Text.encodeUtf8 tokenEndpoint)
                   & either (throwM . OIDCURIException) pure
       let oauth = OAuth2{ oauthClientId = clientID
@@ -147,36 +147,38 @@ cachedOIDCAuth cache AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Jus
 cachedOIDCAuth _ _ _ = Nothing
 
 parseOIDCAuthInfo :: Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)
-parseOIDCAuthInfo m = do
+parseOIDCAuthInfo authInfo = do
-  eitherTLSParams <- parseCA m
+  eitherTLSParams <- parseCA authInfo
-  idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" m
+  idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" authInfo
-  refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" m
+  refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" authInfo
   return $ do
     tlsParams <- mapLeft OIDCAuthCAParsingFailed eitherTLSParams
     issuerURL <- lookupEither "idp-issuer-url"
     clientID <- lookupEither "client-id"
     clientSecret <- lookupEither "client-secret"
     return OIDCAuth{..}
-    where lookupEither k = Map.lookup k m
+    where lookupEither k = Map.lookup k authInfo
                            & maybeToRight (OIDCAuthMissingInformation $ Text.unpack k)
 
 parseCA :: Map Text Text -> IO (Either ParseCertException TLS.ClientParams)
-parseCA m = do
+parseCA authInfo = do
-  t <- defaultTLSClientParams
+  tlsParams <- defaultTLSClientParams
-  fromMaybe (pure $ pure t) (parseCAFile t m <|> parseCAData t m)
+  let maybeNewParams = (parseCAFile tlsParams authInfo
+                        <|> parseCAData tlsParams authInfo)
+  fromMaybe (pure $ Right tlsParams) maybeNewParams
 
 parseCAFile :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))
-parseCAFile t m = do
+parseCAFile tlsParams authInfo = do
-  caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" m
+  caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" authInfo
   Just $ do
     caText <- BS.readFile caFile
-    return $ updateClientParams t caText
+    return $ updateClientParams tlsParams caText
 
 parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))
-parseCAData t m = do
+parseCAData tlsParams authInfo = do
-  caBase64 <- Map.lookup "idp-certificate-authority-data" m
+  caBase64 <- Map.lookup "idp-certificate-authority-data" authInfo
   Just $ pure $ do
     caText <- Text.encodeUtf8 caBase64
               & B64.decode
               & mapLeft Base64ParsingFailed
-    updateClientParams t caText
+    updateClientParams tlsParams caText

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

@@ -69,20 +69,20 @@ kubeClient
   -> IO (NH.Manager, K.KubernetesClientConfig)
 kubeClient oidcCache (KubeConfigFile f) = do
   kubeConfigFile <- decodeFileThrow f
-  uri <- getCluster kubeConfigFile
+  masterURI <- getCluster kubeConfigFile
          & fmap server
          & either (const $ pure "localhost:8080") return
-  t <- defaultTLSClientParams
+  tlsParams <- defaultTLSClientParams
-       & fmap (tlsValidation kubeConfigFile)
+               & fmap (tlsValidation kubeConfigFile)
-       & (>>= (addCACertData kubeConfigFile))
+               & (>>= (addCACertData kubeConfigFile))
-       & (>>= addCACertFile kubeConfigFile (takeDirectory f))
+               & (>>= addCACertFile kubeConfigFile (takeDirectory f))
-  c <- K.newConfig & fmap (setMasterURI uri)
+  clientConfig <- K.newConfig & fmap (setMasterURI masterURI)
-  (tlsParams, cfg) <-
+  (tlsParamsWithAuth, clientConfigWithAuth) <-
     case getAuthInfo kubeConfigFile of
-      Left _          -> return (t,c)
+      Left _          -> return (tlsParams,clientConfig)
-      Right (_, auth) -> applyAuthSettings oidcCache auth (t, c)
+      Right (_, auth) -> applyAuthSettings oidcCache auth (tlsParams, clientConfig)
-  mgr <- newManager tlsParams
+  mgr <- newManager tlsParamsWithAuth
-  return (mgr, cfg)
+  return (mgr, clientConfigWithAuth)
 kubeClient _ (KubeConfigCluster) = Kubernetes.Client.Config.cluster
 
 -- |Creates 'NH.Manager' and 'K.KubernetesClientConfig' assuming it is being executed in a pod
@@ -113,37 +113,39 @@ serviceAccountDir :: FilePath
 serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount"
 
 tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams
-tlsValidation cfg t = case getCluster cfg of
+tlsValidation cfg tlsParams =
-                        Left _ -> t
+  case getCluster cfg of
-                        Right c -> case insecureSkipTLSVerify c of
+    Left _ -> tlsParams
-                                     Just True -> disableServerCertValidation t
+    Right c ->
-                                     _ -> t
+      case insecureSkipTLSVerify c of
+        Just True -> disableServerCertValidation tlsParams
+        _ -> tlsParams
 
 addCACertData :: (MonadThrow m) => Config -> TLS.ClientParams -> m TLS.ClientParams
-addCACertData cfg t =
+addCACertData cfg tlsParams =
   let eitherCertText = getCluster cfg
                        & (>>= (maybeToRight "cert data not provided" . certificateAuthorityData))
   in case eitherCertText of
-       Left _ -> pure t
+       Left _ -> pure tlsParams
        Right certBase64 -> do
          certText <- B64.decode (T.encodeUtf8 certBase64)
                      & either (throwM . Base64ParsingFailed) pure
-         updateClientParams t certText
+         updateClientParams tlsParams certText
            & either throwM return
 
 addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams
-addCACertFile cfg dir t = do
+addCACertFile cfg dir tlsParams = do
-  let certFile = getCluster cfg
+  let eitherCertFile = getCluster cfg
-                 >>= maybeToRight "cert file not provided" . certificateAuthority
+                       >>= maybeToRight "cert file not provided" . certificateAuthority
-                 & fmap T.unpack
+                       & fmap T.unpack
-                 & fmap (dir </>)
+                       & fmap (dir </>)
-  case certFile of
+  case eitherCertFile of
-    Left _ -> return t
+    Left _ -> return tlsParams
-    Right f -> do
+    Right certFile -> do
-      certText <- B.readFile f
+      certText <- B.readFile certFile
       return
-        $ updateClientParams t certText
+        $ updateClientParams tlsParams certText
-        & (fromRight t)
+        & (fromRight tlsParams)
 
 applyAuthSettings
   :: OIDCCache

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

@@ -39,8 +39,8 @@ defaultTLSClientParams = do
 
 -- |Parses a PEM-encoded @ByteString@ into a list of certificates.
 parsePEMCerts :: B.ByteString -> Either ParseCertException [SignedCertificate]
-parsePEMCerts b = do
+parsePEMCerts pemBS = do
-    pems <- pemParseBS b
+    pems <- pemParseBS pemBS
             & mapLeft PEMParsingFailed
     return $ rights $ map (decodeSignedCertificate . pemContent) pems
 
@@ -51,11 +51,8 @@ updateClientParams cp certText = parsePEMCerts certText
 
 -- |Use a custom CA store.
 setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams
-setCAStore certs cp = cp
+setCAStore certs tlsParams =
-    { TLS.clientShared = (TLS.clientShared cp)
+  tlsParams & clientSharedL . sharedCAStoreL .~ makeCertificateStore certs
-        { TLS.sharedCAStore = (makeCertificateStore certs)
-        }
-    }
 
 -- |Use a client cert for authentication.
 setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams
@@ -68,6 +65,12 @@ onServerCertificateL :: Lens' TLS.ClientParams (CertificateStore -> TLS.Validati
 onServerCertificateL =
   clientHooksL . lens TLS.onServerCertificate (\ch osc -> ch { TLS.onServerCertificate = osc })
 
+clientSharedL :: Lens' TLS.ClientParams TLS.Shared
+clientSharedL = lens TLS.clientShared (\tlsParams cs -> tlsParams {TLS.clientShared = cs} )
+
+sharedCAStoreL :: Lens' TLS.Shared CertificateStore
+sharedCAStoreL = lens TLS.sharedCAStore (\shared store -> shared{TLS.sharedCAStore = store})
+
 -- |Don't check whether the cert presented by the server matches the name of the server you are connecting to.
 -- This is necessary if you specify the server host by its IP address.
 disableServerNameValidation :: TLS.ClientParams -> TLS.ClientParams
@@ -84,8 +87,8 @@ onCertificateRequestL =
 
 -- |Loads certificates from a PEM-encoded file.
 loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]
-loadPEMCerts p = do
+loadPEMCerts pemFile = do
-    liftIO (B.readFile p)
+    liftIO (B.readFile pemFile)
         >>= (either throwM return)
         .   parsePEMCerts