Add tests for K8sJSONPath
Also convert all `Either Text` to `Either String`
This commit is contained in:
@@ -22,6 +22,7 @@ tests:
|
||||
dependencies:
|
||||
- kubernetes-client
|
||||
- hspec
|
||||
- hspec-attoparsec
|
||||
- yaml
|
||||
- file-embed
|
||||
example:
|
||||
|
||||
@@ -5,7 +5,7 @@ module Kubernetes.Client.Auth.GCP
|
||||
where
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Attoparsec.Text
|
||||
import Data.Either.Combinators
|
||||
import Data.Function ((&))
|
||||
import Data.JSONPath
|
||||
@@ -47,15 +47,15 @@ gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tls,
|
||||
= Just $ do
|
||||
configOfErr <- parseGCPAuthInfo cfg
|
||||
case configOfErr of
|
||||
Left e -> error $ Text.unpack e
|
||||
Left e -> error e
|
||||
Right gcp -> pure (tls, addAuthMethod kubecfg gcp)
|
||||
gcpAuth _ _ = Nothing
|
||||
|
||||
exceptEither :: Either Text a -> IO a
|
||||
exceptEither :: Either String a -> IO a
|
||||
exceptEither (Right a) = pure a
|
||||
exceptEither (Left t) = error (show t)
|
||||
|
||||
getToken :: GCPAuth -> IO (Either Text Text)
|
||||
getToken :: GCPAuth -> IO (Either String Text)
|
||||
getToken g@(GCPAuth{..}) = getCurrentToken g
|
||||
>>= maybe (fetchToken g) (return . Right)
|
||||
|
||||
@@ -71,21 +71,20 @@ getCurrentToken (GCPAuth{..}) = do
|
||||
else Nothing
|
||||
|
||||
-- TODO: log if parsed expiry is invalid
|
||||
fetchToken :: GCPAuth -> IO (Either Text Text)
|
||||
fetchToken :: GCPAuth -> IO (Either String Text)
|
||||
fetchToken GCPAuth{..} = do
|
||||
(stdOut, _) <- readProcess_ gcpCmd
|
||||
let credsJSON = Aeson.eitherDecode stdOut
|
||||
& first Text.pack
|
||||
token = runJSONPath gcpTokenKey =<< credsJSON
|
||||
expText = runJSONPath gcpExpiryKey =<< credsJSON
|
||||
expiry :: Either Text (Maybe UTCTime)
|
||||
expiry :: Either String (Maybe UTCTime)
|
||||
expiry = Just <$> (parseExpiryTime =<< expText)
|
||||
atomically $ do
|
||||
writeTVar gcpAccessToken (rightToMaybe token)
|
||||
writeTVar gcpTokenExpiry (either (const Nothing) id expiry)
|
||||
return token
|
||||
|
||||
parseGCPAuthInfo :: Map Text Text -> IO (Either Text GCPAuth)
|
||||
parseGCPAuthInfo :: Map Text Text -> IO (Either String GCPAuth)
|
||||
parseGCPAuthInfo m = do
|
||||
gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" m
|
||||
case maybe (pure Nothing) ((Just <$>) . parseExpiryTime) $ Map.lookup "expiry" m of
|
||||
@@ -95,15 +94,23 @@ parseGCPAuthInfo m = do
|
||||
return $ do
|
||||
cmdPath <- Text.unpack <$> lookupEither m "cmd-path"
|
||||
cmdArgs <- Text.splitOn " " <$> lookupEither m "cmd-args"
|
||||
gcpTokenKey <- readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
|
||||
gcpExpiryKey <- readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
|
||||
let gcpCmd = proc cmdPath (map Text.unpack cmdArgs)
|
||||
gcpTokenKey = readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
|
||||
gcpExpiryKey = readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
|
||||
pure $ GCPAuth{..}
|
||||
|
||||
lookupEither :: (Show key, Ord key) => Map key val -> key -> Either Text val
|
||||
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: " <> (Text.pack $ show k) <> " in GCP auth info"
|
||||
where e = "Couldn't find key: " <> show k <> " in GCP auth info"
|
||||
|
||||
parseExpiryTime :: Text -> Either Text UTCTime
|
||||
parseExpiryTime :: Text -> Either String UTCTime
|
||||
parseExpiryTime s = zonedTimeToUTC <$> parseTimeRFC3339 s
|
||||
& maybeToRight ("failed to parse token expiry time " <> 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
|
||||
|
||||
@@ -4,13 +4,10 @@ module Kubernetes.Data.K8sJSONPath where
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Text
|
||||
import Data.JSONPath
|
||||
import Data.Map as Map
|
||||
import Data.Text as Text
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Attoparsec.Text
|
||||
import Data.Bifunctor (bimap)
|
||||
import Data.String (IsString)
|
||||
import Data.Text.Lazy (toStrict)
|
||||
|
||||
data K8sPathElement = PlainText Text
|
||||
@@ -21,36 +18,29 @@ k8sJSONPath :: Parser [K8sPathElement]
|
||||
k8sJSONPath = many1 pathElementParser
|
||||
|
||||
pathElementParser :: Parser K8sPathElement
|
||||
pathElementParser = curlsParser <|> plainTextParser
|
||||
pathElementParser = jsonpathParser <|> plainTextParser
|
||||
|
||||
plainTextParser :: Parser K8sPathElement
|
||||
plainTextParser = PlainText <$> takeWhile1 (/= '{')
|
||||
|
||||
curlsParser :: Parser K8sPathElement
|
||||
curlsParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
|
||||
jsonpathParser :: Parser K8sPathElement
|
||||
jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
|
||||
|
||||
runJSONPath :: [K8sPathElement] -> Value -> Either Text Text
|
||||
runJSONPath :: [K8sPathElement] -> Value -> Either String Text
|
||||
runJSONPath [] _ = pure ""
|
||||
runJSONPath (e:es) v = do
|
||||
res <- runPathElement e v
|
||||
rest <- runJSONPath es v
|
||||
pure $ res <> rest
|
||||
|
||||
runPathElement :: K8sPathElement -> Value -> Either Text Text
|
||||
runPathElement :: K8sPathElement -> Value -> Either String Text
|
||||
runPathElement (PlainText t) _ = pure t
|
||||
runPathElement (JSONPath p) v = encodeResult $ executeJSONPath p v
|
||||
|
||||
readJSONPath :: Map Text Text -> Text -> [K8sPathElement] -> [K8sPathElement]
|
||||
readJSONPath m key def = case Map.lookup key m of
|
||||
Nothing -> def
|
||||
Just str -> case parseOnly (k8sJSONPath <* endOfInput) str of
|
||||
Left e -> error e
|
||||
Right p -> p
|
||||
|
||||
encodeResult :: ExecutionResult Value -> Either Text Text
|
||||
encodeResult :: ExecutionResult Value -> Either String Text
|
||||
encodeResult (ResultValue val) = return $ jsonToText val
|
||||
encodeResult (ResultList vals) = return $ (intercalate " " $ Prelude.map jsonToText vals)
|
||||
encodeResult (ResultError err) = Left $ pack err
|
||||
encodeResult (ResultError err) = Left err
|
||||
|
||||
jsonToText :: Value -> Text
|
||||
jsonToText (String t) = t
|
||||
|
||||
33
kubernetes-client/test/Kubernetes/Data/K8sJSONPathSpec.hs
Normal file
33
kubernetes-client/test/Kubernetes/Data/K8sJSONPathSpec.hs
Normal file
@@ -0,0 +1,33 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Kubernetes.Data.K8sJSONPathSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Attoparsec
|
||||
|
||||
import Kubernetes.Data.K8sJSONPath
|
||||
import Data.Text
|
||||
import Data.JSONPath
|
||||
import Data.Aeson
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "K8sJSONPath" $ do
|
||||
describe "Parsing" $ do
|
||||
it "should parse plain text" $ do
|
||||
("plain" :: Text) ~> k8sJSONPath
|
||||
`shouldParse` [PlainText "plain"]
|
||||
|
||||
it "should parse jsonpath" $ do
|
||||
("{.foo}" :: Text) ~> k8sJSONPath
|
||||
`shouldParse` [JSONPath [KeyChild "foo"]]
|
||||
|
||||
it "should parse K8sJSONPath with both text and jsonpath" $ do
|
||||
("kind is {.kind}" :: Text) ~> k8sJSONPath
|
||||
`shouldParse` [PlainText "kind is ", JSONPath [KeyChild "kind"]]
|
||||
|
||||
describe "Running" $ do
|
||||
it "should interpolate string with json values" $ do
|
||||
let path = [PlainText "kind is ", JSONPath [KeyChild "kind"]]
|
||||
val = (object ["kind" .= ("Pod" :: Text)])
|
||||
runJSONPath path val `shouldBe` Right "kind is Pod"
|
||||
|
||||
Reference in New Issue
Block a user