add Kubernetes.ClientHelper module and add usage in README

Author: Shimin Guo

kubernetes/README.md

@@ -6,192 +6,48 @@ Targeted swagger version: 2.0
 
 OpenAPI-Specification: https://github.com/OAI/OpenAPI-Specification/blob/master/versions/2.0.md
 
-## Installation
-
-Installation follows the standard approach to installing Stack-based projects.
-
-1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).
-2. To build the package, and generate the documentation (recommended):
-```
-stack haddock
-```
-which will generate docs for this lib in the `docs` folder.
-
-To generate the docs in the normal location (to enable hyperlinks to external libs), remove 
-```
-build:
-  haddock-arguments:
-    haddock-args:
-    - "--odir=./docs"
-```
-from the stack.yaml file and run `stack haddock` again.
-
-3. To run unit tests:
-```
-stack test
-```
-
-## Swagger-Codegen
-
-The code generator that produced this library, and which explains how
-to obtain and use the swagger-codegen cli tool lives at
-
-https://github.com/swagger-api/swagger-codegen
-
-The _language_ argument (`--lang`) passed to the cli tool used should be 
-
-```
-haskell-http-client
-```
-
-### Unsupported Swagger Features
-
-* Model Inheritance
-
-This is beta software; other cases may not be supported.
-
-### Codegen "additional properties" parameters
-
-These options allow some customization of the code generation process.
-
-**haskell-http-client additional properties:**
-
-| OPTION                          | DESCRIPTION                                                                                                                   | DEFAULT  | ACTUAL                                |
-| ------------------------------- | ----------------------------------------------------------------------------------------------------------------------------- | -------- | ------------------------------------- |
-| allowNonUniqueOperationIds      | allow *different* API modules to contain the same operationId. Each API must be imported qualified                            | false    | true    |
-| allowFromJsonNulls              | allow JSON Null during model decoding from JSON                                                                               | true     | true              |
-| allowToJsonNulls                | allow emitting JSON Null during model encoding to JSON                                                                        | false    | false                |
-| dateFormat                      | format string used to parse/render a date                                                                                     | %Y-%m-%d | %Y-%m-%d                      |
-| dateTimeFormat                  | format string used to parse/render a datetime. (Defaults to [formatISO8601Millis][1] when not provided)                       |          |                   |
-| generateEnums                   | Generate specific datatypes for swagger enums                                                                                 | true     | true                   |
-| generateFormUrlEncodedInstances | Generate FromForm/ToForm instances for models used by x-www-form-urlencoded operations (model fields must be primitive types) | true     | true |
-| generateLenses                  | Generate Lens optics for Models                                                                                               | true     | true                  |
-| generateModelConstructors       | Generate smart constructors (only supply required fields) for models                                                          | true     | true       |
-| inlineMimeTypes                 | Inline (hardcode) the content-type and accept parameters on operations, when there is only 1 option                           | false    | false                 |
-| modelDeriving                   | Additional classes to include in the deriving() clause of Models                                                              |          |                    |
-| strictFields                    | Add strictness annotations to all model fields                                                                                | true     | true                  |
-| useMonadLogger                  | Use the monad-logger package to provide logging (if instead false, use the katip logging package)                             | false    | false                |
-
-[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis
-
-An example setting _strictFields_ and _dateTimeFormat_:
-
-```
-java -jar swagger-codegen-cli.jar generate -i petstore.yaml -l haskell-http-client -o output/haskell-http-client -DstrictFields=true -DdateTimeFormat="%Y-%m-%dT%H:%M:%S%Q%z"
-```
-
-View the full list of Codegen "config option" parameters with the command:
-
-```
-java -jar swagger-codegen-cli.jar config-help -l haskell-http-client
-```
-
-## Usage Notes
-
-### Example SwaggerPetstore Haddock documentation 
-
-An example of the generated haddock documentation targeting the server http://petstore.swagger.io/ (SwaggerPetstore) can be found [here][2]
-
-[2]: https://hackage.haskell.org/package/swagger-petstore
-
-### Example SwaggerPetstore App
-
-An example application using the auto-generated haskell-http-client bindings for the server http://petstore.swagger.io/ can be found [here][3]
-
-[3]: https://github.com/swagger-api/swagger-codegen/tree/master/samples/client/petstore/haskell-http-client/example-app
-
-This library is intended to be imported qualified.
-
-### Modules
-
-| MODULE              | NOTES                                               |
-| ------------------- | --------------------------------------------------- |
-| Kubernetes.Client    | use the "dispatch" functions to send requests       |
-| Kubernetes.Core      | core funcions, config and request types             |
-| Kubernetes.API       | construct api requests                              |
-| Kubernetes.Model     | describes api models                                |
-| Kubernetes.MimeTypes | encoding/decoding MIME types (content-types/accept) |
-| Kubernetes.ModelLens | lenses for model fields                             |
-| Kubernetes.Logging   | logging functions and utils                         |
-
-
-### MimeTypes
-
-This library adds type safety around what swagger specifies as
-Produces and Consumes for each Operation (e.g. the list of MIME types an
-Operation can Produce (using 'accept' headers) and Consume (using 'content-type' headers).
-
-For example, if there is an Operation named _addFoo_, there will be a
-data type generated named _AddFoo_ (note the capitalization), which
-describes additional constraints and actions on the _addFoo_ operation
-via its typeclass instances. These typeclass instances can be viewed
-in GHCi or via the Haddocks.
-
-* required parameters are included as function arguments to _addFoo_
-* optional non-body parameters are included by using  `applyOptionalParam`
-* optional body parameters are set by using  `setBodyParam`
-
-Example code generated for pretend _addFoo_ operation: 
+## Example
 
 ```haskell
-data AddFoo 	
-instance Consumes AddFoo MimeJSON
-instance Produces AddFoo MimeJSON
-instance Produces AddFoo MimeXML
-instance HasBodyParam AddFoo FooModel
-instance HasOptionalParam AddFoo FooName
-instance HasOptionalParam AddFoo FooId
-```
-
-this would indicate that:
-
-* the _addFoo_ operation can consume JSON
-* the _addFoo_ operation produces JSON or XML, depending on the argument passed to the dispatch function
-* the _addFoo_ operation can set it's body param of _FooModel_ via `setBodyParam`
-* the _addFoo_ operation can set 2 different optional parameters via `applyOptionalParam`
-
-If the swagger spec doesn't declare it can accept or produce a certain
-MIME type for a given Operation, you should either add a Produces or
-Consumes instance for the desired MIME types (assuming the server
-supports it), use `dispatchLbsUnsafe` or modify the swagger spec and
-run the generator again.
-
-New MIME type instances can be added via MimeType/MimeRender/MimeUnrender
-
-Only JSON instances are generated by default, and in some case
-x-www-form-urlencoded instances (FromFrom, ToForm) will also be
-generated if the model fields are primitive types, and there are
-Operations using x-www-form-urlencoded which use those models.
-
-### Authentication
-
-A haskell data type will be generated for each swagger authentication type.
-
-If for example the AuthMethod `AuthOAuthFoo` is generated for OAuth operations, then
-`addAuthMethod` should be used to add the AuthMethod config.
-
-When a request is dispatched, if a matching auth method is found in
-the config, it will be applied to the request.
-
-### Example
-
-```haskell
-mgr <- newManager defaultManagerSettings
-config0 <- withStdoutLogging =<< newConfig 
-let config = config0
-    `addAuthMethod` AuthOAuthFoo "secret-key"
-
-let addFooRequest = 
-  addFoo 
-    (ContentType MimeJSON) 
-    (Accept MimeXML) 
-    (ParamBar paramBar)
-    (ParamQux paramQux)
-    modelBaz
-  `applyOptionalParam` FooId 1
-  `applyOptionalParam` FooName "name"
-  `setHeader` [("qux_header","xxyy")]
-addFooResult <- dispatchMime mgr config addFooRequest
-```
-
-See the example app and the haddocks for details.
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import           Data.Function           ((&))
+import qualified Kubernetes.API.CoreV1
+import           Kubernetes.Client       (dispatchMime)
+import           Kubernetes.ClientHelper
+import           Kubernetes.Core         (newConfig)
+import           Kubernetes.MimeTypes    (Accept (..), MimeJSON (..))
+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
+            (Kubernetes.API.CoreV1.listPodForAllNamespaces (Accept MimeJSON))
+        >>= print
+```
+
+You'll need the following additional package:
+- tls

kubernetes/kubernetes.cabal

@@ -57,6 +57,15 @@ library
     , unordered-containers
     , vector >=0.10.9 && <0.13
     , katip >=0.4 && < 0.6
+    -- below are manually added deps
+    , pem
+    , x509
+    , tls
+    , x509-system
+    , x509-store
+    , data-default-class
+    , connection
+    , x509-validation
   exposed-modules:
       Kubernetes
       Kubernetes.API.Admissionregistration
@@ -117,6 +126,8 @@ library
       Kubernetes.MimeTypes
       Kubernetes.Model
       Kubernetes.ModelLens
+      -- below are hand-written modules
+      Kubernetes.ClientHelper
   other-modules:
       Paths_kubernetes
   default-language: Haskell2010

kubernetes/lib/Kubernetes/ClientHelper.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE OverloadedStrings     #-}
+
+module Kubernetes.ClientHelper where
+
+import qualified Kubernetes.Core            as K
+import qualified Kubernetes.Model           as K
+
+import           Control.Exception.Safe     (Exception, MonadThrow, throwM)
+import           Control.Monad.IO.Class     (MonadIO, liftIO)
+import qualified Data.ByteString            as B
+import qualified Data.ByteString.Lazy       as LazyB
+import           Data.Default.Class         (def)
+import           Data.Either                (rights)
+import           Data.PEM                   (pemContent, pemParseBS)
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import           Data.Typeable              (Typeable)
+import           Data.X509                  (SignedCertificate,
+                                             decodeSignedCertificate)
+import qualified Data.X509                  as X509
+import           Data.X509.CertificateStore (makeCertificateStore)
+import qualified Data.X509.Validation       as X509
+import           Network.Connection         (TLSSettings (..))
+import qualified Network.HTTP.Client        as NH
+import           Network.HTTP.Client.TLS    (mkManagerSettings)
+import           Network.TLS                (Credential, defaultParamsClient)
+import qualified Network.TLS                as TLS
+import qualified Network.TLS.Extra          as TLS
+import           System.X509                (getSystemCertificateStore)
+
+-- |Sets the master URI in the 'K.KubernetesConfig'.
+setMasterURI
+    :: T.Text                -- ^ Master URI
+    -> K.KubernetesConfig
+    -> K.KubernetesConfig
+setMasterURI server kcfg =
+    kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) server }
+
+-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication.
+disableValidateAuthMethods :: K.KubernetesConfig -> K.KubernetesConfig
+disableValidateAuthMethods kcfg = kcfg { K.configValidateAuthMethods = False }
+
+-- |Configures the 'K.KubernetesConfig' to use token authentication.
+setTokenAuth
+    :: T.Text             -- ^Authentication token
+    -> K.KubernetesConfig
+    -> K.KubernetesConfig
+setTokenAuth token kcfg = kcfg
+    { K.configAuthMethods = [K.AnyAuthMethod (K.AuthApiKeyBearerToken token)]
+    }
+
+-- |Creates a 'NH.Manager' that can handle TLS.
+newManager :: TLS.ClientParams -> IO NH.Manager
+newManager cp = NH.newManager (mkManagerSettings (TLSSettings cp) Nothing)
+
+-- |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
+            }
+        }
+
+-- |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 cp = cp
+    { TLS.clientHooks = (TLS.clientHooks cp)
+        { TLS.onServerCertificate = 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 cp = cp
+    { TLS.clientHooks = (TLS.clientHooks cp)
+        { TLS.onServerCertificate = (\_ _ _ _ -> return [])
+        }
+    }
+
+-- |Use a custom CA store.
+setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams
+setCAStore certs cp = cp
+    { TLS.clientShared = (TLS.clientShared cp)
+        { TLS.sharedCAStore = (makeCertificateStore certs)
+        }
+    }
+
+-- |Use a client cert for authentication.
+setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams
+setClientCert cred cp = cp
+    { TLS.clientHooks = (TLS.clientHooks cp)
+        { TLS.onCertificateRequest = (\_ -> return (Just cred))
+        }
+    }
+
+-- |Parses a PEM-encoded @ByteString@ into a list of certificates.
+parsePEMCerts :: B.ByteString -> Either String [SignedCertificate]
+parsePEMCerts b = do
+    pems <- pemParseBS b
+    return $ rights $ map (decodeSignedCertificate . pemContent) pems
+
+data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show)
+
+instance Exception ParsePEMCertsException
+
+-- |Loads certificates from a PEM-encoded file.
+loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]
+loadPEMCerts p = do
+    liftIO (B.readFile p)
+        >>= either (throwM . ParsePEMCertsException) return
+        .   parsePEMCerts