Skip to content

Commit df543b9

Browse files
committed
Add tests for K8sJSONPath
Also convert all `Either Text` to `Either String`
1 parent 2f0a2b4 commit df543b9

File tree

4 files changed

+62
-31
lines changed

4 files changed

+62
-31
lines changed

kubernetes-client/package.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ tests:
2222
dependencies:
2323
- kubernetes-client
2424
- hspec
25+
- hspec-attoparsec
2526
- yaml
2627
- file-embed
2728
example:

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

Lines changed: 21 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module Kubernetes.Client.Auth.GCP
55
where
66

77
import Control.Concurrent.STM
8-
import Data.Bifunctor (first)
8+
import Data.Attoparsec.Text
99
import Data.Either.Combinators
1010
import Data.Function ((&))
1111
import Data.JSONPath
@@ -47,15 +47,15 @@ gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tls,
4747
= Just $ do
4848
configOfErr <- parseGCPAuthInfo cfg
4949
case configOfErr of
50-
Left e -> error $ Text.unpack e
50+
Left e -> error e
5151
Right gcp -> pure (tls, addAuthMethod kubecfg gcp)
5252
gcpAuth _ _ = Nothing
5353

54-
exceptEither :: Either Text a -> IO a
54+
exceptEither :: Either String a -> IO a
5555
exceptEither (Right a) = pure a
5656
exceptEither (Left t) = error (show t)
5757

58-
getToken :: GCPAuth -> IO (Either Text Text)
58+
getToken :: GCPAuth -> IO (Either String Text)
5959
getToken g@(GCPAuth{..}) = getCurrentToken g
6060
>>= maybe (fetchToken g) (return . Right)
6161

@@ -71,21 +71,20 @@ getCurrentToken (GCPAuth{..}) = do
7171
else Nothing
7272

7373
-- TODO: log if parsed expiry is invalid
74-
fetchToken :: GCPAuth -> IO (Either Text Text)
74+
fetchToken :: GCPAuth -> IO (Either String Text)
7575
fetchToken GCPAuth{..} = do
7676
(stdOut, _) <- readProcess_ gcpCmd
7777
let credsJSON = Aeson.eitherDecode stdOut
78-
& first Text.pack
7978
token = runJSONPath gcpTokenKey =<< credsJSON
8079
expText = runJSONPath gcpExpiryKey =<< credsJSON
81-
expiry :: Either Text (Maybe UTCTime)
80+
expiry :: Either String (Maybe UTCTime)
8281
expiry = Just <$> (parseExpiryTime =<< expText)
8382
atomically $ do
8483
writeTVar gcpAccessToken (rightToMaybe token)
8584
writeTVar gcpTokenExpiry (either (const Nothing) id expiry)
8685
return token
8786

88-
parseGCPAuthInfo :: Map Text Text -> IO (Either Text GCPAuth)
87+
parseGCPAuthInfo :: Map Text Text -> IO (Either String GCPAuth)
8988
parseGCPAuthInfo m = do
9089
gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" m
9190
case maybe (pure Nothing) ((Just <$>) . parseExpiryTime) $ Map.lookup "expiry" m of
@@ -95,15 +94,23 @@ parseGCPAuthInfo m = do
9594
return $ do
9695
cmdPath <- Text.unpack <$> lookupEither m "cmd-path"
9796
cmdArgs <- Text.splitOn " " <$> lookupEither m "cmd-args"
97+
gcpTokenKey <- readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
98+
gcpExpiryKey <- readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
9899
let gcpCmd = proc cmdPath (map Text.unpack cmdArgs)
99-
gcpTokenKey = readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
100-
gcpExpiryKey = readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
101100
pure $ GCPAuth{..}
102101

103-
lookupEither :: (Show key, Ord key) => Map key val -> key -> Either Text val
102+
lookupEither :: (Show key, Ord key) => Map key val -> key -> Either String val
104103
lookupEither m k = maybeToRight e $ Map.lookup k m
105-
where e = "Couldn't find key: " <> (Text.pack $ show k) <> " in GCP auth info"
104+
where e = "Couldn't find key: " <> show k <> " in GCP auth info"
106105

107-
parseExpiryTime :: Text -> Either Text UTCTime
106+
parseExpiryTime :: Text -> Either String UTCTime
108107
parseExpiryTime s = zonedTimeToUTC <$> parseTimeRFC3339 s
109-
& maybeToRight ("failed to parse token expiry time " <> s)
108+
& maybeToRight ("failed to parse token expiry time " <> Text.unpack s)
109+
110+
readJSONPath :: Map Text Text
111+
-> Text
112+
-> [K8sPathElement]
113+
-> Either String [K8sPathElement]
114+
readJSONPath m key def = case Map.lookup key m of
115+
Nothing -> pure def
116+
Just str -> parseOnly (k8sJSONPath <* endOfInput) str

