Skip to content

Commit f9990f1

Browse files
amarrellaamarrella
committed
Ormolu
1 parent 4ea2dab commit f9990f1

File tree

1 file changed

+125
-117
lines changed

1 file changed

+125
-117
lines changed

‎src/Kubernetes/Webhook.hs‎

Lines changed: 125 additions & 117 deletions
Original file line numberDiff line numberDiff line change
@@ -1,140 +1,148 @@
1-
{-# LANGUAGE NamedFieldPuns #-}
21
{-# LANGUAGE DuplicateRecordFields #-}
3-
{-|
4-
5-
Module : Kubernetes.Webhook
6-
Copyright : (c) Earnest Research, 2020
7-
License : MIT
8-
Maintainer : amarrella@earnestresearch.com
9-
Stability : experimental
10-
Portability : POSIX
11-
12-
This module lets you create [Kubernetes Admission Webhooks](https://kubernetes.io/docs/reference/access-authn-authz/extensible-admission-controllers/).
13-
14-
Example with Servant (note: webhooks in Kubernetes require TLS):
15-
16-
@
17-
module Kubernetes.Example
18-
( startApp,
19-
app,
20-
)
21-
where
22-
23-
import Control.Monad.IO.Class
24-
import qualified Data.Aeson as A
25-
import qualified Data.ByteString as BS
26-
import qualified Data.HashMap.Strict as HM
27-
import Data.Text
28-
import GHC.Generics
29-
import qualified Kubernetes.Webhook as W
30-
import Network.Wai
31-
import Network.Wai.Handler.Warp
32-
import Network.Wai.Handler.WarpTLS
33-
import Servant
34-
import System.Environment
35-
36-
type API =
37-
"mutate" :> ReqBody '[JSON] W.AdmissionReviewRequest :> Post '[JSON] W.AdmissionReviewResponse
38-
39-
data Toleration
40-
= Toleration
41-
{ effect :: Maybe TolerationEffect,
42-
key :: Maybe Text,
43-
operator :: Maybe TolerationOperator,
44-
tolerationSeconds :: Maybe Integer,
45-
value :: Maybe Text
46-
}
47-
deriving (Generic, A.ToJSON)
48-
49-
data TolerationEffect = NoSchedule | PreferNoSchedule | NoExecute deriving (Generic, A.ToJSON)
50-
51-
data TolerationOperator = Exists | Equal deriving (Generic, A.ToJSON)
52-
53-
testToleration :: Toleration
54-
testToleration =
55-
Toleration
56-
{ effect = Just NoSchedule,
57-
key = Just "dedicated",
58-
operator = Just Equal,
59-
tolerationSeconds = Nothing,
60-
value = Just "test"
61-
}
62-
63-
startApp :: IO ()
64-
startApp = do
65-
let tlsOpts = tlsSettings "/certs/tls.crt" "/certs/tls.key"
66-
warpOpts = setPort 8080 defaultSettings
67-
runTLS tlsOpts warpOpts app
68-
69-
app :: Application
70-
app = serve api server
71-
72-
api :: Proxy API
73-
api = Proxy
74-
75-
server :: Server API
76-
server = mutate
77-
78-
mutate :: W.AdmissionReviewRequest -> Handler W.AdmissionReviewResponse
79-
mutate req = pure $ W.mutatingWebhook req (\_ -> Right W.Allowed) addToleration
80-
81-
addToleration :: W.Patch
82-
addToleration =
83-
W.Patch
84-
[ W.PatchOperation
85-
{ op = W.Add,
86-
path = "/spec/tolerations/-",
87-
from = Nothing,
88-
value = Just $ A.toJSON testToleration
89-
}
90-
]
91-
@
92-
93-
-}
2+
{-# LANGUAGE NamedFieldPuns #-}
943

95-
module Kubernetes.Webhook (
96-
mutatingWebhook,
97-
validatingWebhook,
98-
Allowed(..),
99-
module Kubernetes.Webhook.Types
100-
) where
4+
-- |
5+
--
6+
-- Module : Kubernetes.Webhook
7+
-- Copyright : (c) Earnest Research, 2020
8+
-- License : MIT
9+
-- Maintainer : amarrella@earnestresearch.com
10+
-- Stability : experimental
11+
-- Portability : POSIX
12+
--
13+
-- This module lets you create [Kubernetes Admission Webhooks](https://kubernetes.io/docs/reference/access-authn-authz/extensible-admission-controllers/).
14+
--
15+
-- Example with Servant (note: webhooks in Kubernetes require TLS):
16+
--
17+
-- @
18+
-- module Kubernetes.Example
19+
-- ( startApp,
20+
-- app,
21+
-- )
22+
-- where
23+
--
24+
-- import Control.Monad.IO.Class
25+
-- import qualified Data.Aeson as A
26+
-- import qualified Data.ByteString as BS
27+
-- import qualified Data.HashMap.Strict as HM
28+
-- import Data.Text
29+
-- import GHC.Generics
30+
-- import qualified Kubernetes.Webhook as W
31+
-- import Network.Wai
32+
-- import Network.Wai.Handler.Warp
33+
-- import Network.Wai.Handler.WarpTLS
34+
-- import Servant
35+
-- import System.Environment
36+
--
37+
-- type API =
38+
-- "mutate" :> ReqBody '[JSON] W.AdmissionReviewRequest :> Post '[JSON] W.AdmissionReviewResponse
39+
--
40+
-- data Toleration
41+
-- = Toleration
42+
-- { effect :: Maybe TolerationEffect,
43+
-- key :: Maybe Text,
44+
-- operator :: Maybe TolerationOperator,
45+
-- tolerationSeconds :: Maybe Integer,
46+
-- value :: Maybe Text
47+
-- }
48+
-- deriving (Generic, A.ToJSON)
49+
--
50+
-- data TolerationEffect = NoSchedule | PreferNoSchedule | NoExecute deriving (Generic, A.ToJSON)
51+
--
52+
-- data TolerationOperator = Exists | Equal deriving (Generic, A.ToJSON)
53+
--
54+
-- testToleration :: Toleration
55+
-- testToleration =
56+
-- Toleration
57+
-- { effect = Just NoSchedule,
58+
-- key = Just "dedicated",
59+
-- operator = Just Equal,
60+
-- tolerationSeconds = Nothing,
61+
-- value = Just "test"
62+
-- }
63+
--
64+
-- startApp :: IO ()
65+
-- startApp = do
66+
-- let tlsOpts = tlsSettings "/certs/tls.crt" "/certs/tls.key"
67+
-- warpOpts = setPort 8080 defaultSettings
68+
-- runTLS tlsOpts warpOpts app
69+
--
70+
-- app :: Application
71+
-- app = serve api server
72+
--
73+
-- api :: Proxy API
74+
-- api = Proxy
75+
--
76+
-- server :: Server API
77+
-- server = mutate
78+
--
79+
-- mutate :: W.AdmissionReviewRequest -> Handler W.AdmissionReviewResponse
80+
-- mutate req = pure $ W.mutatingWebhook req (\_ -> Right W.Allowed) addToleration
81+
--
82+
-- addToleration :: W.Patch
83+
-- addToleration =
84+
-- W.Patch
85+
-- [ W.PatchOperation
86+
-- { op = W.Add,
87+
-- path = "/spec/tolerations/-",
88+
-- from = Nothing,
89+
-- value = Just $ A.toJSON testToleration
90+
-- }
91+
-- ]
92+
-- @
93+
module Kubernetes.Webhook
94+
( mutatingWebhook,
95+
validatingWebhook,
96+
Allowed (..),
97+
module Kubernetes.Webhook.Types,
98+
)
99+
where
101100

102-
import Kubernetes.Webhook.Types
103101
import Data.Either
102+
import Kubernetes.Webhook.Types
104103

105104
data Allowed = Allowed
106105

107-
-- | Lets you create a mutating admission webhook
108-
mutatingWebhook :: AdmissionReviewRequest -- ^ the request the webhook receives from Kubernetes
109-
-> (AdmissionRequest -> Either Status Allowed) -- ^ logic to validate the request or reject it with an error
110-
-> Patch -- ^ the change to apply to the object
111-
-> AdmissionReviewResponse -- ^ the response sent back to Kubernetes
112-
mutatingWebhook AdmissionReviewRequest { request = req } allow patch =
113-
admissionReviewResponse AdmissionResponse {
114-
uid = rid,
106+
-- | Lets you create a mutating admission webhook
107+
mutatingWebhook ::
108+
-- | the request the webhook receives from Kubernetes
109+
AdmissionReviewRequest ->
110+
-- | logic to validate the request or reject it with an error
111+
(AdmissionRequest -> Either Status Allowed) ->
112+
-- | the change to apply to the object
113+
Patch ->
114+
-- | the response sent back to Kubernetes
115+
AdmissionReviewResponse
116+
mutatingWebhook AdmissionReviewRequest {request = req} allow patch =
117+
admissionReviewResponse AdmissionResponse
118+
{ uid = rid,
115119
allowed = isRight processedRequest,
116120
patch = Just patch,
117121
status = either Just (const Nothing) processedRequest,
118122
patchType = Just JSONPatch,
119123
auditAnnotations = Nothing
120124
}
121-
where
122-
AdmissionRequest { uid = rid } = req
125+
where
126+
AdmissionRequest {uid = rid} = req
123127
processedRequest = allow req
124128

125129
-- | Lets you create a validating admission webhook
126-
validatingWebhook :: AdmissionReviewRequest -- ^ the request the webhook receives from Kubernetes
127-
-> (AdmissionRequest -> Either Status Allowed) -- ^ logic to validate the request or reject it with an error
128-
-> AdmissionReviewResponse -- ^ the response sent back to Kubernetes
129-
validatingWebhook AdmissionReviewRequest { request = req } allow =
130-
admissionReviewResponse AdmissionResponse {
131-
uid = rid,
130+
validatingWebhook ::
131+
-- | the request the webhook receives from Kubernetes
132+
AdmissionReviewRequest ->
133+
-- | logic to validate the request or reject it with an error
134+
(AdmissionRequest -> Either Status Allowed) ->
135+
-- | the response sent back to Kubernetes
136+
AdmissionReviewResponse
137+
validatingWebhook AdmissionReviewRequest {request = req} allow =
138+
admissionReviewResponse AdmissionResponse
139+
{ uid = rid,
132140
allowed = isRight processedRequest,
133141
patch = Nothing,
134142
status = either Just (const Nothing) processedRequest,
135143
patchType = Nothing,
136144
auditAnnotations = Nothing
137145
}
138-
where
139-
AdmissionRequest { uid = rid } = req
146+
where
147+
AdmissionRequest {uid = rid} = req
140148
processedRequest = allow req

0 commit comments

Comments
 (0)