kubernetes-api-client (empty) → 0.6.0.0
raw patch · 28 files changed
+2296/−0 lines, 28 filesdep +aesondep +attoparsecdep +base
Dependencies added: aeson, attoparsec, base, base64-bytestring, bytestring, connection, containers, crypton-connection, crypton-x509, crypton-x509-store, crypton-x509-system, crypton-x509-validation, data-default-class, either, file-embed, filepath, hoauth2, hspec, hspec-attoparsec, hspec-megaparsec, http-client, http-client-tls, jose-jwt, jsonpath, kubernetes-api, kubernetes-api-client, megaparsec, microlens, mtl, oidc-client, pem, safe-exceptions, stm, streaming-bytestring, text, time, timerep, tls, typed-process, uri-bytestring, x509, x509-store, x509-system, x509-validation, yaml
Files
- LICENSE +201/−0
- README.md +163/−0
- example/App.hs +68/−0
- kubernetes-api-client.cabal +218/−0
- src/Kubernetes/Client.hs +9/−0
- src/Kubernetes/Client/Auth/Basic.hs +49/−0
- src/Kubernetes/Client/Auth/ClientCert.hs +41/−0
- src/Kubernetes/Client/Auth/GCP.hs +137/−0
- src/Kubernetes/Client/Auth/Internal/Types.hs +9/−0
- src/Kubernetes/Client/Auth/OIDC.hs +243/−0
- src/Kubernetes/Client/Auth/Token.hs +32/−0
- src/Kubernetes/Client/Auth/TokenFile.hs +77/−0
- src/Kubernetes/Client/Config.hs +176/−0
- src/Kubernetes/Client/Internal/TLSUtils.hs +108/−0
- src/Kubernetes/Client/KubeConfig.hs +204/−0
- src/Kubernetes/Client/Watch.hs +105/−0
- src/Kubernetes/Data/K8sJSONPath.hs +85/−0
- test/Kubernetes/Client/Auth/BasicSpec.hs +55/−0
- test/Kubernetes/Client/Auth/ClientCertSpec.hs +77/−0
- test/Kubernetes/Client/Auth/TokenFileSpec.hs +73/−0
- test/Kubernetes/Client/KubeConfigSpec.hs +38/−0
- test/Kubernetes/Data/K8sJSONPathSpec.hs +46/−0
- test/Spec.hs +1/−0
- test/testdata/certs/certificate.pem +17/−0
- test/testdata/certs/private-key.pem +27/−0
- test/testdata/kubeconfig.yaml +35/−0
- test/testdata/tokens/token1 +1/−0
- test/testdata/tokens/token2 +1/−0
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,163 @@+# kubernetes-api-client++## Example++### Load KubeConfig file++```haskell+import Control.Concurrent.STM (atomically, newTVar)+import Kubernetes.Client (KubeConfigSource (..), mkKubeClientConfig)+import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), dispatchMime)++import qualified Data.Map as Map+import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1++main :: IO ()+main = do+ oidcCache <- atomically $ newTVar $ Map.fromList []+ (mgr, kcfg) <- mkKubeClientConfig oidcCache $ KubeConfigFile "/path/to/kubeconfig"+ dispatchMime+ mgr+ kcfg+ (CoreV1.listPodForAllNamespaces (Accept MimeJSON))+ >>= print+```++### Load InCluster Config++```haskell+import Control.Concurrent.STM (atomically, newTVar)+import Data.Function ((&))+import Kubernetes.Client (KubeConfigSource (..), mkKubeClientConfig)+import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), dispatchMime)+import Network.TLS (credentialLoadX509)++import qualified Data.Map as Map+import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1++main :: IO ()+main = do+ oidcCache <- atomically $ newTVar $ Map.fromList []+ (mgr, kcfg) <- mkKubeClientConfig oidcCache KubeConfigCluster+ dispatchMime+ mgr+ kcfg+ (CoreV1.listPodForAllNamespaces (Accept MimeJSON))+ >>= print+```++### Load config from URL and paths++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Function ((&))+import Kubernetes.Client (defaultTLSClientParams,+ disableServerCertValidation,+ disableServerNameValidation,+ disableValidateAuthMethods,+ loadPEMCerts, newManager,+ setCAStore, setClientCert,+ setMasterURI, setTokenAuth)+import Kubernetes.OpenAPI (Accept (..), MimeJSON (..),+ dispatchMime, newConfig)+import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1+import Network.TLS (credentialLoadX509)++main :: IO ()+main = do+ -- We need to first create a Kubernetes.Core.KubernetesConfig and a Network.HTTP.Client.Manager.+ -- Currently we need to construct these objects manually. Work is underway to construct these+ -- objects automatically from a kubeconfig file. See https://github.com/kubernetes-client/haskell/issues/2.+ kcfg <-+ newConfig+ & fmap (setMasterURI "https://mycluster.example.com") -- fill in master URI+ & fmap (setTokenAuth "mytoken") -- if using token auth+ & fmap disableValidateAuthMethods -- if using client cert auth+ myCAStore <- loadPEMCerts "/path/to/ca.crt" -- if using custom CA certs+ myCert <- -- if using client cert+ credentialLoadX509 "/path/to/client.crt" "/path/to/client.key"+ >>= either error return+ tlsParams <-+ defaultTLSClientParams+ & fmap disableServerNameValidation -- if master address is specified as an IP address+ & fmap disableServerCertValidation -- if you don't want to validate the server cert at all (insecure)+ & fmap (setCAStore myCAStore) -- if using custom CA certs+ & fmap (setClientCert myCert) -- if using client cert+ manager <- newManager tlsParams+ dispatchMime+ manager+ kcfg+ (CoreV1.listPodForAllNamespaces (Accept MimeJSON))+ >>= print+```++## Watch Example+Following is a simple example which+just streams to stdout. First some setup - this assumes kubernetes is accessible+at http://localhost:8001, e.g. after running `kubectl proxy`:++```haskell+> import qualified Data.ByteString.Streaming.Char8 as Q++> manager <- newManager defaultManagerSettings+> defaultConfig <- newConfig+> config = defaultConfig { configHost = "http://localhost:8001", configValidateAuthMethods = False }+> request = listEndpointsForAllNamespaces (Accept MimeJSON)+```++Launching 'dispatchWatch' with the above we get a stream of endpoints data:++```haskell+ > dispatchWatch manager config request Q.stdout+ {"type":\"ADDED\","object":{"kind":\"Endpoints\","apiVersion":"v1","metadata":{"name":"heapster" ....+```++A more complex example involving some ggprocessing of the stream, the following+prints out the event types of each event. First, define functions to allow us apply+a parser to a stream:+++```haskell+import Data.Aeson+import qualified Data.ByteString.Streaming.Char8 as Q+import Data.JsonStream.Parser+import qualified Streaming.Prelude as S++-- | Parse the stream using the given parser.+streamParse ::+ FromJSON a =>+ Parser a+ -> Q.ByteString IO r+ -> Stream (Of [a]) IO r+streamParse parser byteStream = do+ byteStream & Q.lines & parseEvent parser++-- | Parse a single event from the stream.+parseEvent ::+ (FromJSON a, Monad m) =>+ Parser a+ -> Stream (Q.ByteString m) m r+ -> Stream (Of [a]) m r+parseEvent parser byteStream = S.map (parseByteString parser) (S.mapped Q.toStrict byteStream)+```++Next, define the parser and apply it to the stream:++```haskell+> eventParser = value :: Parser (WatchEvent V1Endpoints)+> withResponseBody body = streamParse eventParser body & S.map (map eventType)+> dispatchWatch manager config request (S.print . withResponseBody)+[\"ADDED\"]+[\"ADDED\"]+[\"MODIFIED\"]+...+```++Packages in this example:+ * Data.Aeson -- from [aeson](https://hackage.haskell.org/package/aeson)+ * Data.ByteString.Streaming.Char8 from [streaming-bytestring](https://hackage.haskell.org/package/streaming-bytestring-0.1.5/docs/Data-ByteString-Streaming-Char8.html)+ * Data.JsonStream.Parser from [json-stream](https://hackage.haskell.org/package/json-stream-0.4.1.5/docs/Data-JsonStream-Parser.html)+ * Streaming.Prelude from [streaming](https://hackage.haskell.org/package/streaming-0.2.0.0/docs/Streaming-Prelude.html)
+ example/App.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent.STM (atomically, newTVar)+import Data.Function ((&))+import Kubernetes.Client (KubeConfigSource (..), defaultTLSClientParams,+ disableServerCertValidation,+ disableServerNameValidation,+ disableValidateAuthMethods, mkKubeClientConfig,+ loadPEMCerts, newManager, setCAStore,+ setClientCert, setMasterURI, setTokenAuth)+import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), dispatchMime,+ newConfig)+import Network.TLS (credentialLoadX509)++import qualified Data.Map as Map+import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1++example :: IO ()+example = do+ -- We need to first create a Kubernetes.Core.KubernetesConfig and a Network.HTTP.Client.Manager.+ -- Currently we need to construct these objects manually. Work is underway to construct these+ -- objects automatically from a kubeconfig file. See https://github.com/kubernetes-client/haskell/issues/2.+ kcfg <-+ newConfig+ & fmap (setMasterURI "https://mycluster.example.com") -- fill in master URI+ & fmap (setTokenAuth "mytoken") -- if using token auth+ & fmap disableValidateAuthMethods -- if using client cert auth+ myCAStore <- loadPEMCerts "/path/to/ca.crt" -- if using custom CA certs+ myCert <- -- if using client cert+ credentialLoadX509 "/path/to/client.crt" "/path/to/client.key"+ >>= either error return+ tlsParams <-+ defaultTLSClientParams+ & fmap disableServerNameValidation -- if master address is specified as an IP address+ & fmap disableServerCertValidation -- if you don't want to validate the server cert at all (insecure)+ & fmap (setCAStore myCAStore) -- if using custom CA certs+ & fmap (setClientCert myCert) -- if using client cert+ manager <- newManager tlsParams+ dispatchMime+ manager+ kcfg+ (CoreV1.listPodForAllNamespaces (Accept MimeJSON))+ >>= print++exampleWithKubeConfig :: IO ()+exampleWithKubeConfig = do+ oidcCache <- atomically $ newTVar $ Map.fromList []+ (mgr, kcfg) <- mkKubeClientConfig oidcCache $ KubeConfigFile "/path/to/kubeconfig"+ dispatchMime+ mgr+ kcfg+ (CoreV1.listPodForAllNamespaces (Accept MimeJSON))+ >>= print++exampleWithInClusterConfig :: IO ()+exampleWithInClusterConfig = do+ oidcCache <- atomically $ newTVar $ Map.fromList []+ (mgr, kcfg) <- mkKubeClientConfig oidcCache KubeConfigCluster+ dispatchMime+ mgr+ kcfg+ (CoreV1.listPodForAllNamespaces (Accept MimeJSON))+ >>= print++main :: IO ()+main = return ()
+ kubernetes-api-client.cabal view
@@ -0,0 +1,218 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name: kubernetes-api-client+version: 0.6.0.0+synopsis: Client library for Kubernetes+description: Client library for interacting with a Kubernetes cluster.+ .+ This package contains hand-written code, while @kubernetes-api@ contains code auto-generated from the OpenAPI spec.+ .+ It was forked from the @kubernetes-client@ package.+category: Web+maintainer: Tom McLaughlin <tom@codedown.io>+license: Apache-2.0+license-file: LICENSE+build-type: Simple+extra-source-files:+ test/testdata/certs/certificate.pem+ test/testdata/certs/private-key.pem+ test/testdata/kubeconfig.yaml+ test/testdata/tokens/token1+ test/testdata/tokens/token2+ README.md++library+ exposed-modules:+ Kubernetes.Client+ Kubernetes.Client.Auth.Basic+ Kubernetes.Client.Auth.ClientCert+ Kubernetes.Client.Auth.GCP+ Kubernetes.Client.Auth.Internal.Types+ Kubernetes.Client.Auth.OIDC+ Kubernetes.Client.Auth.Token+ Kubernetes.Client.Auth.TokenFile+ Kubernetes.Client.Config+ Kubernetes.Client.Internal.TLSUtils+ Kubernetes.Client.KubeConfig+ Kubernetes.Client.Watch+ Kubernetes.Data.K8sJSONPath+ other-modules:+ Paths_kubernetes_api_client+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ aeson >=1.2 && <3+ , attoparsec >=0.13+ , base >=4.7 && <5.0+ , base64-bytestring+ , bytestring >=0.10+ , containers >=0.5+ , data-default-class >=0.1+ , either >=5.0+ , filepath >=1.4+ , hoauth2 >=1.11 && <=3+ , http-client >=0.5 && <0.8+ , http-client-tls >=0.3+ , jose-jwt >=0.8+ , jsonpath >=0.1 && <0.4+ , kubernetes-api+ , megaparsec ==9.*+ , microlens >=0.4+ , mtl >=2.2+ , oidc-client >=0.4+ , pem >=0.2+ , safe-exceptions >=0.1.0.0+ , stm >=2.4+ , streaming-bytestring >=0.1 && <0.4+ , text >=0.11 && <3+ , time >=1.8+ , timerep >=2.0+ , tls >=1.4.1+ , typed-process >=0.2+ , uri-bytestring >=0.3+ , yaml >=0.8.32+ default-language: Haskell2010+ if impl(ghc >= 9.6)+ build-depends:+ crypton-connection+ , crypton-x509 >=1.7+ , crypton-x509-store >=1.6+ , crypton-x509-system >=1.6+ , crypton-x509-validation >=1.6+ else+ build-depends:+ connection+ , x509 >=1.7+ , x509-store >=1.6+ , x509-system >=1.6+ , x509-validation >=1.6++test-suite example+ type: exitcode-stdio-1.0+ main-is: App.hs+ other-modules:+ Paths_kubernetes_api_client+ hs-source-dirs:+ example+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ aeson >=1.2 && <3+ , attoparsec >=0.13+ , base >=4.7 && <5.0+ , base64-bytestring+ , bytestring >=0.10+ , containers >=0.5+ , data-default-class >=0.1+ , either >=5.0+ , filepath >=1.4+ , hoauth2 >=1.11 && <=3+ , http-client >=0.5 && <0.8+ , http-client-tls >=0.3+ , jose-jwt >=0.8+ , jsonpath >=0.1 && <0.4+ , kubernetes-api+ , kubernetes-api-client+ , megaparsec ==9.*+ , microlens >=0.4+ , mtl >=2.2+ , oidc-client >=0.4+ , pem >=0.2+ , safe-exceptions >=0.1.0.0+ , stm >=2.4+ , streaming-bytestring >=0.1 && <0.4+ , text >=0.11 && <3+ , time >=1.8+ , timerep >=2.0+ , tls >=1.4.1+ , typed-process >=0.2+ , uri-bytestring >=0.3+ , yaml >=0.8.32+ default-language: Haskell2010+ if impl(ghc >= 9.6)+ build-depends:+ crypton-connection+ , crypton-x509 >=1.7+ , crypton-x509-store >=1.6+ , crypton-x509-system >=1.6+ , crypton-x509-validation >=1.6+ else+ build-depends:+ connection+ , x509 >=1.7+ , x509-store >=1.6+ , x509-system >=1.6+ , x509-validation >=1.6++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Kubernetes.Client.Auth.BasicSpec+ Kubernetes.Client.Auth.ClientCertSpec+ Kubernetes.Client.Auth.TokenFileSpec+ Kubernetes.Client.KubeConfigSpec+ Kubernetes.Data.K8sJSONPathSpec+ Paths_kubernetes_api_client+ hs-source-dirs:+ test+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ aeson >=1.2 && <3+ , attoparsec >=0.13+ , base >=4.7 && <5.0+ , base64-bytestring+ , bytestring >=0.10+ , containers >=0.5+ , data-default-class >=0.1+ , either >=5.0+ , file-embed+ , filepath >=1.4+ , hoauth2 >=1.11 && <=3+ , hspec+ , hspec-attoparsec+ , hspec-megaparsec+ , http-client >=0.5 && <0.8+ , http-client-tls >=0.3+ , jose-jwt >=0.8+ , jsonpath >=0.1 && <0.4+ , kubernetes-api+ , kubernetes-api-client+ , megaparsec ==9.*+ , microlens >=0.4+ , mtl >=2.2+ , oidc-client >=0.4+ , pem >=0.2+ , safe-exceptions >=0.1.0.0+ , stm >=2.4+ , streaming-bytestring >=0.1 && <0.4+ , text >=0.11 && <3+ , time >=1.8+ , timerep >=2.0+ , tls >=1.4.1+ , typed-process >=0.2+ , uri-bytestring >=0.3+ , yaml >=0.8.4+ default-language: Haskell2010+ if impl(ghc >= 9.6)+ build-depends:+ crypton-connection+ , crypton-x509 >=1.7+ , crypton-x509-store >=1.6+ , crypton-x509-system >=1.6+ , crypton-x509-validation >=1.6+ else+ build-depends:+ connection+ , x509 >=1.7+ , x509-store >=1.6+ , x509-system >=1.6+ , x509-validation >=1.6
+ src/Kubernetes/Client.hs view
@@ -0,0 +1,9 @@+module Kubernetes.Client+ ( module Kubernetes.Client.Config+ , module Kubernetes.Client.KubeConfig+ , module Kubernetes.Client.Watch+ ) where++import Kubernetes.Client.Config+import Kubernetes.Client.KubeConfig+import Kubernetes.Client.Watch
+ src/Kubernetes/Client/Auth/Basic.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Kubernetes.Client.Auth.Basic where++import Data.ByteString.Base64 ( encode )+import Data.Function ( (&) )+import Data.Text ( Text )+import Kubernetes.Client.Auth.Internal.Types+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI.Core++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif++import qualified Data.Text.Encoding as T+import qualified Lens.Micro as L+++data BasicAuth = BasicAuth { basicAuthUsername :: Text+ , basicAuthPassword :: Text+ }++instance AuthMethod BasicAuth where+ applyAuthMethod _ BasicAuth{..} req =+ pure+ $ req+ `setHeader` toHeader ("authorization", "Basic " <> encodeBasicAuth)+ & L.set rAuthTypesL []+ where+ encodeBasicAuth = T.decodeUtf8 $ encode $ T.encodeUtf8 $ basicAuthUsername <> ":" <> basicAuthPassword++-- |Detects if username and password is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'BasicAuth'+basicAuth :: DetectAuth+basicAuth auth (tlsParams, cfg) = do+ u <- username auth+ p <- password auth+ return $ return (tlsParams, setBasicAuth u p cfg)++-- |Configures the 'KubernetesClientConfig' to use basic authentication.+setBasicAuth+ :: Text -- ^Username+ -> Text -- ^Password+ -> KubernetesClientConfig+ -> KubernetesClientConfig+setBasicAuth u p kcfg = kcfg+ { configAuthMethods = [AnyAuthMethod (BasicAuth u p)]+ }
+ src/Kubernetes/Client/Auth/ClientCert.hs view
@@ -0,0 +1,41 @@+module Kubernetes.Client.Auth.ClientCert where++import Control.Exception.Safe (Exception, throwM)+import Data.Text.Encoding+import Kubernetes.Client.Auth.Internal.Types+import Kubernetes.Client.Internal.TLSUtils+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI (KubernetesClientConfig (..))+import Network.TLS++-- | Detects if kuebconfig file provides 'client-certificate', if it configures TLS client params with the client certificate+clientCertFileAuth :: DetectAuth+clientCertFileAuth auth (tlsParams, cfg) = do+ certFile <- clientCertificate auth+ keyFile <- clientKey auth+ return $ do+ cert <- credentialLoadX509 certFile keyFile+ >>= either (throwM . CredentialLoadException) return+ let newParams = (setClientCert cert tlsParams)+ newCfg = (disableValidateAuthMethods cfg)+ return (newParams, newCfg)++-- | Detects if kuebconfig file provides 'client-certificate-data', if it configures TLS client params with the client certificate+clientCertDataAuth :: DetectAuth+clientCertDataAuth auth (tlsParams, cfg) = do+ certB64 <- encodeUtf8 <$> clientCertificateData auth+ keyB64 <- encodeUtf8 <$> clientKeyData auth+ Just $ do+ cert <- loadB64EncodedCert certB64 keyB64+ let newParams = (setClientCert cert tlsParams)+ newCfg = (disableValidateAuthMethods cfg)+ return (newParams, newCfg)++-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication.+disableValidateAuthMethods :: KubernetesClientConfig -> KubernetesClientConfig+disableValidateAuthMethods kcfg = kcfg { configValidateAuthMethods = False }++data CredentialLoadException = CredentialLoadException String+ deriving Show++instance Exception CredentialLoadException
+ src/Kubernetes/Client/Auth/GCP.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Kubernetes.Client.Auth.GCP+ ( gcpAuth )+where++import Control.Concurrent.STM+import Control.Exception.Safe (Exception, throwM)+import Data.Either.Combinators+import Data.Function ((&))+import Data.JSONPath+import Data.Map (Map)+import Data.Text (Text)+import Data.Time.Clock+import Data.Time.LocalTime+import Data.Time.RFC3339+import Kubernetes.Client.Auth.Internal.Types+import Kubernetes.Client.KubeConfig+import Kubernetes.Data.K8sJSONPath+import Kubernetes.OpenAPI.Core+import System.Process.Typed++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif++import qualified Data.Aeson as Aeson+import qualified Data.Map as Map+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Lens.Micro as L++-- TODO: Add support for scopes based token fetching+data GCPAuth = GCPAuth { gcpAccessToken :: TVar(Maybe Text)+ , gcpTokenExpiry :: TVar(Maybe UTCTime)+ , gcpCmd :: ProcessConfig () () ()+ , gcpTokenKey :: [K8sPathElement]+ , gcpExpiryKey :: [K8sPathElement]+ }++instance AuthMethod GCPAuth where+ applyAuthMethod _ gcp req = do+ token <- getToken gcp+ >>= either throwM pure+ pure+ $ setHeader req [("Authorization", "Bearer " <> (Text.encodeUtf8 token))]+ & L.set rAuthTypesL []++-- |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))} (tlsParams, kubecfg)+ = Just $ do+ configOrErr <- parseGCPAuthInfo cfg+ case configOrErr of+ Left err -> throwM err+ Right gcp -> pure (tlsParams, addAuthMethod kubecfg gcp)+gcpAuth _ _ = Nothing++data GCPAuthParsingException = GCPAuthMissingInformation String+ | GCPAuthInvalidExpiry String+ | GCPAuthInvalidTokenJSONPath String+ | GCPAuthInvalidExpiryJSONPath String+ deriving Show+instance Exception GCPAuthParsingException++data GCPGetTokenException = GCPCmdProducedInvalidJSON String+ | GCPTokenNotFound String+ | GCPTokenExpiryNotFound String+ | GCPTokenExpiryInvalid String+ deriving Show+instance Exception GCPGetTokenException++getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)+getToken auth@(GCPAuth{}) = getCurrentToken auth >>= maybe (fetchToken auth) (return . Right)++getCurrentToken :: GCPAuth -> IO (Maybe Text)+getCurrentToken (GCPAuth{..}) = do+ now <- getCurrentTime+ maybeExpiry <- readTVarIO gcpTokenExpiry+ maybeToken <- readTVarIO gcpAccessToken+ return $ do+ expiry <- maybeExpiry+ if expiry > now+ then maybeToken+ else Nothing++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+ where+ parseTokenAndExpiry credsStr = do+ credsJSON <- Aeson.eitherDecode credsStr+ & mapLeft GCPCmdProducedInvalidJSON+ token <- runJSONPath gcpTokenKey credsJSON+ & mapLeft GCPTokenNotFound+ expText <- runJSONPath gcpExpiryKey credsJSON+ & mapLeft GCPTokenExpiryNotFound+ expiry <- parseExpiryTime expText+ & mapLeft GCPTokenExpiryInvalid+ return (token, expiry)++parseGCPAuthInfo :: Map Text Text -> IO (Either GCPAuthParsingException GCPAuth)+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 "token-key" [JSONPath [KeyChild "token_expiry"]]+ & mapLeft GCPAuthInvalidTokenJSONPath+ 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" authInfo of+ Nothing -> Right Nothing+ Just expiryText -> Just <$> parseExpiryTime expiryText+ lookupEither key = Map.lookup key authInfo+ & maybeToRight (GCPAuthMissingInformation $ Text.unpack key)+ readJSONPath key defaultPath =+ maybe (Right defaultPath) parseK8sJSONPath $ Map.lookup key authInfo++parseExpiryTime :: Text -> Either String UTCTime+parseExpiryTime expiryText =+ zonedTimeToUTC <$> parseTimeRFC3339 expiryText+ & maybeToRight ("failed to parse token expiry time " <> Text.unpack expiryText)
+ src/Kubernetes/Client/Auth/Internal/Types.hs view
@@ -0,0 +1,9 @@+module Kubernetes.Client.Auth.Internal.Types where++import Network.TLS as TLS+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI (KubernetesClientConfig)++type DetectAuth = AuthInfo+ -> (TLS.ClientParams, KubernetesClientConfig)+ -> Maybe (IO (TLS.ClientParams, KubernetesClientConfig))
+ src/Kubernetes/Client/Auth/OIDC.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Kubernetes.Client.Auth.OIDC+ (oidcAuth, OIDCCache, cachedOIDCAuth)+where++import Control.Applicative+import Control.Concurrent.STM+import Control.Exception.Safe (Exception, throwM)+import Control.Monad.Except (runExceptT)+import Data.Either.Combinators+import Data.Function ((&))+import Data.Map (Map)+import Data.Maybe+import Data.Text+import Data.Text.Encoding (encodeUtf8)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Jose.Jwt+import Kubernetes.Client.Auth.Internal.Types+import Kubernetes.Client.Internal.TLSUtils+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI.Core+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.OAuth.OAuth2 as OAuth+import Network.TLS as TLS+import URI.ByteString+import Web.OIDC.Client.Discovery as OIDC++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif++import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64+import qualified Data.Map as Map+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Lens.Micro as L++#if !MIN_VERSION_hoauth2(2,8,0)+import qualified Network.OAuth.OAuth2.TokenRequest as OAuth2TokenRequest+#endif+++data OIDCAuth = OIDCAuth { issuerURL :: Text+ , clientID :: Text+ , clientSecret :: Text+ , tlsParams :: TLS.ClientParams+ , idTokenTVar :: TVar(Maybe Text)+ , refreshTokenTVar :: TVar(Maybe Text)+#if MIN_VERSION_hoauth2(2,3,0)+ , redirectUri :: URI+#endif+ }++-- | Cache OIDCAuth based on issuerURL and clientID.+type OIDCCache = TVar (Map (Text, Text) OIDCAuth)++instance AuthMethod OIDCAuth where+ applyAuthMethod _ oidc req = do+ token <- getToken oidc+ pure+ $ setHeader req [("Authorization", "Bearer " <> (Text.encodeUtf8 token))]+ & L.set rAuthTypesL []++data OIDCGetTokenException =+#if MIN_VERSION_hoauth2(2,9,0)+ OIDCOAuthException TokenResponseError+#elif MIN_VERSION_hoauth2(2,8,0)+ OIDCOAuthException TokenRequestError+#else+ OIDCOAuthException (OAuth2Error OAuth2TokenRequest.Errors)+#endif+ | OIDCURIException URIParseError+ | OIDCGetTokenException String+ deriving Show+instance Exception OIDCGetTokenException++data OIDCAuthParsingException = OIDCAuthCAParsingFailed ParseCertException+ | OIDCAuthMissingInformation String+ deriving Show+instance Exception OIDCAuthParsingException++-- TODO: Consider a token expired few seconds before actual expiry to account for time skew+getToken :: OIDCAuth -> IO Text+getToken auth@(OIDCAuth{..}) = do+ now <- getPOSIXTime+ maybeIdToken <- readTVarIO idTokenTVar+ case maybeIdToken of+ Nothing -> fetchToken auth+ Just idToken -> do+ let maybeExpiry = do+ (_, claims) <- decodeClaims (Text.encodeUtf8 idToken)+ & rightToMaybe+ jwtExp claims+ case maybeExpiry of+ Nothing -> fetchToken auth+ Just (IntDate expiryDate) ->+ if now < expiryDate+ then pure idToken+ else fetchToken auth++fetchToken :: OIDCAuth -> IO Text+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 auth+ tokenURI <- parseURI strictURIParserOptions (Text.encodeUtf8 tokenEndpoint)+ & either (throwM . OIDCURIException) pure++#if MIN_VERSION_hoauth2(2,3,0)+ let oauth = OAuth2{ oauth2ClientId = clientID+ , oauth2ClientSecret = clientSecret+ , oauth2AuthorizeEndpoint = tokenURI+ , oauth2TokenEndpoint = tokenURI+ , oauth2RedirectUri = redirectUri+ }+#elif MIN_VERSION_hoauth2(2,2,0)+ let oauth = OAuth2{ oauth2ClientId = clientID+ , oauth2ClientSecret = clientSecret+ , oauth2AuthorizeEndpoint = tokenURI+ , oauth2TokenEndpoint = tokenURI+ , oauth2RedirectUri = Nothing+ }+#elif MIN_VERSION_hoauth2(2,0,0)+ let oauth = OAuth2{ oauth2ClientId = clientID+ , oauth2ClientSecret = Just clientSecret+ , oauth2AuthorizeEndpoint = tokenURI+ , oauth2TokenEndpoint = tokenURI+ , oauth2RedirectUri = Nothing+ }+#else+ let oauth = OAuth2{ oauthClientId = clientID+ , oauthClientSecret = Just clientSecret+ , oauthAccessTokenEndpoint = tokenURI+ , oauthOAuthorizeEndpoint = tokenURI+ , oauthCallback = Nothing+ }+#endif++#if MIN_VERSION_hoauth2(2,2,0)+ oauthToken <- runExceptT (refreshAccessToken mgr oauth (RefreshToken token)) >>= either (throwM . OIDCOAuthException) pure+#else+ oauthToken <- (refreshAccessToken mgr oauth (RefreshToken token)) >>= either (throwM . OIDCOAuthException) pure+#endif++ case OAuth.idToken oauthToken of+ Nothing -> throwM $ OIDCGetTokenException "token response did not contain an id_token, either the scope \"openid\" wasn't requested upon login, or the provider doesn't support id_tokens as part of the refresh response."+ Just (IdToken t) -> do+ _ <- atomically $ writeTVar idTokenTVar (Just t)+ return t++fetchTokenEndpoint :: Manager -> OIDCAuth -> IO Text+fetchTokenEndpoint mgr OIDCAuth{..} = do+ discover issuerURL mgr+ & (fmap configuration)+ & (fmap tokenEndpoint)++{-+ Detects if auth-provier name is oidc, if it is configures the 'KubernetesClientConfig' with OIDCAuth 'AuthMethod'.+ Does not use cache, consider using 'cachedOIDCAuth'.+-}+oidcAuth :: DetectAuth+oidcAuth AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Just cfg))} (tls, kubecfg)+ = Just+ $ parseOIDCAuthInfo cfg+ >>= 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+{-+ Detects if auth-provier name is oidc, if it is configures the 'KubernetesClientConfig' with OIDCAuth 'AuthMethod'.+ First looks for Auth information to be present in 'OIDCCache'. If found returns that, otherwise creates new Auth information and persists it in cache.+-}+cachedOIDCAuth :: OIDCCache -> DetectAuth+cachedOIDCAuth cache AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Just cfg))} (tls, kubecfg) = Just $ do+ 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 $ newTLSAndAuth parsedAuth+ where lookupOrThrow k = Map.lookup k cfg+ & maybe (throwM $ OIDCAuthMissingInformation $ Text.unpack k) pure+ newTLSAndAuth auth = (tls, addAuthMethod kubecfg auth)+cachedOIDCAuth _ _ _ = Nothing++parseOIDCAuthInfo :: Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)+parseOIDCAuthInfo authInfo = do+ eitherTLSParams <- parseCA authInfo+ idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" authInfo+ refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" authInfo++#if MIN_VERSION_hoauth2(2,3,0)+ redirectUri <- case Map.lookup "redirect-uri" authInfo of+ Nothing -> throwM $ OIDCAuthMissingInformation "redirect-uri"+ Just raw -> case parseURI laxURIParserOptions $ encodeUtf8 raw of+ Left err -> throwM $ OIDCAuthMissingInformation ("Couldn't parse redirect URI: " <> show err)+ Right x -> return x+#endif++ 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 authInfo+ & maybeToRight (OIDCAuthMissingInformation $ Text.unpack k)++parseCA :: Map Text Text -> IO (Either ParseCertException TLS.ClientParams)+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 tlsParams authInfo = do+ caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" authInfo+ Just $ do+ caText <- BS.readFile caFile+ return $ updateClientParams tlsParams caText++parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))+parseCAData tlsParams authInfo = do+ caBase64 <- Map.lookup "idp-certificate-authority-data" authInfo+ Just $ pure $ do+ caText <- B64.decode (Text.encodeUtf8 caBase64)+ & mapLeft Base64ParsingFailed+ updateClientParams tlsParams caText
+ src/Kubernetes/Client/Auth/Token.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module Kubernetes.Client.Auth.Token where++import Kubernetes.Client.Auth.Internal.Types+import Kubernetes.Client.KubeConfig ( AuthInfo(..) )+import Kubernetes.OpenAPI.Core ( AnyAuthMethod(..)+ , KubernetesClientConfig(..)+ )+import Kubernetes.OpenAPI.Model ( AuthApiKeyBearerToken(..) )++import qualified Data.Text as T++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ( (<>) )+#endif+++-- |Detects if token is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'AuthApiKeyBearerToken'+tokenAuth :: DetectAuth+tokenAuth auth (tlsParams, cfg) = do+ t <- token auth+ return $ return (tlsParams, setTokenAuth t cfg)++-- |Configures the 'KubernetesClientConfig' to use token authentication.+setTokenAuth+ :: T.Text -- ^Authentication token+ -> KubernetesClientConfig+ -> KubernetesClientConfig+setTokenAuth t kcfg = kcfg+ { configAuthMethods = [AnyAuthMethod (AuthApiKeyBearerToken $ "Bearer " <> t)]+ }
+ src/Kubernetes/Client/Auth/TokenFile.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+module Kubernetes.Client.Auth.TokenFile where++import Control.Concurrent.STM+import Data.Function ( (&) )+import Data.Text ( Text )+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Time.Clock+import Kubernetes.Client.Auth.Internal.Types+import Kubernetes.Client.KubeConfig hiding ( token )+import Kubernetes.OpenAPI.Core+import qualified Lens.Micro as L++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ( (<>) )+#endif+++data TokenFileAuth = TokenFileAuth { token :: TVar(Maybe Text)+ , expiry :: TVar(Maybe UTCTime)+ , file :: FilePath+ , period :: NominalDiffTime+ }++instance AuthMethod TokenFileAuth where+ applyAuthMethod _ tokenFile req = do+ t <- getToken tokenFile+ pure+ $ req+ `setHeader` toHeader ("authorization", "Bearer " <> t)+ & L.set rAuthTypesL []++-- |Detects if token-file is specified in AuthConfig.+tokenFileAuth :: DetectAuth+tokenFileAuth auth (tlsParams, cfg) = do+ file <- tokenFile auth+ return $ do+ c <- setTokenFileAuth file cfg+ return (tlsParams, c)++-- |Configures the 'KubernetesClientConfig' to use TokenFile authentication.+setTokenFileAuth+ :: FilePath -> KubernetesClientConfig -> IO KubernetesClientConfig+setTokenFileAuth f kcfg = atomically $ do+ t <- newTVar (Nothing :: Maybe Text)+ e <- newTVar (Nothing :: Maybe UTCTime)+ return kcfg+ { configAuthMethods =+ [ AnyAuthMethod+ (TokenFileAuth { token = t, expiry = e, file = f, period = 60 })+ ]+ }++getToken :: TokenFileAuth -> IO Text+getToken auth = getCurrentToken auth >>= maybe (reloadToken auth) return++getCurrentToken :: TokenFileAuth -> IO (Maybe Text)+getCurrentToken TokenFileAuth { token, expiry } = do+ now <- getCurrentTime+ maybeExpiry <- readTVarIO expiry+ maybeToken <- readTVarIO token+ return $ do+ e <- maybeExpiry+ if e > now then maybeToken else Nothing++reloadToken :: TokenFileAuth -> IO Text+reloadToken TokenFileAuth { token, expiry, file, period } = do+ content <- T.readFile file+ let t = T.strip content+ now <- getCurrentTime+ atomically $ do+ writeTVar token (Just t)+ writeTVar expiry (Just (addUTCTime period now))+ return t
+ src/Kubernetes/Client/Config.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}++module Kubernetes.Client.Config+ ( KubeConfigSource(..)+ , addCACertData+ , addCACertFile+ , applyAuthSettings+ , clientHooksL+ , defaultTLSClientParams+ , disableServerCertValidation+ , disableServerNameValidation+ , disableValidateAuthMethods+ , loadPEMCerts+ , mkInClusterClientConfig+ , mkKubeClientConfig+ , newManager+ , onCertificateRequestL+ , onServerCertificateL+ , parsePEMCerts+ , serviceAccountDir+ , setCAStore+ , setClientCert+ , setMasterURI+ , setTokenAuth+ , tlsValidation+ )+where++import qualified Kubernetes.OpenAPI.Core as K++import Control.Applicative ( (<|>) )+import Control.Exception.Safe ( MonadThrow+ , throwM+ )+import Control.Monad.IO.Class ( MonadIO+ , liftIO+ )+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Lazy as LazyB+import Data.Either.Combinators+import Data.Function ( (&) )+import Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Yaml+import Kubernetes.Client.Auth.Basic+import Kubernetes.Client.Auth.ClientCert+import Kubernetes.Client.Auth.GCP+import Kubernetes.Client.Auth.OIDC+import Kubernetes.Client.Auth.Token+import Kubernetes.Client.Auth.TokenFile+import Kubernetes.Client.Internal.TLSUtils+import Kubernetes.Client.KubeConfig+import Network.Connection ( TLSSettings(..) )+import qualified Network.HTTP.Client as NH+import Network.HTTP.Client.TLS ( mkManagerSettings )+import qualified Network.TLS as TLS+import System.Environment ( getEnv )+import System.FilePath++data KubeConfigSource = KubeConfigFile FilePath+ | KubeConfigCluster++{-|+ Creates 'NH.Manager' and 'K.KubernetesClientConfig' for a given+ 'KubeConfigSource'. It is recommended that multiple 'kubeClient' invocations+ across an application share an 'OIDCCache', this makes sure updation of OAuth+ token is synchronized across all the different clients being used.+-}+mkKubeClientConfig+ :: OIDCCache -> KubeConfigSource -> IO (NH.Manager, K.KubernetesClientConfig)+mkKubeClientConfig oidcCache (KubeConfigFile f) = do+ kubeConfig <- decodeFileThrow f+ masterURI <-+ server+ <$> getCluster kubeConfig+ & either (const $ pure "localhost:8080") return+ tlsParams <- configureTLSParams kubeConfig (takeDirectory f)+ clientConfig <- K.newConfig & fmap (setMasterURI masterURI)+ (tlsParamsWithAuth, clientConfigWithAuth) <- case getAuthInfo kubeConfig of+ Left _ -> return (tlsParams, clientConfig)+ Right (_, auth) ->+ applyAuthSettings oidcCache auth (tlsParams, clientConfig)+ mgr <- newManager tlsParamsWithAuth+ return (mgr, clientConfigWithAuth)+mkKubeClientConfig _ KubeConfigCluster = mkInClusterClientConfig++-- |Creates 'NH.Manager' and 'K.KubernetesClientConfig' assuming it is being executed in a pod+mkInClusterClientConfig+ :: (MonadIO m, MonadThrow m) => m (NH.Manager, K.KubernetesClientConfig)+mkInClusterClientConfig = do+ caStore <- loadPEMCerts $ serviceAccountDir ++ "/ca.crt"+ defTlsParams <- liftIO defaultTLSClientParams+ mgr <- liftIO . newManager . setCAStore caStore $ disableServerNameValidation+ defTlsParams+ host <- liftIO $ getEnv "KUBERNETES_SERVICE_HOST"+ port <- liftIO $ getEnv "KUBERNETES_SERVICE_PORT"+ cfg <- setMasterURI (T.pack $ "https://" ++ host ++ ":" ++ port) <$> liftIO+ (K.newConfig >>= setTokenFileAuth (serviceAccountDir ++ "/token"))+ return (mgr, cfg)++-- |Sets the master URI in the 'K.KubernetesClientConfig'.+setMasterURI+ :: T.Text -- ^ Master URI+ -> K.KubernetesClientConfig+ -> K.KubernetesClientConfig+setMasterURI masterURI kcfg =+ kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) masterURI }++-- |Creates a 'NH.Manager' that can handle TLS.+newManager :: TLS.ClientParams -> IO NH.Manager+newManager cp = NH.newManager (mkManagerSettings (TLSSettings cp) Nothing)++serviceAccountDir :: FilePath+serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount"++configureTLSParams :: Config -> FilePath -> IO TLS.ClientParams+configureTLSParams cfg dir = do+ defaultTLS <- defaultTLSClientParams+ withCACertData <- addCACertData cfg defaultTLS+ withCACertFile <- addCACertFile cfg dir withCACertData+ return $ tlsValidation cfg withCACertFile++tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams+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 tlsParams =+ let+ eitherCertText =+ getCluster cfg+ & (>>= (maybeToRight "cert data not provided" . certificateAuthorityData+ )+ )+ in case eitherCertText of+ Left _ -> pure tlsParams+ Right certBase64 -> do+ certText <-+ B64.decode (T.encodeUtf8 certBase64)+ & either (throwM . Base64ParsingFailed) pure+ updateClientParams tlsParams certText & either throwM return++addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams+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 tlsParams certText & fromRight tlsParams++applyAuthSettings+ :: OIDCCache+ -> AuthInfo+ -> (TLS.ClientParams, K.KubernetesClientConfig)+ -> IO (TLS.ClientParams, K.KubernetesClientConfig)+applyAuthSettings oidcCache auth input =+ fromMaybe (pure input)+ $ clientCertFileAuth auth input+ <|> clientCertDataAuth auth input+ <|> tokenAuth auth input+ <|> tokenFileAuth auth input+ <|> gcpAuth auth input+ <|> cachedOIDCAuth oidcCache auth input+ <|> basicAuth auth input
+ src/Kubernetes/Client/Internal/TLSUtils.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}+module Kubernetes.Client.Internal.TLSUtils where++import Control.Exception.Safe (Exception, MonadThrow, throwM)+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.PEM (pemContent, pemParseBS)+import Data.X509 (SignedCertificate, decodeSignedCertificate)+import Data.X509.CertificateStore (CertificateStore, makeCertificateStore)+import Lens.Micro ((&), (.~), Lens', lens, set)+import Network.TLS (Credential, credentialLoadX509FromMemory, defaultParamsClient)+import System.X509 (getSystemCertificateStore)++import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as B64+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509+import qualified Network.TLS as TLS+import qualified Network.TLS.Extra as TLS++-- |Default TLS settings using the system CA store.+defaultTLSClientParams :: IO TLS.ClientParams+defaultTLSClientParams = do+ let defParams = defaultParamsClient "" ""+ systemCAStore <- getSystemCertificateStore+ return defParams+ { TLS.clientSupported = def+ { TLS.supportedCiphers = TLS.ciphersuite_strong+ }+ , TLS.clientShared = (TLS.clientShared defParams)+ { TLS.sharedCAStore = systemCAStore+ }+ }++-- |Parses a PEM-encoded @ByteString@ into a list of certificates.+parsePEMCerts :: B.ByteString -> Either ParseCertException [SignedCertificate]+parsePEMCerts pemBS = do+ pems <- pemParseBS pemBS+ & mapLeft PEMParsingFailed+ return $ rights $ map (decodeSignedCertificate . pemContent) pems++-- | 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))++-- |Use a custom CA store.+setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams+setCAStore certs tlsParams =+ tlsParams & clientSharedL . sharedCAStoreL .~ makeCertificateStore certs++-- |Use a client cert for authentication.+setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams+setClientCert cred = set onCertificateRequestL (\_ -> return $ Just cred)++clientHooksL :: Lens' TLS.ClientParams TLS.ClientHooks+clientHooksL = lens TLS.clientHooks (\cp ch -> cp { TLS.clientHooks = ch })++onServerCertificateL :: Lens' TLS.ClientParams (CertificateStore -> TLS.ValidationCache -> X509.ServiceID -> X509.CertificateChain -> IO [X509.FailedReason])+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+disableServerNameValidation =+ set onServerCertificateL (X509.validate X509.HashSHA256 def (def { X509.checkFQHN = False }))++-- |Insecure mode. The client will not validate the server cert at all.+disableServerCertValidation :: TLS.ClientParams -> TLS.ClientParams+disableServerCertValidation = set onServerCertificateL (\_ _ _ _ -> return [])++onCertificateRequestL :: Lens' TLS.ClientParams (([TLS.CertificateType], Maybe [TLS.HashAndSignatureAlgorithm], [X509.DistinguishedName]) -> IO (Maybe (X509.CertificateChain, TLS.PrivKey)))+onCertificateRequestL =+ clientHooksL . lens TLS.onCertificateRequest (\ch ocr -> ch { TLS.onCertificateRequest = ocr })++-- |Loads certificates from a PEM-encoded file.+loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]+loadPEMCerts pemFile = do+ liftIO (B.readFile pemFile)+ >>= (either throwM return)+ . parsePEMCerts++-- |Loads Base64 encoded certificate and private key+loadB64EncodedCert :: (MonadThrow m) => B.ByteString -> B.ByteString -> m Credential+loadB64EncodedCert certB64 keyB64 = either throwM pure $ do+ certText <- B64.decode certB64+ & mapLeft Base64ParsingFailed+ keyText <- B64.decode keyB64+ & mapLeft Base64ParsingFailed+ credentialLoadX509FromMemory certText keyText+ & mapLeft FailedToLoadCredential++data ParseCertException = PEMParsingFailed String+ | Base64ParsingFailed String+ | FailedToLoadCredential String+ deriving Show++instance Exception ParseCertException
+ src/Kubernetes/Client/KubeConfig.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}++{-|+Module : Kubernetes.KubeConfig+Description : Data model for the kubeconfig.++This module contains the definition of the data model of the kubeconfig.++The official definition of the kubeconfig is defined in https://github.com/kubernetes/client-go/blob/master/tools/clientcmd/api/v1/types.go.++This is a mostly straightforward translation into Haskell, with 'FromJSON' and 'ToJSON' instances defined.+-}+module Kubernetes.Client.KubeConfig where++import Data.Aeson (FromJSON (..), Options, ToJSON (..),+ camelTo2, defaultOptions,+ fieldLabelModifier, genericParseJSON,+ genericToJSON, object, omitNothingFields,+ withObject, (.:), (.=))+import qualified Data.Map as Map+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import Data.Typeable+import GHC.Generics+import GHC.TypeLits++#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as A+#endif++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif+++camelToWithOverrides :: Char -> Map.Map String String -> Options+camelToWithOverrides c overrides = defaultOptions+ { fieldLabelModifier = modifier+ , omitNothingFields = True+ }+ where modifier s = Map.findWithDefault (camelTo2 c s) s overrides++-- |Represents a kubeconfig.+data Config = Config+ { kind :: Maybe Text+ , apiVersion :: Maybe Text+ , preferences :: Maybe Preferences+ , clusters :: [NamedEntity Cluster "cluster"]+ , authInfos :: [NamedEntity AuthInfo "user"]+ , contexts :: [NamedEntity Context "context"]+ , currentContext :: Text+ } deriving (Eq, Generic, Show)++configJSONOptions :: Options+configJSONOptions = camelToWithOverrides+ '-'+ (Map.fromList [("apiVersion", "apiVersion"), ("authInfos", "users")])++instance ToJSON Config where+ toJSON = genericToJSON configJSONOptions++instance FromJSON Config where+ parseJSON = genericParseJSON configJSONOptions++newtype Preferences = Preferences+ { colors :: Maybe Bool+ } deriving (Eq, Generic, Show)++instance ToJSON Preferences where+ toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty++instance FromJSON Preferences where+ parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty++data Cluster = Cluster+ { server :: Text+ , insecureSkipTLSVerify :: Maybe Bool+ , certificateAuthority :: Maybe Text+ , certificateAuthorityData :: Maybe Text+ } deriving (Eq, Generic, Show, Typeable)++instance ToJSON Cluster where+ toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty++instance FromJSON Cluster where+ parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty++data NamedEntity a (typeKey :: Symbol) = NamedEntity+ { name :: Text+ , entity :: a } deriving (Eq, Generic, Show)++instance (FromJSON a, Typeable a, KnownSymbol s) =>+ FromJSON (NamedEntity a s) where+ parseJSON = withObject ("Named" <> (show $ typeOf (undefined :: a))) $ \v ->+#if MIN_VERSION_aeson(2,0,0)+ NamedEntity <$> v .: "name" <*> v .: A.fromString (symbolVal (Proxy :: Proxy s))+#else+ NamedEntity <$> v .: "name" <*> v .: T.pack (symbolVal (Proxy :: Proxy s))+#endif++instance (ToJSON a, KnownSymbol s) =>+ ToJSON (NamedEntity a s) where+ toJSON (NamedEntity {..}) = object+#if MIN_VERSION_aeson(2,0,0)+ ["name" .= toJSON name, A.fromString (symbolVal (Proxy :: Proxy s)) .= toJSON entity]+#else+ ["name" .= toJSON name, T.pack (symbolVal (Proxy :: Proxy s)) .= toJSON entity]+#endif++toMap :: [NamedEntity a s] -> Map.Map Text a+toMap = Map.fromList . fmap (\NamedEntity {..} -> (name, entity))++data AuthInfo = AuthInfo+ { clientCertificate :: Maybe FilePath+ , clientCertificateData :: Maybe Text+ , clientKey :: Maybe FilePath+ , clientKeyData :: Maybe Text+ , token :: Maybe Text+ , tokenFile :: Maybe FilePath+ , impersonate :: Maybe Text+ , impersonateGroups :: Maybe [Text]+ , impersonateUserExtra :: Maybe (Map.Map Text [Text])+ , username :: Maybe Text+ , password :: Maybe Text+ , authProvider :: Maybe AuthProviderConfig+ } deriving (Eq, Generic, Show, Typeable)++authInfoJSONOptions :: Options+authInfoJSONOptions = camelToWithOverrides+ '-'+ ( Map.fromList+ [ ("tokenFile" , "tokenFile")+ , ("impersonate" , "as")+ , ("impersonateGroups" , "as-groups")+ , ("impersonateUserExtra", "as-user-extra")+ ]+ )++instance ToJSON AuthInfo where+ toJSON = genericToJSON authInfoJSONOptions++instance FromJSON AuthInfo where+ parseJSON = genericParseJSON authInfoJSONOptions++data Context = Context+ { cluster :: Text+ , authInfo :: Text+ , namespace :: Maybe Text+ } deriving (Eq, Generic, Show, Typeable)++contextJSONOptions :: Options+contextJSONOptions =+ camelToWithOverrides '-' (Map.fromList [("authInfo", "user")])++instance ToJSON Context where+ toJSON = genericToJSON contextJSONOptions++instance FromJSON Context where+ parseJSON = genericParseJSON contextJSONOptions++data AuthProviderConfig = AuthProviderConfig+ { name :: Text+ , config :: Maybe (Map.Map Text Text)+ } deriving (Eq, Generic, Show)++instance ToJSON AuthProviderConfig where+ toJSON = genericToJSON $ camelToWithOverrides '-' Map.empty++instance FromJSON AuthProviderConfig where+ parseJSON = genericParseJSON $ camelToWithOverrides '-' Map.empty++-- |Returns the currently active context.+getContext :: Config -> Either String Context+getContext Config {..} =+ let maybeContext = Map.lookup currentContext (toMap contexts)+ in case maybeContext of+ Just ctx -> Right ctx+ Nothing -> Left ("No context named " <> T.unpack currentContext)++-- |Returns the currently active user.+getAuthInfo :: Config -> Either String (Text, AuthInfo)+getAuthInfo cfg@Config {..} = do+ Context {..} <- getContext cfg+ let maybeAuth = Map.lookup authInfo (toMap authInfos)+ case maybeAuth of+ Just auth -> Right (authInfo, auth)+ Nothing -> Left ("No user named " <> T.unpack authInfo)++-- |Returns the currently active cluster.+getCluster :: Config -> Either String Cluster+getCluster cfg@Config {clusters=clusters} = do+ Context {cluster=clusterName} <- getContext cfg+ let maybeCluster = Map.lookup clusterName (toMap clusters)+ case maybeCluster of+ Just cluster -> Right cluster+ Nothing -> Left ("No cluster named " <> T.unpack clusterName)
+ src/Kubernetes/Client/Watch.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Kubernetes.Client.Watch+ ( WatchEvent+ , eventType+ , eventObject+ , dispatchWatch+ ) where++import Control.Monad+import Control.Monad.Trans (lift)+import Data.Aeson+import qualified Data.ByteString as B+import qualified Data.Text as T+import Kubernetes.OpenAPI.Client+import Kubernetes.OpenAPI.Core+import Kubernetes.OpenAPI.MimeTypes+import Kubernetes.OpenAPI.Model (Watch(..))+import Network.HTTP.Client++#if MIN_VERSION_streaming_bytestring(0,1,7)+import qualified Streaming.ByteString.Char8 as Q+type ByteStream = Q.ByteStream+#else+import qualified Data.ByteString.Streaming.Char8 as Q+type ByteStream = Q.ByteString+#endif+++data WatchEvent a = WatchEvent+ { _eventType :: T.Text+ , _eventObject :: a+ } deriving (Eq, Show)++instance FromJSON a => FromJSON (WatchEvent a) where+ parseJSON (Object x) = WatchEvent <$> x .: "type" <*> x .: "object"+ parseJSON _ = fail "Expected an object"++instance ToJSON a => ToJSON (WatchEvent a) where+ toJSON x = object+ [ "type" .= _eventType x+ , "object" .= _eventObject x+ ]++-- | Type of the 'WatchEvent'.+eventType :: WatchEvent a -> T.Text+eventType = _eventType++-- | Object within the 'WatchEvent'.+eventObject :: WatchEvent a -> a+eventObject = _eventObject++{-| Dispatch a request setting watch to true. Takes a consumer function+which consumes the 'Q.ByteString' stream. Following is a simple example which+just streams to stdout. First some setup - this assumes kubernetes is accessible+at http://localhost:8001, e.g. after running /kubectl proxy/:++@+import qualified Data.ByteString.Streaming.Char8 as Q++manager <- newManager defaultManagerSettings+defaultConfig <- newConfig+config = defaultConfig { configHost = "http://localhost:8001", configValidateAuthMethods = False }+request = listEndpointsForAllNamespaces (Accept MimeJSON)+@++Launching 'dispatchWatch' with the above we get a stream of endpoints data:++@+ > dispatchWatch manager config request Q.stdout+ {"type":\"ADDED\","object":{"kind":\"Endpoints\","apiVersion":"v1","metadata":{"name":"heapster" ....+@+-}+dispatchWatch ::+ (HasOptionalParam req Watch, MimeType accept, MimeType contentType) =>+ Manager+ -> KubernetesClientConfig+ -> KubernetesRequest req contentType resp accept+ -> (ByteStream IO () -> IO a)+ -> IO a+dispatchWatch manager config request apply = do+ let watchRequest = applyOptionalParam request (Watch True)+ (InitRequest req) <- _toInitRequest config watchRequest+ withHTTP req manager $ \resp -> apply $ responseBody resp++withHTTP ::+ Request+ -> Manager+ -> (Response (ByteStream IO ()) -> IO a)+ -> IO a+withHTTP request manager f = withResponse request manager f'+ where+ f' resp = do+ let p = (from . brRead . responseBody) resp+ f (resp {responseBody = p})+ from :: IO B.ByteString -> ByteStream IO ()+ from io = go+ where+ go = do+ bs <- lift io+ unless (B.null bs) $ do+ Q.chunk bs+ go
+ src/Kubernetes/Data/K8sJSONPath.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module Kubernetes.Data.K8sJSONPath where++import Control.Applicative ((<|>))+import Data.Aeson+import Data.Aeson.Text+import Data.Bifunctor+import Data.JSONPath+import Data.Text as Text+import Data.Text.Lazy (toStrict)++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif++#if MIN_VERSION_jsonpath(0,3,0)+import Data.Void (Void)+import Text.Megaparsec ( Parsec, eof, runParser, some, takeWhile1P )+import Text.Megaparsec.Char ( char )+type Parser a = Parsec Void Text a+#else+import Data.Attoparsec.Text ( Parser, char, endOfInput, many1, parseOnly, takeWhile1 )+#endif+++data K8sPathElement = PlainText Text+ | JSONPath [JSONPathElement]+ deriving (Show, Eq)++parseK8sJSONPath :: Text -> Either String [K8sPathElement]+#if MIN_VERSION_jsonpath(0,3,0)+parseK8sJSONPath = first show . runParser (k8sJSONPath <* eof) "nothing"+#else+parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput)+#endif++k8sJSONPath :: Parser [K8sPathElement]+#if MIN_VERSION_jsonpath(0,3,0)+k8sJSONPath = some pathElementParser+#else+k8sJSONPath = many1 pathElementParser+#endif++pathElementParser :: Parser K8sPathElement+pathElementParser = jsonpathParser <|> plainTextParser++plainTextParser :: Parser K8sPathElement+#if MIN_VERSION_jsonpath(0,3,0)+plainTextParser = PlainText <$> takeWhile1P (Just "non_open_brace") (/= '{')+#else+plainTextParser = PlainText <$> takeWhile1 (/= '{')+#endif++jsonpathParser :: Parser K8sPathElement+#if MIN_VERSION_jsonpath(0,3,0)+jsonpathParser = JSONPath <$> (char '{' *> jsonPath (char '}') <* char '}')+#else+jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}')+#endif++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 String Text+runPathElement (PlainText t) _ = pure t+runPathElement (JSONPath p) v = encodeResult $ executeJSONPath p v++#if MIN_VERSION_jsonpath(0,3,0)+encodeResult :: [Value] -> Either String Text+encodeResult vals = return $ (intercalate " " $ Prelude.map jsonToText vals)+#else+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 err+#endif++jsonToText :: Value -> Text+jsonToText (String t) = t+jsonToText x = toStrict $ encodeToLazyText x
+ test/Kubernetes/Client/Auth/BasicSpec.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}+module Kubernetes.Client.Auth.BasicSpec where++import Test.Hspec+import Data.Typeable+import Data.Maybe ( isJust+ , isNothing+ , fromJust+ )+import Kubernetes.Client.Auth.Basic+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI+import Network.TLS ( defaultParamsClient )++emptyAuthInfo :: AuthInfo+emptyAuthInfo = AuthInfo Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++spec :: Spec+spec = do+ let testTLSParams = defaultParamsClient "" ""+ testUsername = Just "testuser"+ testPassword = Just "testpassword"+ basicAuthInfo = emptyAuthInfo { username = testUsername, password = testPassword}+ describe "Basic Authentication" $ do+ it "should return Nothing if the username an d/or password is not provided" $ do+ testConfig <- newConfig+ isNothing (basicAuth emptyAuthInfo (testTLSParams, testConfig))+ `shouldBe` True+ isNothing (basicAuth emptyAuthInfo { username = testUsername} (testTLSParams, testConfig))+ `shouldBe` True+ isNothing (basicAuth emptyAuthInfo { password = testUsername} (testTLSParams, testConfig))+ `shouldBe` True++ context "when username and password are provided" $ do+ it "should return a configuration provider io" $ do+ testConfig <- newConfig+ isJust (basicAuth basicAuthInfo (testTLSParams, testConfig)) `shouldBe` True+ + it "should configure basic auth" $ do+ testConfig <- newConfig+ (_, (KubernetesClientConfig { configAuthMethods = AnyAuthMethod (a) : as })) <- + fromJust $ basicAuth basicAuthInfo (testTLSParams, testConfig)+ null as `shouldBe` True+ isJust (cast a :: Maybe BasicAuth) `shouldBe` True
+ test/Kubernetes/Client/Auth/ClientCertSpec.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Kubernetes.Client.Auth.ClientCertSpec where++import Test.Hspec++import Data.FileEmbed+import Data.Maybe (isJust, isNothing)+import Data.Text.Encoding (decodeUtf8)+import Kubernetes.Client.Auth.ClientCert+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI+import Network.TLS (defaultParamsClient)++import qualified Data.ByteString.Base64 as B64++emptyAuthInfo :: AuthInfo+emptyAuthInfo = AuthInfo Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++spec :: Spec+spec = do+ let inputTLSParams = defaultParamsClient "" ""+ certFilePath = "test/testdata/certs/certificate.pem"+ keyFilePath = "test/testdata/certs/private-key.pem"+ base64EncodedCert = decodeUtf8 $ B64.encode $(embedFile $ "test/testdata/certs/certificate.pem")+ base64EncodedKey = decodeUtf8 $ B64.encode $(embedFile $ "test/testdata/certs/private-key.pem")+ describe "ClientCert File Authentication" $ do+ context "when cert and key file are provided in AuthInfo" $ do+ let auth = emptyAuthInfo { clientCertificate = Just $ certFilePath+ , clientKey = Just $ keyFilePath }+ it "should detect client cert file auth" $ do+ inputConfig <- newConfig+ isJust (clientCertFileAuth auth (inputTLSParams, inputConfig)) `shouldBe` True++ it "should disable validate auth method" $ do+ inputConfig <- newConfig+ case clientCertFileAuth auth (inputTLSParams, inputConfig) of+ Nothing -> expectationFailure "expected to detect client cert file auth"+ Just detectedAuth -> do+ (_, cfg) <- detectedAuth+ configValidateAuthMethods cfg `shouldBe` False++ it "should return Nothing if the cert file is not provided" $ do+ let auth = emptyAuthInfo {clientKey = Just "/some/file"}+ inputConfig <- newConfig+ isNothing (clientCertFileAuth auth (inputTLSParams, inputConfig)) `shouldBe` True++ it "should return Nothing if the key file is not provided" $ do+ let auth = emptyAuthInfo {clientCertificate = Just "/some/file"}+ inputConfig <- newConfig+ isNothing (clientCertFileAuth auth (undefined, inputConfig)) `shouldBe` True++ describe "ClientCert Data Authentication" $ do+ context "when cert and key file are provided in AuthInfo" $ do+ let auth = emptyAuthInfo { clientCertificateData = Just base64EncodedCert+ , clientKeyData = Just base64EncodedKey}+ it "should detect client cert data auth" $ do+ inputConfig <- newConfig+ isJust (clientCertDataAuth auth (inputTLSParams, inputConfig)) `shouldBe` True++ it "should disable validate auth method" $ do+ inputConfig <- newConfig+ case clientCertDataAuth auth (inputTLSParams, inputConfig) of+ Nothing -> expectationFailure "expected to detect client cert file auth"+ Just detectedAuth -> do+ (_, cfg) <- detectedAuth+ configValidateAuthMethods cfg `shouldBe` False++ it "should return Nothing if the cert file is not provided" $ do+ let auth = emptyAuthInfo {clientKeyData = Just base64EncodedKey}+ inputConfig <- newConfig+ isNothing (clientCertDataAuth auth (inputTLSParams, inputConfig)) `shouldBe` True++ it "should return Nothing if the key file is not provided" $ do+ let auth = emptyAuthInfo {clientCertificateData = Just base64EncodedCert}+ inputConfig <- newConfig+ isNothing (clientCertDataAuth auth (inputTLSParams, inputConfig)) `shouldBe` True
+ test/Kubernetes/Client/Auth/TokenFileSpec.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}+module Kubernetes.Client.Auth.TokenFileSpec where++import Test.Hspec+import Control.Concurrent+import Data.Function ( (&) )+import Data.FileEmbed+import Data.Typeable+import Data.Maybe ( isJust+ , isNothing+ )+import Data.Text ( Text )+import Data.Text.Encoding ( decodeUtf8 )+import Kubernetes.Client.Auth.TokenFile+import Kubernetes.Client.KubeConfig+import Kubernetes.OpenAPI+import Kubernetes.OpenAPI.Core ( _applyAuthMethods+ , _mkRequest+ )+import Network.TLS ( defaultParamsClient )++import qualified Data.ByteString.Base64 as B64++emptyAuthInfo :: AuthInfo+emptyAuthInfo = AuthInfo Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++spec :: Spec+spec = do+ let testTLSParams = defaultParamsClient "" ""+ token1FilePath = "test/testdata/tokens/token1"+ token2FilePath = "test/testdata/tokens/token2"+ describe "TokenFile Authentication" $ do+ it "should return Nothing if the file is not provided" $ do+ testConfig <- newConfig+ isNothing (tokenFileAuth emptyAuthInfo (testTLSParams, testConfig))+ `shouldBe` True++ it "should reload token after expiry" $ do+ let auth = emptyAuthInfo { tokenFile = Just token1FilePath }+ testConfig <- newConfig+ case tokenFileAuth auth (testTLSParams, testConfig) of+ Nothing -> expectationFailure "expected to detect TokenFile auth"+ Just detectedAuth -> do+ (_, cfg@(KubernetesClientConfig { configAuthMethods = AnyAuthMethod (a) : as })) <-+ detectedAuth+ case cast a :: Maybe TokenFileAuth of+ Nothing -> expectationFailure "expected to be TokenFile auth"+ Just tf -> do+ let tfWithShorterPeriod = tf { period = 5 }+ x <- getToken tfWithShorterPeriod+ x `shouldBe` ("token1" :: Text)++ let tfWithShorterPeriod' =+ tfWithShorterPeriod { file = token2FilePath }+ threadDelay 2000000 -- sleep 2 seconds+ x <- getToken tfWithShorterPeriod'+ x `shouldBe` ("token1" :: Text)++ threadDelay 3000000 -- sleep 3 seconds+ x <- getToken tfWithShorterPeriod'+ x `shouldBe` ("token2" :: Text)+
+ test/Kubernetes/Client/KubeConfigSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Kubernetes.Client.KubeConfigSpec where++import Data.Aeson (decode, encode, parseJSON,+ toJSON)+import Data.Either (fromRight)+import Data.Yaml (decodeFileEither)+import Kubernetes.Client.KubeConfig (AuthInfo (..), Cluster (..),+ Config, Context (..),+ getAuthInfo, getCluster,+ getContext)+import Test.Hspec++spec :: Spec+spec = do+ let getConfig :: IO Config+ getConfig = fromRight (error "Couldn't decode config") <$> decodeFileEither "test/testdata/kubeconfig.yaml"++ describe "FromJSON and ToJSON instances" $ do+ it "roundtrips successfully" $ do+ config <- getConfig+ decode (encode (toJSON config)) `shouldBe` Just config++ describe "getContext" $ do+ it "returns the correct context" $ do+ config <- getConfig+ getContext config `shouldBe` (Right (Context "cluster-aaa" "user-aaa" Nothing))++ describe "getCluster" $ do+ it "returns the correct cluster" $ do+ config <- getConfig+ server <$> getCluster config `shouldBe` (Right "https://aaa.example.com")++ describe "getAuthInfo" $ do+ it "returns the correct authInfo" $ do+ config <- getConfig+ fst <$> getAuthInfo config `shouldBe` (Right "user-aaa")
+ test/Kubernetes/Data/K8sJSONPathSpec.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++module Kubernetes.Data.K8sJSONPathSpec where++import Test.Hspec++import Kubernetes.Data.K8sJSONPath+import Data.Text+import Data.JSONPath+import Data.Aeson++#if MIN_VERSION_jsonpath(0,3,0)+import Data.Void (Void)+import Test.Hspec.Megaparsec+import Text.Megaparsec (runParser)+import Text.Megaparsec.Error (ParseErrorBundle)++(~>) :: Text -> Parser [K8sPathElement] -> Either (ParseErrorBundle Text Void) [K8sPathElement]+(~>) text parser = runParser parser "nothing" text+#else+import Test.Hspec.Attoparsec+#endif+++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"
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/testdata/certs/certificate.pem view
@@ -0,0 +1,17 @@+-----BEGIN CERTIFICATE-----+MIICsDCCAZgCCQCyRyEmfEJy9jANBgkqhkiG9w0BAQUFADAZMRcwFQYDVQQDDA5z+ZWxmLXNpZ25lZC1jYTAgFw0xOTA3MjMyMTUwMThaGA8yMTI5MDEyNzIxNTAxOFow+GTEXMBUGA1UEAwwOc2VsZi1zaWduZWQtY2EwggEiMA0GCSqGSIb3DQEBAQUAA4IB+DwAwggEKAoIBAQDbxmgIae5FUbLu76NmsUbbo7D0Bk6cUpII/lhREQptoL4YkOo3+MnLVQ6bkTG1hdWkN2A+eDHDJklNR6zzrCAA395lKhCZWSxq9o3AFWFMI8TWSptxL+X/fl/vDh1pH4u/nGjKC1fSf2F9nvxywIgd0PNttWG8bNMzl3gZULfg0TWKvSX6Ln+9SLA9Whsr3WMQno46JiKauB7z1+9Qc+26uEOi6kpc2mYIDTCUO5+umUEsV+seQS++TUe9lMQCLuZVmnWoygbCx5+eXm//iYOBSz8Z5jpEOuA6mY9FJAUU3uoGR656NImZ+IBjgVSZBIDleq2V/lmdbjHy8GpQTMtButMorAgMBAAEwDQYJKoZIhvcNAQEFBQAD+ggEBALHSlOI+Ra6QWr5V3FQS2ypkddK19RZ3TxEvCt8Brt2uNBw6Oxw/qLq17xiB+C7bJV1SA9MNqdv1grk1kVil5aUeAGLIQtVD3C1/qiCgfP+HN1Fb0QnMcxJwESRmc+TDQoYEkZp/TqgggDbmJD6S91EpXs1QiAvNA5+9L8ikOrOJQeHkzFen9PXoSqkVTl+XPwOsCIzcBnuq+agt3pkiFcHtm348y4Yjv3kOimAhzanR96DH2DtTBCmDE/cYW7j+s5aOI/MKlrZxh2gFvgqBZMjVUv8bNuDAU+8prDH4YzsDFeGKD42lDvnL+XQ69xKE+oLBoM+xTo5QwQp0ZWW3srw47BKo=+-----END CERTIFICATE-----
+ test/testdata/certs/private-key.pem view
@@ -0,0 +1,27 @@+-----BEGIN RSA PRIVATE KEY-----+MIIEowIBAAKCAQEA28ZoCGnuRVGy7u+jZrFG26Ow9AZOnFKSCP5YUREKbaC+GJDq+NzJy1UOm5ExtYXVpDdgPngxwyZJTUes86wgAN/eZSoQmVksavaNwBVhTCPE1kqbc+S1/35f7w4daR+Lv5xoygtX0n9hfZ78csCIHdDzbbVhvGzTM5d4GVC34NE1ir0l+i+5/UiwPVobK91jEJ6OOiYimrge89fvUHPturhDoupKXNpmCA0wlDufrplBLFfrHkE+vk1HvZTEAi7mVZp1qMoGwsefnl5v/4mDgUs/GeY6RDrgOpmPRSQFFN7qBkeuejSJ+mSAY4FUmQSA5Xqtlf5ZnW4x8vBqUEzLQbrTKKwIDAQABAoIBACG0nRHlRSCmdf3F+DNdcCtT2ltXl/bplw3XTpDHSnjnP9DeKShFrEEd616advgy7WABCiaqgl8+iPFsM+68vT70ymEYFnIQYNAK3i2fRH5nwxmhjCtHhu4HMKlWDdaoeuNJFp0d/jsPRCFi96+6Vrop8GElUDwg53G5GJaokQf8dtsbg05Qv0C+BLMjYoXt+OCSYn0Jnzc3YLyn6pf+0Ubhb5X73+pSFcY0JindJzHo/c3k5255VOorimxSA9Kr0glYJ2MlOuWM7khZfWjJ+yJPEfa0hM/mPkR2WZ3Rif1Hb01BcrpjsNmQKFDKG+gumxL0CYzUlxOrVI5RO5+yC+wKw8FYkCgYEA/QSzpNxc+qtYj9lJL3p2sxN8cQNOhDOF3DdEZmwToPF2JQKqnDo0+5LDugNgUuOilVFYGxmLNC9RMB+PgOT7kHgZY99cZFuUCww85j2NIbdoATXFZvUdD+O2E9o4X4RQ4+WQTZZ01sfjxMa6Y+t5HC49wvwHwdY0SMA3w6jPkBer8CgYEA3l1q+yJObFV6rorCoeJIpLPGs1lQpXb0qgENmE6tnwYQ56mIuP0mLiSvqkISWwQyEiPjZ+g9O70adOLom/0l9ssIsE1bHk/k/391rzYsvXvHM/uuIFNd7yqYApBLXq3jiNZbfq+CeoWkymez0VOWzgIQxh2UHZ+5+qRSMDgV6hq55UCgYBr00ofcs2pAcZvHyFCO4VE+UYSRwOAAFNjx/ReIMny29M/te9JrW57Y6tHpVKyYFIUIiNTATLCnXuS75A/VNYkP+hpL5o9AMYrInoGBeS+g88E96sViWAj2Tm6AiBODFxQkq9JcVn/ghX98NbT6DCnos+ktRCymHXwQmOHq3xD9jijwKBgGX3KFQ5e0/dTY8Yuugu/bqiR8MwbJeTer2+Kjyy+yK0wWO5lfxd+PgH0pWcHpal4d/3nPrb4jJOiyHMGr3NkVo7N8LWdEYicWvSOPDT9+jDvaDUtBAWqmhVe8cRK76Ktl+1C9eRB6y0dIOo6JFVk25HL/8KEM9Tybj2txJm6L+yBnRAoGBAN3K6EhZ6eO0BorVNi8/5KaE8D0f3ZFEgUBEpVwiJLmL1hXbsiv2JyjE++dR+reScpl8NODycnnFzBzlIijB52CZWo+cxyFSvZxz3RrJZ8XaM/fg5MgNmcwLQ+zejmoH7LuYD4z/OaPzgupJZlRUZNADOqZ8alsxSIvOHkImUAT9Q2+-----END RSA PRIVATE KEY-----
+ test/testdata/kubeconfig.yaml view
@@ -0,0 +1,35 @@+apiVersion: v1+clusters:+- cluster:+ certificate-authority-data: fake-ca-data+ server: https://aaa.example.com+ name: cluster-aaa+- cluster:+ certificate-authority-data: fake-ca-data+ server: https://bbb.example.com+ name: cluster-bbb+contexts:+- context:+ cluster: cluster-aaa+ user: user-aaa+ name: aaa+- context:+ cluster: cluster-bbb+ user: user-bbb+ name: bbb+current-context: aaa+kind: Config+preferences: {}+users:+- name: user-aaa+ user:+ auth-provider:+ config:+ access-token: fake-token+ expiry: 2017-06-06 22:53:31+ expiry-key: '{.credential.token_expiry}'+ token-key: '{.credential.access_token}'+ name: gcp+- name: user-bbb+ user:+ token: fake-token
+ test/testdata/tokens/token1 view
@@ -0,0 +1,1 @@+token1
+ test/testdata/tokens/token2 view
@@ -0,0 +1,1 @@+token2