kubernetes-client/src/Kubernetes/Data/K8sJSONPath.hs

Lines changed: 7 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,10 @@ module Kubernetes.Data.K8sJSONPath where
44
import Data.Aeson
55
import Data.Aeson.Text
66
import Data.JSONPath
7-
import Data.Map as Map
87
import Data.Text as Text
98

109
import Control.Applicative ((<|>))
1110
import Data.Attoparsec.Text
12-
import Data.Bifunctor (bimap)
13-
import Data.String (IsString)
1411
import Data.Text.Lazy (toStrict)
1512

1613
data K8sPathElement = PlainText Text
@@ -21,36 +18,29 @@ k8sJSONPath :: Parser [K8sPathElement]
2118
k8sJSONPath = many1 pathElementParser
2219

2320
pathElementParser :: Parser K8sPathElement
24-
pathElementParser = curlsParser <|> plainTextParser
21+
pathElementParser = jsonpathParser <|> plainTextParser
2522

2623
plainTextParser :: Parser K8sPathElement
2724
plainTextParser = PlainText <$> takeWhile1 (/= '{')
2825

29-
curlsParser :: Parser K8sPathElement
30-
curlsParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
26+
jsonpathParser :: Parser K8sPathElement
27+
jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
3128

32-
runJSONPath :: [K8sPathElement] -> Value -> Either Text Text
29+
runJSONPath :: [K8sPathElement] -> Value -> Either String Text
3330
runJSONPath [] _ = pure ""
3431
runJSONPath (e:es) v = do
3532
res <- runPathElement e v
3633
rest <- runJSONPath es v
3734
pure $ res <> rest
3835

39-
runPathElement :: K8sPathElement -> Value -> Either Text Text
36+
runPathElement :: K8sPathElement -> Value -> Either String Text
4037
runPathElement (PlainText t) _ = pure t
4138
runPathElement (JSONPath p) v = encodeResult $ executeJSONPath p v
4239

43-
readJSONPath :: Map Text Text -> Text -> [K8sPathElement] -> [K8sPathElement]
44-
readJSONPath m key def = case Map.lookup key m of
45-
Nothing -> def
46-
Just str -> case parseOnly (k8sJSONPath <* endOfInput) str of
47-
Left e -> error e
48-
Right p -> p
49-
50-
encodeResult :: ExecutionResult Value -> Either Text Text
40+
encodeResult :: ExecutionResult Value -> Either String Text
5141
encodeResult (ResultValue val) = return $ jsonToText val
5242
encodeResult (ResultList vals) = return $ (intercalate " " $ Prelude.map jsonToText vals)
53-
encodeResult (ResultError err) = Left $ pack err
43+
encodeResult (ResultError err) = Left err
5444

5545
jsonToText :: Value -> Text
5646
jsonToText (String t) = t
Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
module Kubernetes.Data.K8sJSONPathSpec where
3+
4+
import Test.Hspec
5+
import Test.Hspec.Attoparsec
6+
7+
import Kubernetes.Data.K8sJSONPath
8+
import Data.Text
9+
import Data.JSONPath
10+
import Data.Aeson
11+
12+
spec :: Spec
13+
spec = do
14+
describe "K8sJSONPath" $ do
15+
describe "Parsing" $ do
16+
it "should parse plain text" $ do
17+
("plain" :: Text) ~> k8sJSONPath
18+
`shouldParse` [PlainText "plain"]
19+
20+
it "should parse jsonpath" $ do
21+
("{.foo}" :: Text) ~> k8sJSONPath
22+
`shouldParse` [JSONPath [KeyChild "foo"]]
23+
24+
it "should parse K8sJSONPath with both text and jsonpath" $ do
25+
("kind is {.kind}" :: Text) ~> k8sJSONPath
26+
`shouldParse` [PlainText "kind is ", JSONPath [KeyChild "kind"]]
27+
28+
describe "Running" $ do
29+
it "should interpolate string with json values" $ do
30+
let path = [PlainText "kind is ", JSONPath [KeyChild "kind"]]
31+
val = (object ["kind" .= ("Pod" :: Text)])
32+
runJSONPath path val `shouldBe` Right "kind is Pod"
33+

0 commit comments

Comments
 (0)