Skip to content

Commit c0923b9

Browse files
author
Shimin Guo
committed
add Kubernetes.ClientHelper module and add usage in README
1 parent d66255f commit c0923b9

File tree

3 files changed

+175
-187
lines changed

3 files changed

+175
-187
lines changed

kubernetes/README.md

Lines changed: 43 additions & 187 deletions
Original file line numberDiff line numberDiff line change
@@ -6,192 +6,48 @@ Targeted swagger version: 2.0
66

77
OpenAPI-Specification: https://github.com/OAI/OpenAPI-Specification/blob/master/versions/2.0.md
88

9-
## Installation
10-
11-
Installation follows the standard approach to installing Stack-based projects.
12-
13-
1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).
14-
2. To build the package, and generate the documentation (recommended):
15-
```
16-
stack haddock
17-
```
18-
which will generate docs for this lib in the `docs` folder.
19-
20-
To generate the docs in the normal location (to enable hyperlinks to external libs), remove
21-
```
22-
build:
23-
haddock-arguments:
24-
haddock-args:
25-
- "--odir=./docs"
26-
```
27-
from the stack.yaml file and run `stack haddock` again.
28-
29-
3. To run unit tests:
30-
```
31-
stack test
32-
```
33-
34-
## Swagger-Codegen
35-
36-
The code generator that produced this library, and which explains how
37-
to obtain and use the swagger-codegen cli tool lives at
38-
39-
https://github.com/swagger-api/swagger-codegen
40-
41-
The _language_ argument (`--lang`) passed to the cli tool used should be
42-
43-
```
44-
haskell-http-client
45-
```
46-
47-
### Unsupported Swagger Features
48-
49-
* Model Inheritance
50-
51-
This is beta software; other cases may not be supported.
52-
53-
### Codegen "additional properties" parameters
54-
55-
These options allow some customization of the code generation process.
56-
57-
**haskell-http-client additional properties:**
58-
59-
| OPTION | DESCRIPTION | DEFAULT | ACTUAL |
60-
| ------------------------------- | ----------------------------------------------------------------------------------------------------------------------------- | -------- | ------------------------------------- |
61-
| allowNonUniqueOperationIds | allow *different* API modules to contain the same operationId. Each API must be imported qualified | false | true |
62-
| allowFromJsonNulls | allow JSON Null during model decoding from JSON | true | true |
63-
| allowToJsonNulls | allow emitting JSON Null during model encoding to JSON | false | false |
64-
| dateFormat | format string used to parse/render a date | %Y-%m-%d | %Y-%m-%d |
65-
| dateTimeFormat | format string used to parse/render a datetime. (Defaults to [formatISO8601Millis][1] when not provided) | | |
66-
| generateEnums | Generate specific datatypes for swagger enums | true | true |
67-
| generateFormUrlEncodedInstances | Generate FromForm/ToForm instances for models used by x-www-form-urlencoded operations (model fields must be primitive types) | true | true |
68-
| generateLenses | Generate Lens optics for Models | true | true |
69-
| generateModelConstructors | Generate smart constructors (only supply required fields) for models | true | true |
70-
| inlineMimeTypes | Inline (hardcode) the content-type and accept parameters on operations, when there is only 1 option | false | false |
71-
| modelDeriving | Additional classes to include in the deriving() clause of Models | | |
72-
| strictFields | Add strictness annotations to all model fields | true | true |
73-
| useMonadLogger | Use the monad-logger package to provide logging (if instead false, use the katip logging package) | false | false |
74-
75-
[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis
76-
77-
An example setting _strictFields_ and _dateTimeFormat_:
78-
79-
```
80-
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"
81-
```
82-
83-
View the full list of Codegen "config option" parameters with the command:
84-
85-
```
86-
java -jar swagger-codegen-cli.jar config-help -l haskell-http-client
87-
```
88-
89-
## Usage Notes
90-
91-
### Example SwaggerPetstore Haddock documentation
92-
93-
An example of the generated haddock documentation targeting the server http://petstore.swagger.io/ (SwaggerPetstore) can be found [here][2]
94-
95-
[2]: https://hackage.haskell.org/package/swagger-petstore
96-
97-
### Example SwaggerPetstore App
98-
99-
An example application using the auto-generated haskell-http-client bindings for the server http://petstore.swagger.io/ can be found [here][3]
100-
101-
[3]: https://github.com/swagger-api/swagger-codegen/tree/master/samples/client/petstore/haskell-http-client/example-app
102-
103-
This library is intended to be imported qualified.
104-
105-
### Modules
106-
107-
| MODULE | NOTES |
108-
| ------------------- | --------------------------------------------------- |
109-
| Kubernetes.Client | use the "dispatch" functions to send requests |
110-
| Kubernetes.Core | core funcions, config and request types |
111-
| Kubernetes.API | construct api requests |
112-
| Kubernetes.Model | describes api models |
113-
| Kubernetes.MimeTypes | encoding/decoding MIME types (content-types/accept) |
114-
| Kubernetes.ModelLens | lenses for model fields |
115-
| Kubernetes.Logging | logging functions and utils |
116-
117-
118-
### MimeTypes
119-
120-
This library adds type safety around what swagger specifies as
121-
Produces and Consumes for each Operation (e.g. the list of MIME types an
122-
Operation can Produce (using 'accept' headers) and Consume (using 'content-type' headers).
123-
124-
For example, if there is an Operation named _addFoo_, there will be a
125-
data type generated named _AddFoo_ (note the capitalization), which
126-
describes additional constraints and actions on the _addFoo_ operation
127-
via its typeclass instances. These typeclass instances can be viewed
128-
in GHCi or via the Haddocks.
129-
130-
* required parameters are included as function arguments to _addFoo_
131-
* optional non-body parameters are included by using `applyOptionalParam`
132-
* optional body parameters are set by using `setBodyParam`
133-
134-
Example code generated for pretend _addFoo_ operation:
9+
## Example
13510

13611
```haskell
137-
data AddFoo
138-
instance Consumes AddFoo MimeJSON
139-
instance Produces AddFoo MimeJSON
140-
instance Produces AddFoo MimeXML
141-
instance HasBodyParam AddFoo FooModel
142-
instance HasOptionalParam AddFoo FooName
143-
instance HasOptionalParam AddFoo FooId
144-
```
145-
146-
this would indicate that:
147-
148-
* the _addFoo_ operation can consume JSON
149-
* the _addFoo_ operation produces JSON or XML, depending on the argument passed to the dispatch function
150-
* the _addFoo_ operation can set it's body param of _FooModel_ via `setBodyParam`
151-
* the _addFoo_ operation can set 2 different optional parameters via `applyOptionalParam`
152-
153-
If the swagger spec doesn't declare it can accept or produce a certain
154-
MIME type for a given Operation, you should either add a Produces or
155-
Consumes instance for the desired MIME types (assuming the server
156-
supports it), use `dispatchLbsUnsafe` or modify the swagger spec and
157-
run the generator again.
158-
159-
New MIME type instances can be added via MimeType/MimeRender/MimeUnrender
160-
161-
Only JSON instances are generated by default, and in some case
162-
x-www-form-urlencoded instances (FromFrom, ToForm) will also be
163-
generated if the model fields are primitive types, and there are
164-
Operations using x-www-form-urlencoded which use those models.
165-
166-
### Authentication
167-
168-
A haskell data type will be generated for each swagger authentication type.
169-
170-
If for example the AuthMethod `AuthOAuthFoo` is generated for OAuth operations, then
171-
`addAuthMethod` should be used to add the AuthMethod config.
172-
173-
When a request is dispatched, if a matching auth method is found in
174-
the config, it will be applied to the request.
175-
176-
### Example
177-
178-
```haskell
179-
mgr <- newManager defaultManagerSettings
180-
config0 <- withStdoutLogging =<< newConfig
181-
let config = config0
182-
`addAuthMethod` AuthOAuthFoo "secret-key"
183-
184-
let addFooRequest =
185-
addFoo
186-
(ContentType MimeJSON)
187-
(Accept MimeXML)
188-
(ParamBar paramBar)
189-
(ParamQux paramQux)
190-
modelBaz
191-
`applyOptionalParam` FooId 1
192-
`applyOptionalParam` FooName "name"
193-
`setHeader` [("qux_header","xxyy")]
194-
addFooResult <- dispatchMime mgr config addFooRequest
195-
```
196-
197-
See the example app and the haddocks for details.
12+
{-# LANGUAGE OverloadedStrings #-}
13+
14+
module Main where
15+
16+
import Data.Function ((&))
17+
import qualified Kubernetes.API.CoreV1
18+
import Kubernetes.Client (dispatchMime)
19+
import Kubernetes.ClientHelper
20+
import Kubernetes.Core (newConfig)
21+
import Kubernetes.MimeTypes (Accept (..), MimeJSON (..))
22+
import Network.TLS (credentialLoadX509)
23+
24+
main :: IO ()
25+
main = do
26+
-- We need to first create a Kubernetes.Core.KubernetesConfig and a Network.HTTP.Client.Manager.
27+
-- Currently we need to construct these objects manually. Work is underway to construct these
28+
-- objects automatically from a kubeconfig file. See https://github.com/kubernetes-client/haskell/issues/2.
29+
kcfg <-
30+
newConfig
31+
& fmap (setMasterURI "https://mycluster.example.com") -- fill in master URI
32+
& fmap (setTokenAuth "mytoken") -- if using token auth
33+
& fmap disableValidateAuthMethods -- if using client cert auth
34+
myCAStore <- loadPEMCerts "/path/to/ca.crt" -- if using custom CA certs
35+
myCert <- -- if using client cert
36+
credentialLoadX509 "/path/to/client.crt" "/path/to/client.key"
37+
>>= either error return
38+
tlsParams <-
39+
defaultTLSClientParams
40+
& fmap disableServerNameValidation -- if master address is specified as an IP address
41+
& fmap disableServerCertValidation -- if you don't want to validate the server cert at all (insecure)
42+
& fmap (setCAStore myCAStore) -- if using custom CA certs
43+
& fmap (setClientCert myCert) -- if using client cert
44+
manager <- newManager tlsParams
45+
dispatchMime
46+
manager
47+
kcfg
48+
(Kubernetes.API.CoreV1.listPodForAllNamespaces (Accept MimeJSON))
49+
>>= print
50+
```
51+
52+
You'll need the following additional package:
53+
- tls

kubernetes/kubernetes.cabal

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,15 @@ library
5757
, unordered-containers
5858
, vector >=0.10.9 && <0.13
5959
, katip >=0.4 && < 0.6
60+
-- below are manually added deps
61+
, pem
62+
, x509
63+
, tls
64+
, x509-system
65+
, x509-store
66+
, data-default-class
67+
, connection
68+
, x509-validation
6069
exposed-modules:
6170
Kubernetes
6271
Kubernetes.API.Admissionregistration
@@ -117,6 +126,8 @@ library
117126
Kubernetes.MimeTypes
118127
Kubernetes.Model
119128
Kubernetes.ModelLens
129+
-- below are hand-written modules
130+
Kubernetes.ClientHelper
120131
other-modules:
121132
Paths_kubernetes
122133
default-language: Haskell2010
Lines changed: 121 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,121 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Kubernetes.ClientHelper where
4+
5+
import qualified Kubernetes.Core as K
6+
import qualified Kubernetes.Model as K
7+
8+
import Control.Exception.Safe (Exception, MonadThrow, throwM)
9+
import Control.Monad.IO.Class (MonadIO, liftIO)
10+
import qualified Data.ByteString as B
11+
import qualified Data.ByteString.Lazy as LazyB
12+
import Data.Default.Class (def)
13+
import Data.Either (rights)
14+
import Data.PEM (pemContent, pemParseBS)
15+
import qualified Data.Text as T
16+
import qualified Data.Text.Encoding as T
17+
import Data.Typeable (Typeable)
18+
import Data.X509 (SignedCertificate,
19+
decodeSignedCertificate)
20+
import qualified Data.X509 as X509
21+
import Data.X509.CertificateStore (makeCertificateStore)
22+
import qualified Data.X509.Validation as X509
23+
import Network.Connection (TLSSettings (..))
24+
import qualified Network.HTTP.Client as NH
25+
import Network.HTTP.Client.TLS (mkManagerSettings)
26+
import Network.TLS (Credential, defaultParamsClient)
27+
import qualified Network.TLS as TLS
28+
import qualified Network.TLS.Extra as TLS
29+
import System.X509 (getSystemCertificateStore)
30+
31+
-- |Sets the master URI in the 'K.KubernetesConfig'.
32+
setMasterURI
33+
:: T.Text -- ^ Master URI
34+
-> K.KubernetesConfig
35+
-> K.KubernetesConfig
36+
setMasterURI server kcfg =
37+
kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) server }
38+
39+
-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication.
40+
disableValidateAuthMethods :: K.KubernetesConfig -> K.KubernetesConfig
41+
disableValidateAuthMethods kcfg = kcfg { K.configValidateAuthMethods = False }
42+
43+
-- |Configures the 'K.KubernetesConfig' to use token authentication.
44+
setTokenAuth
45+
:: T.Text -- ^Authentication token
46+
-> K.KubernetesConfig
47+
-> K.KubernetesConfig
48+
setTokenAuth token kcfg = kcfg
49+
{ K.configAuthMethods = [K.AnyAuthMethod (K.AuthApiKeyBearerToken token)]
50+
}
51+
52+
-- |Creates a 'NH.Manager' that can handle TLS.
53+
newManager :: TLS.ClientParams -> IO NH.Manager
54+
newManager cp = NH.newManager (mkManagerSettings (TLSSettings cp) Nothing)
55+
56+
-- |Default TLS settings using the system CA store.
57+
defaultTLSClientParams :: IO TLS.ClientParams
58+
defaultTLSClientParams = do
59+
let defParams = defaultParamsClient "" ""
60+
systemCAStore <- getSystemCertificateStore
61+
return defParams
62+
{ TLS.clientSupported = def
63+
{ TLS.supportedCiphers = TLS.ciphersuite_strong
64+
}
65+
, TLS.clientShared = (TLS.clientShared defParams)
66+
{ TLS.sharedCAStore = systemCAStore
67+
}
68+
}
69+
70+
-- |Don't check whether the cert presented by the server matches the name of the server you are connecting to.
71+
-- This is necessary if you specify the server host by its IP address.
72+
disableServerNameValidation :: TLS.ClientParams -> TLS.ClientParams
73+
disableServerNameValidation cp = cp
74+
{ TLS.clientHooks = (TLS.clientHooks cp)
75+
{ TLS.onServerCertificate = X509.validate
76+
X509.HashSHA256
77+
def
78+
def { X509.checkFQHN = False }
79+
}
80+
}
81+
82+
-- |Insecure mode. The client will not validate the server cert at all.
83+
disableServerCertValidation :: TLS.ClientParams -> TLS.ClientParams
84+
disableServerCertValidation cp = cp
85+
{ TLS.clientHooks = (TLS.clientHooks cp)
86+
{ TLS.onServerCertificate = (\_ _ _ _ -> return [])
87+
}
88+
}
89+
90+
-- |Use a custom CA store.
91+
setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams
92+
setCAStore certs cp = cp
93+
{ TLS.clientShared = (TLS.clientShared cp)
94+
{ TLS.sharedCAStore = (makeCertificateStore certs)
95+
}
96+
}
97+
98+
-- |Use a client cert for authentication.
99+
setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams
100+
setClientCert cred cp = cp
101+
{ TLS.clientHooks = (TLS.clientHooks cp)
102+
{ TLS.onCertificateRequest = (\_ -> return (Just cred))
103+
}
104+
}
105+
106+
-- |Parses a PEM-encoded @ByteString@ into a list of certificates.
107+
parsePEMCerts :: B.ByteString -> Either String [SignedCertificate]
108+
parsePEMCerts b = do
109+
pems <- pemParseBS b
110+
return $ rights $ map (decodeSignedCertificate . pemContent) pems
111+
112+
data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show)
113+
114+
instance Exception ParsePEMCertsException
115+
116+
-- |Loads certificates from a PEM-encoded file.
117+
loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]
118+
loadPEMCerts p = do
119+
liftIO (B.readFile p)
120+
>>= either (throwM . ParsePEMCertsException) return
121+
. parsePEMCerts

0 commit comments

Comments
 (0)