diff --git a/kubernetes-client/src/Kubernetes/Client/Auth/GCP.hs b/kubernetes-client/src/Kubernetes/Client/Auth/GCP.hs index de31355..6766fb9 100644 --- a/kubernetes-client/src/Kubernetes/Client/Auth/GCP.hs +++ b/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 - Right gcp -> pure (tls, addAuthMethod kubecfg gcp) + Left err -> throwM err + 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 - >>= maybe (fetchToken g) (return . Right) +getToken auth@(GCPAuth{..}) = getCurrentToken auth + >>= 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 - gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" m +parseGCPAuthInfo authInfo = do + 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 - & maybeToRight ("failed to parse token expiry time " <> Text.unpack s) - -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 +parseExpiryTime expiryText = + zonedTimeToUTC <$> parseTimeRFC3339 expiryText + & maybeToRight ("failed to parse token expiry time " <> Text.unpack expiryText) diff --git a/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs b/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs index 045fc32..5236641 100644 --- a/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs +++ b/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 - eitherTLSParams <- parseCA m - idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" m - refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" m +parseOIDCAuthInfo authInfo = do + eitherTLSParams <- parseCA authInfo + idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" authInfo + 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 - t <- defaultTLSClientParams - fromMaybe (pure $ pure t) (parseCAFile t m <|> parseCAData t m) +parseCA authInfo = do + tlsParams <- defaultTLSClientParams + 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 - caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" m +parseCAFile tlsParams authInfo = do + 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 - caBase64 <- Map.lookup "idp-certificate-authority-data" m +parseCAData tlsParams authInfo = do + 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 diff --git a/kubernetes-client/src/Kubernetes/Client/Config.hs b/kubernetes-client/src/Kubernetes/Client/Config.hs index 885281f..d3e6187 100644 --- a/kubernetes-client/src/Kubernetes/Client/Config.hs +++ b/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 - & fmap (tlsValidation kubeConfigFile) - & (>>= (addCACertData kubeConfigFile)) - & (>>= addCACertFile kubeConfigFile (takeDirectory f)) - c <- K.newConfig & fmap (setMasterURI uri) - (tlsParams, cfg) <- + tlsParams <- defaultTLSClientParams + & fmap (tlsValidation kubeConfigFile) + & (>>= (addCACertData kubeConfigFile)) + & (>>= addCACertFile kubeConfigFile (takeDirectory f)) + clientConfig <- K.newConfig & fmap (setMasterURI masterURI) + (tlsParamsWithAuth, clientConfigWithAuth) <- case getAuthInfo kubeConfigFile of - Left _ -> return (t,c) - Right (_, auth) -> applyAuthSettings oidcCache auth (t, c) - mgr <- newManager tlsParams - return (mgr, cfg) + Left _ -> return (tlsParams,clientConfig) + Right (_, auth) -> applyAuthSettings oidcCache auth (tlsParams, clientConfig) + mgr <- newManager tlsParamsWithAuth + 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 - Left _ -> t - Right c -> case insecureSkipTLSVerify c of - Just True -> disableServerCertValidation t - _ -> t +tlsValidation cfg tlsParams = + case getCluster cfg of + Left _ -> tlsParams + Right c -> + 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 - let certFile = getCluster cfg - >>= maybeToRight "cert file not provided" . certificateAuthority - & fmap T.unpack - & fmap (dir ) - case certFile of - Left _ -> return t - Right f -> do - certText <- B.readFile f +addCACertFile cfg dir tlsParams = do + let eitherCertFile = getCluster cfg + >>= maybeToRight "cert file not provided" . certificateAuthority + & fmap T.unpack + & fmap (dir ) + case eitherCertFile of + Left _ -> return tlsParams + Right certFile -> do + certText <- B.readFile certFile return - $ updateClientParams t certText - & (fromRight t) + $ updateClientParams tlsParams certText + & (fromRight tlsParams) applyAuthSettings :: OIDCCache diff --git a/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs b/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs index d4e8bfe..64a2378 100644 --- a/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs +++ b/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 - pems <- pemParseBS b +parsePEMCerts pemBS = do + 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 - { TLS.clientShared = (TLS.clientShared cp) - { TLS.sharedCAStore = (makeCertificateStore certs) - } - } +setCAStore certs tlsParams = + tlsParams & clientSharedL . sharedCAStoreL .~ 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 - liftIO (B.readFile p) +loadPEMCerts pemFile = do + liftIO (B.readFile pemFile) >>= (either throwM return) . parsePEMCerts