Add tests for K8sJSONPath

Also convert all `Either Text` to `Either String`
This commit is contained in:
Akshay Mankar
2019-07-24 01:12:08 +01:00
parent 2f0a2b4cb1
commit df543b990b
4 changed files with 62 additions and 31 deletions

View File

@@ -22,6 +22,7 @@ tests:
dependencies:
- kubernetes-client
- hspec
- hspec-attoparsec
- yaml
- file-embed
example:

View File

@@ -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

View File

@@ -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

View 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"