From 3f1ee81c27de827340ce96c97ed24a98e94a1b07 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 27 Aug 2019 18:24:03 +0100 Subject: [PATCH] Use ADTs instead of `Either String` in OIDC Auth code --- .../src/Kubernetes/Client/Auth/OIDC.hs | 70 +++++++++---------- .../src/Kubernetes/Client/Config.hs | 9 +-- .../Kubernetes/Client/Internal/TLSUtils.hs | 27 ++++--- 3 files changed, 56 insertions(+), 50 deletions(-) diff --git a/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs b/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs index 816a448..045fc32 100644 --- a/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs +++ b/kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs @@ -59,7 +59,8 @@ data OIDCGetTokenException = OIDCOAuthException (OAuth2Error OAuth2TokenRequest. deriving Show instance Exception OIDCGetTokenException -data OIDCAuthParsingException = OIDCAuthParsingException String +data OIDCAuthParsingException = OIDCAuthCAParsingFailed ParseCertException + | OIDCAuthMissingInformation String deriving Show instance Exception OIDCAuthParsingException @@ -119,7 +120,7 @@ oidcAuth :: DetectAuth oidcAuth AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Just cfg))} (tls, kubecfg) = Just $ parseOIDCAuthInfo cfg - >>= either (throwM . OIDCAuthParsingException) (\oidc -> pure (tls, addAuthMethod kubecfg oidc)) + >>= either throwM (\oidc -> pure (tls, addAuthMethod kubecfg oidc)) oidcAuth _ _ = Nothing -- TODO: Consider doing this whole function atomically, as two threads may miss the cache simultaneously @@ -129,54 +130,53 @@ oidcAuth _ _ = Nothing -} cachedOIDCAuth :: OIDCCache -> DetectAuth cachedOIDCAuth cache AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Just cfg))} (tls, kubecfg) = Just $ do - m <- readTVarIO cache - o <- case findInCache m cfg of - Left e -> throwM $ OIDCAuthParsingException e - Right (Just o) -> return o - Right Nothing -> do - o@(OIDCAuth{..}) <- parseOIDCAuthInfo cfg - >>= either (throwM . OIDCAuthParsingException) pure - let newCache = Map.insert (issuerURL, clientID) o m + latestCache <- readTVarIO cache + issuerURL <- lookupOrThrow "idp-issuer-url" + clientID <- lookupOrThrow "client-id" + case Map.lookup (issuerURL, clientID) latestCache of + Just cacheHit -> return $ newTLSAndAuth cacheHit + Nothing -> do + parsedAuth <- parseOIDCAuthInfo cfg + >>= either throwM pure + let newCache = Map.insert (issuerURL, clientID) parsedAuth latestCache _ <- atomically $ swapTVar cache newCache - return o - pure (tls, addAuthMethod kubecfg o) + return $ newTLSAndAuth parsedAuth + where lookupOrThrow k = Map.lookup k cfg + & maybe (throwM $ OIDCAuthMissingInformation $ Text.unpack k) pure + newTLSAndAuth auth = (tls, addAuthMethod kubecfg auth) cachedOIDCAuth _ _ _ = Nothing -findInCache :: Map (Text, Text) a -> Map Text Text -> Either String (Maybe a) -findInCache cache cfg = do - issuerURL <- lookupEither cfg "idp-issuer-url" - clientID <- lookupEither cfg "client-id" - return $ Map.lookup (issuerURL, clientID) cache - -parseOIDCAuthInfo :: Map Text Text -> IO (Either String OIDCAuth) +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 return $ do - tlsParams <- eitherTLSParams - issuerURL <- lookupEither m "idp-issuer-url" - clientID <- lookupEither m "client-id" - clientSecret <- lookupEither m "client-secret" + 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 + & maybeToRight (OIDCAuthMissingInformation $ Text.unpack k) -parseCA :: Map Text Text -> IO (Either String TLS.ClientParams) +parseCA :: Map Text Text -> IO (Either ParseCertException TLS.ClientParams) parseCA m = do t <- defaultTLSClientParams fromMaybe (pure $ pure t) (parseCAFile t m <|> parseCAData t m) -parseCAFile :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either String TLS.ClientParams)) +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 - return $ updateClientParams t <$> BS.readFile caFile + Just $ do + caText <- BS.readFile caFile + return $ updateClientParams t caText -parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either String TLS.ClientParams)) +parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams)) parseCAData t m = do - caText <- Map.lookup "idp-certificate-authority-data" m - pure . pure - $ (B64.decode $ Text.encodeUtf8 caText) - >>= updateClientParams t - -lookupEither :: (Show key, Ord key) => Map key val -> key -> Either String val -lookupEither m k = maybeToRight e $ Map.lookup k m - where e = "Couldn't find key: " <> show k <> " in OIDC auth info" + caBase64 <- Map.lookup "idp-certificate-authority-data" m + Just $ pure $ do + caText <- Text.encodeUtf8 caBase64 + & B64.decode + & mapLeft Base64ParsingFailed + updateClientParams t caText diff --git a/kubernetes-client/src/Kubernetes/Client/Config.hs b/kubernetes-client/src/Kubernetes/Client/Config.hs index 070ace1..885281f 100644 --- a/kubernetes-client/src/Kubernetes/Client/Config.hs +++ b/kubernetes-client/src/Kubernetes/Client/Config.hs @@ -125,10 +125,11 @@ addCACertData cfg t = & (>>= (maybeToRight "cert data not provided" . certificateAuthorityData)) in case eitherCertText of Left _ -> pure t - Right certText -> - (B64.decode $ T.encodeUtf8 certText) - >>= updateClientParams t - & either (throwM . ParsePEMCertsException) return + Right certBase64 -> do + certText <- B64.decode (T.encodeUtf8 certBase64) + & either (throwM . Base64ParsingFailed) pure + updateClientParams t certText + & either throwM return addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams addCACertFile cfg dir t = do diff --git a/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs b/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs index e22b04b..d4e8bfe 100644 --- a/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs +++ b/kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs @@ -6,9 +6,9 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) import Data.Default.Class (def) import Data.Either (rights) +import Data.Either.Combinators (mapLeft) import Data.Function ((&)) import Data.PEM (pemContent, pemParseBS) -import Data.Typeable (Typeable) import Data.X509 (SignedCertificate, decodeSignedCertificate) import Data.X509.CertificateStore (CertificateStore, makeCertificateStore) import Lens.Micro @@ -38,12 +38,14 @@ defaultTLSClientParams = do } -- |Parses a PEM-encoded @ByteString@ into a list of certificates. -parsePEMCerts :: B.ByteString -> Either String [SignedCertificate] +parsePEMCerts :: B.ByteString -> Either ParseCertException [SignedCertificate] parsePEMCerts b = do pems <- pemParseBS b + & mapLeft PEMParsingFailed return $ rights $ map (decodeSignedCertificate . pemContent) pems -updateClientParams :: TLS.ClientParams -> ByteString -> Either String TLS.ClientParams +-- | Updates client params, sets CA store to passed bytestring of CA certificates +updateClientParams :: TLS.ClientParams -> ByteString -> Either ParseCertException TLS.ClientParams updateClientParams cp certText = parsePEMCerts certText & (fmap (flip setCAStore cp)) @@ -80,23 +82,26 @@ onCertificateRequestL :: Lens' TLS.ClientParams (([TLS.CertificateType], Maybe [ onCertificateRequestL = clientHooksL . lens TLS.onCertificateRequest (\ch ocr -> ch { TLS.onCertificateRequest = ocr }) -data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show) - -instance Exception ParsePEMCertsException - -- |Loads certificates from a PEM-encoded file. loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate] loadPEMCerts p = do liftIO (B.readFile p) - >>= throwLeft + >>= (either throwM return) . parsePEMCerts -- |Loads Base64 encoded certificate and private key loadB64EncodedCert :: (MonadThrow m) => B.ByteString -> B.ByteString -> m Credential -loadB64EncodedCert certB64 keyB64 = throwLeft $ do +loadB64EncodedCert certB64 keyB64 = either throwM pure $ do certText <- B64.decode certB64 + & mapLeft Base64ParsingFailed keyText <- B64.decode keyB64 + & mapLeft Base64ParsingFailed credentialLoadX509FromMemory certText keyText + & mapLeft FailedToLoadCredential -throwLeft :: (MonadThrow m) => Either String a -> m a -throwLeft = either (throwM . ParsePEMCertsException) return +data ParseCertException = PEMParsingFailed String + | Base64ParsingFailed String + | FailedToLoadCredential String + deriving Show + +instance Exception ParseCertException