diff --git a/Changelog.md b/Changelog.md new file mode 100644 index 0000000..e626bbb --- /dev/null +++ b/Changelog.md @@ -0,0 +1,6 @@ +# Alertmanager + +## 0.1.0 + ++ Initial generation ++ Make it compile with ghc 9 diff --git a/Makefile b/Makefile index ae26270..5adb324 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ space := $(null) # comma := , generate: - openapi-generator generate \ + openapi-generator-cli generate \ -i alertmanager/api/v2/openapi.yaml \ --additional-properties $(subst $(space),$(comma),$(strip $(PROPERTIES))) \ --ignore-file-override alertmanager-openapi/.openapi-generator-ignore \ diff --git a/README.md b/README.md index d58e462..d2990df 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,21 @@ # Alertmanager Client library -This is a WIP library for using the Alertmanager HTTP API for creating & modifying alerts from Haskell code. +This is a library for using the Alertmanager HTTP API for creating & modifying alerts from Haskell code. It is split into two parts: * `alertmanager-openapi` - a Haskell library which contains auto-generated bindings for the Alertmanager v2 HTTP API, generated using `openapi-generator` from the Alertmanager API Swagger file in their repository (pulled in via submodule). * `alertmanager-client` - an `amazonka`-inspired Haskell library which provides a high-level interface, including cleaner types and a monad transformer, for running queries against the Alertmanager v2 HTTP API. + +# Usage + +run `git submodule update --recursive` then enter the nix shell. +Follow the steps below. + + ## Generating the OpenAPI bindings + A command to re-generate the bindings is provided in the top-level `Makefile` - simply run `make generate`. Note that some files normally generated by the tool have to be modified by hand. For example, the `.cabal` file contains copyright information, so the tool is forbidden from overwriting it. The full list of such files is contained in `.openapi-generator-ignore`. diff --git a/alertmanager-client/alertmanager-client.cabal b/alertmanager-client/alertmanager-client.cabal index b48e827..52daa4f 100644 --- a/alertmanager-client/alertmanager-client.cabal +++ b/alertmanager-client/alertmanager-client.cabal @@ -39,8 +39,8 @@ library build-depends: base >= 4.7 && < 5 , alertmanager-openapi >= 0.0.1 && < 0.0.2 - , http-client >= 0.5 && < 0.7 - , lens >= 4 && < 5 + , http-client >= 0.5 && < 0.8 + , lens >= 4 && < 6 , text >= 0.11 && < 2 , transformers >= 0.5 && < 0.6 default-language: Haskell2010 diff --git a/alertmanager-client/shell.nix b/alertmanager-client/shell.nix new file mode 100644 index 0000000..ade0b1a --- /dev/null +++ b/alertmanager-client/shell.nix @@ -0,0 +1,35 @@ +{ nixpkgs ? import ../nix/pin.nix {}, compiler ? "default", doBenchmark ? false }: + +let + + inherit (nixpkgs) pkgs; + + f = { mkDerivation, alertmanager-openapi, base, http-client, lens + , lib, text, transformers, cabal-install + }: + mkDerivation { + pname = "alertmanager-client"; + version = "0.1.0.0"; + src = ./.; + libraryToolDepends = [ cabal-install ]; + libraryHaskellDepends = [ + alertmanager-openapi base http-client lens text transformers + ]; + homepage = "https://github.com/SupercedeTech/alertmanager-client#readme"; + license = lib.licenses.bsd3; + }; + + haskellPackages = (if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler}).extend(self: super: { + alertmanager-openapi = haskellPackages.callPackage ../alertmanager-openapi {}; + }); + + variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; + + drv = variant (haskellPackages.callPackage f { + }); + +in + + if pkgs.lib.inNixShell then drv.env else drv diff --git a/alertmanager-openapi/.openapi-generator/VERSION b/alertmanager-openapi/.openapi-generator/VERSION index 862529f..1e20ec3 100644 --- a/alertmanager-openapi/.openapi-generator/VERSION +++ b/alertmanager-openapi/.openapi-generator/VERSION @@ -1 +1 @@ -5.2.1-SNAPSHOT \ No newline at end of file +5.4.0 \ No newline at end of file diff --git a/alertmanager-openapi/README.md b/alertmanager-openapi/README.md index 972d073..bf89747 100644 --- a/alertmanager-openapi/README.md +++ b/alertmanager-openapi/README.md @@ -15,7 +15,7 @@ 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 +To generate the docs in the normal location (to enable hyperlinks to external libs), remove ``` build: haddock-arguments: @@ -55,7 +55,7 @@ These options allow some customization of the code generation process. **haskell-http-client additional properties:** | OPTION | DESCRIPTION | DEFAULT | ACTUAL | -| ------------------------------- | ----------------------------------------------------------------------------------------------------------------------------- | -------- | ------------------------------------- | +|---------------------------------|-------------------------------------------------------------------------------------------------------------------------------|----------|---------------------------------------| | allowFromJsonNulls | allow JSON Null during model decoding from JSON | true | true | | allowNonUniqueOperationIds | allow *different* API modules to contain the same operationId. Each API must be imported qualified | false | false | | allowToJsonNulls | allow emitting JSON Null during model encoding to JSON | false | false | @@ -76,13 +76,14 @@ These options allow some customization of the code generation process. | requestType | Set the name of the type used to generate requests | | AlertmanagerRequest | | strictFields | Add strictness annotations to all model fields | true | true | | useKatip | Sets the default value for the UseKatip cabal flag. If true, the katip package provides logging instead of monad-logger | true | false | +| queryExtraUnreserved | Configures additional querystring characters which must not be URI encoded, e.g. '+' or ':' | | | [1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis An example setting _dateTimeFormat_ and _strictFields_: ``` -java -jar openapi-generator-cli.jar generate -i petstore.yaml -g haskell-http-client -o output/haskell-http-client --additional-properties=dateTimeFormat="%Y-%m-%dT%H:%M:%S%Q%z" --additional-properties=strictFields=false +java -jar openapi-generator-cli.jar generate -i petstore.yaml -g haskell-http-client -o output/haskell-http-client --additional-properties=dateTimeFormat="%Y-%m-%dT%H:%M:%S%Q%z" --additional-properties=strictFields=false ``` View the full list of Codegen "config option" parameters with the command: @@ -112,7 +113,7 @@ This library is intended to be imported qualified. | MODULE | NOTES | | ------------------- | --------------------------------------------------- | | Network.Alertmanager.OpenAPI.Client | use the "dispatch" functions to send requests | -| Network.Alertmanager.OpenAPI.Core | core funcions, config and request types | +| Network.Alertmanager.OpenAPI.Core | core functions, config and request types | | Network.Alertmanager.OpenAPI.API | construct api requests | | Network.Alertmanager.OpenAPI.Model | describes api models | | Network.Alertmanager.OpenAPI.MimeTypes | encoding/decoding MIME types (content-types/accept) | @@ -136,10 +137,10 @@ in GHCi or via the Haddocks. * 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 code generated for pretend _addFoo_ operation: ```haskell -data AddFoo +data AddFoo instance Consumes AddFoo MimeJSON instance Produces AddFoo MimeJSON instance Produces AddFoo MimeXML @@ -182,14 +183,14 @@ the config, it will be applied to the request. ```haskell mgr <- newManager defaultManagerSettings -config0 <- withStdoutLogging =<< newConfig +config0 <- withStdoutLogging =<< newConfig let config = config0 `addAuthMethod` AuthOAuthFoo "secret-key" -let addFooRequest = - addFoo - (ContentType MimeJSON) - (Accept MimeXML) +let addFooRequest = + addFoo + (ContentType MimeJSON) + (Accept MimeXML) (ParamBar paramBar) (ParamQux paramQux) modelBaz diff --git a/alertmanager-openapi/alertmanager-openapi.cabal b/alertmanager-openapi/alertmanager-openapi.cabal index 4c519a9..d1c799d 100644 --- a/alertmanager-openapi/alertmanager-openapi.cabal +++ b/alertmanager-openapi/alertmanager-openapi.cabal @@ -30,7 +30,7 @@ library lib ghc-options: -Wall -funbox-strict-fields build-depends: - aeson >=1.0 && <2.0 + aeson >=2.0 && <3.0 , base >=4.7 && <5.0 , base64-bytestring >1.0 && <2.0 , bytestring >=0.10.0 && <0.11 @@ -38,8 +38,8 @@ library , containers >=0.5.0.0 && <0.8 , deepseq >= 1.4 && <1.6 , exceptions >= 0.4 - , http-api-data >= 0.3.4 && <0.5 - , http-client >=0.5 && <0.7 + , http-api-data >= 0.3.4 && <0.6 + , http-client >=0.5 && <0.8 , http-client-tls , http-media >= 0.4 && < 0.9 , http-types >=0.8 && <0.13 diff --git a/alertmanager-openapi/default.nix b/alertmanager-openapi/default.nix new file mode 100644 index 0000000..21c535a --- /dev/null +++ b/alertmanager-openapi/default.nix @@ -0,0 +1,27 @@ +{ mkDerivation, aeson, base, base64-bytestring, bytestring + , case-insensitive, containers, deepseq, exceptions, hspec + , http-api-data, http-client, http-client-tls, http-media + , http-types, iso8601-time, lib, microlens, monad-logger, mtl + , network, QuickCheck, random, safe-exceptions, semigroups, text + , time, transformers, unordered-containers, vector, cabal-install + }: + mkDerivation { + pname = "alertmanager-openapi"; + version = "0.0.1.0"; + src = ./.; + libraryToolDepends = [cabal-install]; + libraryHaskellDepends = [ + aeson base base64-bytestring bytestring case-insensitive containers + deepseq exceptions http-api-data http-client http-client-tls + http-media http-types iso8601-time microlens monad-logger mtl + network random safe-exceptions text time transformers + unordered-containers vector + ]; + testHaskellDepends = [ + aeson base bytestring containers hspec iso8601-time mtl QuickCheck + semigroups text time transformers unordered-containers vector + ]; + homepage = "https://openapi-generator.tech"; + description = "Auto-generated alertmanager-openapi API Client"; + license = lib.licenses.bsd3; + } diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alert.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alert.hs index 35334a8..7112d3c 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alert.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alert.hs @@ -63,7 +63,7 @@ import qualified Prelude as P -- -- Get a list of alerts -- -getAlerts +getAlerts :: AlertmanagerRequest GetAlerts MimeNoContent [GettableAlert] MimeJSON getAlerts = _mkRequest "GET" ["/alerts"] @@ -109,7 +109,7 @@ instance Produces GetAlerts MimeJSON -- -- Create new Alerts -- -postAlerts +postAlerts :: (Consumes PostAlerts MimeJSON, MimeRender MimeJSON Alerts) => Alerts -- ^ "alerts" - The alerts to create -> AlertmanagerRequest PostAlerts MimeJSON NoContent MimeNoContent diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alertgroup.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alertgroup.hs index a8a1a67..2ca3d08 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alertgroup.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Alertgroup.hs @@ -63,7 +63,7 @@ import qualified Prelude as P -- -- Get a list of alert groups -- -getAlertGroups +getAlertGroups :: AlertmanagerRequest GetAlertGroups MimeNoContent [AlertGroup] MimeJSON getAlertGroups = _mkRequest "GET" ["/alerts/groups"] diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/General.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/General.hs index 0ebbfc4..0574750 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/General.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/General.hs @@ -63,7 +63,7 @@ import qualified Prelude as P -- -- Get current status of an Alertmanager instance and its cluster -- -getStatus +getStatus :: AlertmanagerRequest GetStatus MimeNoContent AlertmanagerStatus MimeJSON getStatus = _mkRequest "GET" ["/status"] diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Receiver.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Receiver.hs index 7ff16ba..174303f 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Receiver.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Receiver.hs @@ -63,7 +63,7 @@ import qualified Prelude as P -- -- Get list of all receivers (name of notification integrations) -- -getReceivers +getReceivers :: AlertmanagerRequest GetReceivers MimeNoContent [Receiver] MimeJSON getReceivers = _mkRequest "GET" ["/receivers"] diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Silence.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Silence.hs index 09c0e8c..a59adc2 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Silence.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/API/Silence.hs @@ -63,7 +63,7 @@ import qualified Prelude as P -- -- Delete a silence by its ID -- -deleteSilence +deleteSilence :: SilenceId -- ^ "silenceId" - ID of the silence to get -> AlertmanagerRequest DeleteSilence MimeNoContent NoContent MimeNoContent deleteSilence (SilenceId silenceId) = @@ -79,7 +79,7 @@ instance Produces DeleteSilence MimeNoContent -- -- Get a silence by its ID -- -getSilence +getSilence :: SilenceId -- ^ "silenceId" - ID of the silence to get -> AlertmanagerRequest GetSilence MimeNoContent GettableSilence MimeJSON getSilence (SilenceId silenceId) = @@ -96,7 +96,7 @@ instance Produces GetSilence MimeJSON -- -- Get a list of silences -- -getSilences +getSilences :: AlertmanagerRequest GetSilences MimeNoContent [GettableSilence] MimeJSON getSilences = _mkRequest "GET" ["/silences"] @@ -117,7 +117,7 @@ instance Produces GetSilences MimeJSON -- -- Post a new silence or update an existing one -- -postSilences +postSilences :: (Consumes PostSilences MimeJSON, MimeRender MimeJSON PostableSilence) => PostableSilence -- ^ "silence" - The silence to create -> AlertmanagerRequest PostSilences MimeJSON InlineResponse200 MimeJSON diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Client.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Client.hs index e3c27a5..80257d4 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Client.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Client.hs @@ -32,6 +32,7 @@ import qualified Control.Exception.Safe as E import qualified Control.Monad.IO.Class as P import qualified Control.Monad as P import qualified Data.Aeson.Types as A +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BCL @@ -69,7 +70,7 @@ dispatchLbs manager config request = do -- | pair of decoded http body and http response data MimeResult res = MimeResult { mimeResult :: Either MimeError res -- ^ decoded http body - , mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response + , mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response } deriving (Show, Functor, Foldable, Traversable) @@ -77,8 +78,8 @@ data MimeResult res = data MimeError = MimeError { mimeError :: String -- ^ unrender/parser error - , mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response - } deriving (Eq, Show) + , mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response + } deriving (Show) -- | send a request returning the 'MimeResult' dispatchMime @@ -171,7 +172,7 @@ _toInitRequest => AlertmanagerClientConfig -- ^ config -> AlertmanagerRequest req contentType res accept -- ^ request -> IO (InitRequest req contentType res accept) -- ^ initialized request -_toInitRequest config req0 = +_toInitRequest config req0 = runConfigLogWithExceptions "Client" config $ do parsedReq <- P.liftIO $ NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0)) req1 <- P.liftIO $ _applyAuthMethods req0 config @@ -179,13 +180,18 @@ _toInitRequest config req0 = (configValidateAuthMethods config && (not . null . rAuthTypes) req1) (E.throw $ AuthMethodException $ "AuthMethod not configured: " <> (show . head . rAuthTypes) req1) let req2 = req1 & _setContentTypeHeader & _setAcceptHeader - reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (rParams req2) - reqQuery = NH.renderQuery True (paramsQuery (rParams req2)) - pReq = parsedReq { NH.method = (rMethod req2) + params = rParams req2 + reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders params + reqQuery = let query = paramsQuery params + queryExtraUnreserved = configQueryExtraUnreserved config + in if B.null queryExtraUnreserved + then NH.renderQuery True query + else NH.renderQueryPartialEscape True (toPartialEscapeQuery queryExtraUnreserved query) + pReq = parsedReq { NH.method = rMethod req2 , NH.requestHeaders = reqHeaders , NH.queryString = reqQuery } - outReq <- case paramsBody (rParams req2) of + outReq <- case paramsBody params of ParamBodyNone -> pure (pReq { NH.requestBody = mempty }) ParamBodyB bs -> pure (pReq { NH.requestBody = NH.RequestBodyBS bs }) ParamBodyBL bl -> pure (pReq { NH.requestBody = NH.RequestBodyLBS bl }) @@ -202,16 +208,16 @@ modifyInitRequest (InitRequest req) f = InitRequest (f req) modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept) modifyInitRequestM (InitRequest req) f = fmap InitRequest (f req) --- ** Logging +-- ** Logging -- | Run a block using the configured logger instance runConfigLog :: P.MonadIO m - => AlertmanagerClientConfig -> LogExec m + => AlertmanagerClientConfig -> LogExec m a runConfigLog config = configLogExecWithContext config (configLogContext config) -- | Run a block using the configured logger instance (logs exceptions) runConfigLogWithExceptions :: (E.MonadCatch m, P.MonadIO m) - => T.Text -> AlertmanagerClientConfig -> LogExec m + => T.Text -> AlertmanagerClientConfig -> LogExec m a runConfigLogWithExceptions src config = runConfigLog config . logExceptions src diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Core.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Core.hs index a0dddb2..1c0e7a7 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Core.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/Core.hs @@ -44,6 +44,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Data as P (Data, Typeable, TypeRep, typeRep) import qualified Data.Foldable as P import qualified Data.Ix as P +import qualified Data.Kind as K (Type) import qualified Data.Maybe as P import qualified Data.Proxy as P (Proxy(..)) import qualified Data.Text as T @@ -55,9 +56,9 @@ import qualified Lens.Micro as L import qualified Network.HTTP.Client.MultipartFormData as NH import qualified Network.HTTP.Types as NH import qualified Prelude as P +import qualified Text.Printf as T import qualified Web.FormUrlEncoded as WH import qualified Web.HttpApiData as WH -import qualified Text.Printf as T import Control.Applicative ((<|>)) import Control.Applicative (Alternative) @@ -66,11 +67,11 @@ import Data.Function ((&)) import Data.Foldable(foldlM) import Data.Monoid ((<>)) import Data.Text (Text) -import Prelude (($), (.), (<$>), (<*>), Maybe(..), Bool(..), Char, String, fmap, mempty, pure, return, show, IO, Monad, Functor) +import Prelude (($), (.), (&&), (<$>), (<*>), Maybe(..), Bool(..), Char, String, fmap, mempty, pure, return, show, IO, Monad, Functor, maybe) -- * AlertmanagerClientConfig --- | +-- | data AlertmanagerClientConfig = AlertmanagerClientConfig { configHost :: BCL.ByteString -- ^ host supplied in the Request , configUserAgent :: Text -- ^ user-agent supplied in the Request @@ -78,6 +79,7 @@ data AlertmanagerClientConfig = AlertmanagerClientConfig , configLogContext :: LogContext -- ^ Configures the logger , configAuthMethods :: [AnyAuthMethod] -- ^ List of configured auth methods , configValidateAuthMethods :: Bool -- ^ throw exceptions if auth methods are not configured + , configQueryExtraUnreserved :: B.ByteString -- ^ Configures additional querystring characters which must not be URI encoded, e.g. '+' or ':' } -- | display the config @@ -108,7 +110,8 @@ newConfig = do , configLogContext = logCxt , configAuthMethods = [] , configValidateAuthMethods = True - } + , configQueryExtraUnreserved = "" + } -- | updates config use AuthMethod on matching requests addAuthMethod :: AuthMethod auth => AlertmanagerClientConfig -> auth -> AlertmanagerClientConfig @@ -130,7 +133,7 @@ withStderrLogging p = do -- | updates the config to disable logging withNoLogging :: AlertmanagerClientConfig -> AlertmanagerClientConfig withNoLogging p = p { configLogExecWithContext = runNullLogExec} - + -- * AlertmanagerRequest -- | Represents a request. @@ -229,7 +232,7 @@ data ParamBody -- ** AlertmanagerRequest Utils -_mkRequest :: NH.Method -- ^ Method +_mkRequest :: NH.Method -- ^ Method -> [BCL.ByteString] -- ^ Endpoint -> AlertmanagerRequest req contentType res accept -- ^ req: Request Type, res: Response Type _mkRequest m u = AlertmanagerRequest m u _mkParams [] @@ -263,13 +266,13 @@ removeHeader req header = _setContentTypeHeader :: forall req contentType res accept. MimeType contentType => AlertmanagerRequest req contentType res accept -> AlertmanagerRequest req contentType res accept _setContentTypeHeader req = - case mimeType (P.Proxy :: P.Proxy contentType) of + case mimeType (P.Proxy :: P.Proxy contentType) of Just m -> req `setHeader` [("content-type", BC.pack $ P.show m)] Nothing -> req `removeHeader` ["content-type"] _setAcceptHeader :: forall req contentType res accept. MimeType accept => AlertmanagerRequest req contentType res accept -> AlertmanagerRequest req contentType res accept _setAcceptHeader req = - case mimeType (P.Proxy :: P.Proxy accept) of + case mimeType (P.Proxy :: P.Proxy accept) of Just m -> req `setHeader` [("accept", BC.pack $ P.show m)] Nothing -> req `removeHeader` ["accept"] @@ -293,25 +296,25 @@ addQuery :: addQuery req query = req & L.over (rParamsL . paramsQueryL) (query P.++) addForm :: AlertmanagerRequest req contentType res accept -> WH.Form -> AlertmanagerRequest req contentType res accept -addForm req newform = +addForm req newform = let form = case paramsBody (rParams req) of ParamBodyFormUrlEncoded _form -> _form _ -> mempty in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form)) _addMultiFormPart :: AlertmanagerRequest req contentType res accept -> NH.Part -> AlertmanagerRequest req contentType res accept -_addMultiFormPart req newpart = +_addMultiFormPart req newpart = let parts = case paramsBody (rParams req) of ParamBodyMultipartFormData _parts -> _parts _ -> [] in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts)) _setBodyBS :: AlertmanagerRequest req contentType res accept -> B.ByteString -> AlertmanagerRequest req contentType res accept -_setBodyBS req body = +_setBodyBS req body = req & L.set (rParamsL . paramsBodyL) (ParamBodyB body) _setBodyLBS :: AlertmanagerRequest req contentType res accept -> BL.ByteString -> AlertmanagerRequest req contentType res accept -_setBodyLBS req body = +_setBodyLBS req body = req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body) _hasAuthType :: AuthMethod authMethod => AlertmanagerRequest req contentType res accept -> P.Proxy authMethod -> AlertmanagerRequest req contentType res accept @@ -335,6 +338,16 @@ toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem] toQuery x = [(fmap . fmap) toQueryParam x] where toQueryParam = T.encodeUtf8 . WH.toQueryParam +toPartialEscapeQuery :: B.ByteString -> NH.Query -> NH.PartialEscapeQuery +toPartialEscapeQuery extraUnreserved query = fmap (\(k, v) -> (k, maybe [] go v)) query + where go :: B.ByteString -> [NH.EscapeItem] + go v = v & B.groupBy (\a b -> a `B.notElem` extraUnreserved && b `B.notElem` extraUnreserved) + & fmap (\xs -> if B.null xs then NH.QN xs + else if B.head xs `B.elem` extraUnreserved + then NH.QN xs -- Not Encoded + else NH.QE xs -- Encoded + ) + -- *** OpenAPI `CollectionFormat` Utils -- | Determines the format of the array if type array is used. @@ -380,7 +393,7 @@ _toCollA' c encode one xs = case c of {-# INLINE go #-} {-# INLINE expandList #-} {-# INLINE combine #-} - + -- * AuthMethods -- | Provides a method to apply auth methods to requests @@ -411,11 +424,11 @@ _applyAuthMethods req config@(AlertmanagerClientConfig {configAuthMethods = as}) foldlM go req as where go r (AnyAuthMethod a) = applyAuthMethod config a r - + -- * Utils -- | Removes Null fields. (OpenAPI-Specification 2.0 does not allow Null in JSON) -_omitNulls :: [(Text, A.Value)] -> A.Value +_omitNulls :: [(A.Key, A.Value)] -> A.Value _omitNulls = A.object . P.filter notNull where notNull (_, A.Null) = False @@ -504,7 +517,7 @@ _showDate = -- * Byte/Binary Formatting - + -- | base64 encoded characters newtype ByteArray = ByteArray { unByteArray :: BL.ByteString } deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData) @@ -560,4 +573,4 @@ _showBinaryBase64 = T.decodeUtf8 . BL.toStrict . BL64.encode . unBinary -- * Lens Type Aliases type Lens_' s a = Lens_ s s a a -type Lens_ s t a b = forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t +type Lens_ s t a b = forall (f :: K.Type -> K.Type). Functor f => (a -> f b) -> s -> f t diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingKatip.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingKatip.hs index 4dcf68a..0b86fe1 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingKatip.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingKatip.hs @@ -34,11 +34,11 @@ import qualified Katip as LG -- * Type Aliases (for compatibility) -- | Runs a Katip logging block with the Log environment -type LogExecWithContext = forall m. P.MonadIO m => - LogContext -> LogExec m +type LogExecWithContext = forall m a. P.MonadIO m => + LogContext -> LogExec m a -- | A Katip logging block -type LogExec m = forall a. LG.KatipT m a -> m a +type LogExec m a = LG.KatipT m a -> m a -- | A Katip Log environment type LogContext = LG.LogEnv @@ -115,4 +115,3 @@ levelError = LG.ErrorS levelDebug :: LogLevel levelDebug = LG.DebugS - diff --git a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingMonadLogger.hs b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingMonadLogger.hs index 2bed805..eca756c 100644 --- a/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingMonadLogger.hs +++ b/alertmanager-openapi/lib/Network/Alertmanager/OpenAPI/LoggingMonadLogger.hs @@ -24,7 +24,6 @@ import qualified Control.Monad.IO.Class as P import qualified Data.Text as T import qualified Data.Time as TI -import Data.Monoid ((<>)) import Data.Text (Text) import qualified Control.Monad.Logger as LG @@ -32,11 +31,11 @@ import qualified Control.Monad.Logger as LG -- * Type Aliases (for compatibility) -- | Runs a monad-logger block with the filter predicate -type LogExecWithContext = forall m. P.MonadIO m => - LogContext -> LogExec m +type LogExecWithContext = forall m a. P.MonadIO m => + LogContext -> LogExec m a -- | A monad-logger block -type LogExec m = forall a. LG.LoggingT m a -> m a +type LogExec m a = LG.LoggingT m a -> m a -- | A monad-logger filter predicate type LogContext = LG.LogSource -> LG.LogLevel -> Bool diff --git a/alertmanager-openapi/shell.nix b/alertmanager-openapi/shell.nix new file mode 100644 index 0000000..eacf6cd --- /dev/null +++ b/alertmanager-openapi/shell.nix @@ -0,0 +1,17 @@ +{ nixpkgs ? import ../nix/pin.nix {}, compiler ? "default", doBenchmark ? false }: + +let + + inherit (nixpkgs) pkgs; + + haskellPackages = if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler}; + + variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; + + drv = variant (haskellPackages.callPackage ./. {}); + +in + + if pkgs.lib.inNixShell then drv.env else drv diff --git a/alertmanager-openapi/stack.yaml b/alertmanager-openapi/stack.yaml index 3668952..940a7cd 100644 --- a/alertmanager-openapi/stack.yaml +++ b/alertmanager-openapi/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-14.27 +resolver: lts-18.6 build: haddock-arguments: haddock-args: diff --git a/alertmanager-openapi/tests/Instances.hs b/alertmanager-openapi/tests/Instances.hs index 75ddb65..4f14535 100644 --- a/alertmanager-openapi/tests/Instances.hs +++ b/alertmanager-openapi/tests/Instances.hs @@ -51,27 +51,6 @@ instance Arbitrary Date where arbitrary = Date <$> arbitrary shrink (Date xs) = Date <$> shrink xs --- | A naive Arbitrary instance for A.Value: -instance Arbitrary A.Value where - arbitrary = frequency [(3, simpleTypes), (1, arrayTypes), (1, objectTypes)] - where - simpleTypes :: Gen A.Value - simpleTypes = - frequency - [ (1, return A.Null) - , (2, liftM A.Bool (arbitrary :: Gen Bool)) - , (2, liftM (A.Number . fromIntegral) (arbitrary :: Gen Int)) - , (2, liftM (A.String . T.pack) (arbitrary :: Gen String)) - ] - mapF (k, v) = (T.pack k, v) - simpleAndArrays = frequency [(1, sized sizedArray), (4, simpleTypes)] - arrayTypes = sized sizedArray - objectTypes = sized sizedObject - sizedArray n = liftM (A.Array . V.fromList) $ replicateM n simpleTypes - sizedObject n = - liftM (A.object . map mapF) $ - replicateM n $ (,) <$> (arbitrary :: Gen String) <*> simpleAndArrays - -- | Checks if a given list has no duplicates in _O(n log n)_. hasNoDups :: (Ord a) diff --git a/nix/pin.nix b/nix/pin.nix new file mode 100644 index 0000000..f0b1c1a --- /dev/null +++ b/nix/pin.nix @@ -0,0 +1,6 @@ +let + # release-21.11, committed on May 23 2022 + rev = "a790b646e0634695782876f45d98f93c38ceae1d"; + url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz"; +in +import (builtins.fetchTarball url) diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..a522b67 --- /dev/null +++ b/shell.nix @@ -0,0 +1,4 @@ +{pkgs ? import ./nix/pin.nix {} }: +pkgs.mkShell { + packages = [ pkgs.openapi-generator-cli ]; +}