alerta 0.1.0.5 → 0.1.0.6

raw patch · 4 files changed

+135/−57 lines, 4 filesdep +servant-client-coredep ~aesondep ~servant-clientPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: servant-client-core

Dependency ranges changed: aeson, servant-client

API changes (from Hackage documentation)

Files

• alerta.cabal +27/−13
• src/Alerta/Auth.hs +43/−14
• src/Alerta/Helpers.hs +26/−9
• src/Alerta/ServantExtras.hs +39/−21

@@ -1,5 +1,5 @@ name:                alerta-version:             0.1.0.5+version:             0.1.0.6 synopsis:            Bindings to the alerta REST API homepage:            https://github.com/mjhopkins/alerta-client bug-reports:         https://github.com/mjhopkins/alerta-client/issues@@ -22,6 +22,11 @@   .   Built with <http://hackage.haskell.org/package/servant Servant>. +flag servant-client-core+  description: Use servant-client-core+  default:     True+  manual:      False+ library   hs-source-dirs:      src   exposed-modules:     Alerta@@ -30,18 +35,27 @@                      , Alerta.ServantExtras                      , Alerta.Types                      , Alerta.Util-  build-depends:       aeson          >= 1.1   && < 1.3-                     , aeson-pretty   >= 0.8   && < 0.9-                     , base           >= 4.7   && < 5-                     , containers     >= 0.5   && < 0.6-                     , data-default   >= 0.7   && < 0.8-                     , http-api-data  >= 0.3   && < 0.4-                     , http-client    >= 0.5   && < 0.6-                     , servant        >= 0.10  && < 0.13-                     , servant-client >= 0.10  && < 0.13-                     , servant-server >= 0.10  && < 0.13-                     , text           >= 1.2.2 && < 1.3-                     , time           >= 1.6   && < 1.9+  build-depends:       aeson          >= 1.0.2.1 && < 1.3+                     , aeson-pretty   >= 0.8     && < 0.9+                     , base           >= 4.7     && < 5+                     , containers     >= 0.5     && < 0.6+                     , data-default   >= 0.7     && < 0.8+                     , http-api-data  >= 0.3     && < 0.4+                     , http-client    >= 0.5     && < 0.6+                     , servant        >= 0.10    && < 0.13+                     , servant-client >= 0.10    && < 0.13+                     , servant-server >= 0.10    && < 0.13+                     , text           >= 1.2.2   && < 1.3+                     , time           >= 1.6     && < 1.9++  if flag(servant-client-core)+    cpp-options: -DHAS_CLIENT_CORE=1+    build-depends:+      servant-client-core >= 0.12 && < 0.13+  else+    build-depends:+      servant-client      >= 0.10  && < 0.12+   ghc-options:         -Wall   default-language:    Haskell2010 

@@ -1,10 +1,12 @@-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE DeriveDataTypeable  #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}  -------------------------------------------------------------------------------- -- |@@ -17,34 +19,61 @@   , NeedApiKey   ) where -import           Alerta.Types       (ApiKey (..))+import           Alerta.Types        (ApiKey (..)) -import           Data.Monoid        ((<>))-import           Data.Proxy-import           Data.Typeable      (Typeable)-import           Servant.API        ((:>))+import           Data.Monoid         ((<>))+import           Data.Proxy          (Proxy (..))+import           Data.Typeable       (Typeable)+import           Servant.API         ((:>))++-- #if MIN_VERSION_servant_client(0,12,0)+#ifdef HAS_CLIENT_CORE+import           Servant.Client.Core (AuthClientData, HasClient (..), Request,+                                      addHeader)+#define REQ Request+#else import           Servant.Client-import           Servant.Common.Req (Req, addHeader)+import           Servant.Common.Req  (Req, addHeader)+#define REQ Req+#endif  data NeedApiKey deriving Typeable data WithApiKey deriving Typeable  -- | Authenticate a request using an API key-addApiKey :: ApiKey -> Req -> Req+addApiKey :: ApiKey -> REQ -> REQ addApiKey (ApiKey key) = addHeader "Authorization" ("Key " <> key)  type instance AuthClientData NeedApiKey = ApiKey +-- #ifdef HAS_CLIENT_CORE+#if !MIN_VERSION_servant_client(0,12,0) instance HasClient api => HasClient (NeedApiKey :> api) where   type Client (NeedApiKey :> api) = ApiKey -> Client api    clientWithRoute _ req k =     clientWithRoute (Proxy :: Proxy api) (addApiKey k req)+#else+instance HasClient m api => HasClient m (NeedApiKey :> api) where+  type Client m (NeedApiKey :> api) = ApiKey -> Client m api +  clientWithRoute m _ req k =+    clientWithRoute m (Proxy :: Proxy api) (addApiKey k req)+#endif+ type instance AuthClientData WithApiKey = Maybe ApiKey +-- #ifdef HAS_CLIENT_CORE+#if !MIN_VERSION_servant_client(0,12,0) instance HasClient api => HasClient (WithApiKey :> api) where   type Client (WithApiKey :> api) = Maybe ApiKey -> Client api    clientWithRoute _ req m =     clientWithRoute (Proxy :: Proxy api) (maybe id addApiKey m req)+#else+instance HasClient m api => HasClient m (WithApiKey :> api) where+  type Client m (WithApiKey :> api) = Maybe ApiKey -> Client m api++  clientWithRoute m _ req mk =+    clientWithRoute m (Proxy :: Proxy api) (maybe id addApiKey mk req)+#endif

@@ -34,7 +34,7 @@ run :: (Show a, FromJSON a, ToJSON a) => ClientM a -> IO a run cl = do   manager <- newManager defaultManagerSettings-  res <- runClientM cl (clientEnv manager)+  res     <- runClientM cl (clientEnv manager)   either handleError (\r -> prettyPrint r >> putStrLn "Success" >> return r) res  -- | Run a Servant client function, pretty-printing the JSON returned, and@@ -43,14 +43,31 @@ run' = void . run  handleError :: (FromJSON a, ToJSON a) => ServantError -> IO a-#if MIN_VERSION_servant_client(0,11,0)-handleError (FailureResponse _ status _ b) = either fail (\r -> putStrLn ("Failure response (status " ++ show status ++ ")") >> prettyPrint r >> return r) (eitherDecode b)-#else+-- really, these should all be servant_client. But CPP.+#if !MIN_VERSION_servant(0,11,0) handleError (FailureResponse status _ b)   = either fail (\r -> putStrLn ("Failure response (status " ++ show status ++ ")") >> prettyPrint r >> return r) (eitherDecode b)+handleError (DecodeFailure e _ b)          = fail ("decode failure\n\n" ++ e ++ "\n\n" ++ showUnescaped b)+handleError (InvalidContentTypeHeader h b) = fail ("unsupported content type type\n\n" ++ show h ++ "\n" ++ show b) #endif+#if MIN_VERSION_servant(0,11,0) && !MIN_VERSION_servant(0,12,0)+handleError (FailureResponse _ status _ b) = either fail (\r -> putStrLn ("Failure response (status " ++ show status ++ ")") >> prettyPrint r >> return r) (eitherDecode b) handleError (DecodeFailure e _ b)          = fail ("decode failure\n\n" ++ e ++ "\n\n" ++ showUnescaped b)-handleError (UnsupportedContentType ct b)  = fail ("unsupported content type\n\n" ++ show ct ++ "\n" ++ show b) handleError (InvalidContentTypeHeader h b) = fail ("unsupported content type type\n\n" ++ show h ++ "\n" ++ show b)+#endif+#if MIN_VERSION_servant(0,12,0)+handleError (FailureResponse r) = either fail (\r -> putStrLn ("Failure response (status " ++ show status ++ ")") >> prettyPrint r >> return r) (eitherDecode b)+  where+    status = responseStatusCode r+    b      = responseBody r+handleError (DecodeFailure e r)          = fail ("decode failure\n\n" ++ T.unpack e ++ "\n\n" ++ showUnescaped b)+  where+    b = responseBody r+handleError (InvalidContentTypeHeader r) = fail ("unsupported content type type\n\n" ++ show h ++ "\n" ++ show b)+  where+    h = responseHeaders r+    b = responseBody r+#endif+handleError (UnsupportedContentType ct b)  = fail ("unsupported content type\n\n" ++ show ct ++ "\n" ++ show b) handleError (ConnectionError e)            = fail ("connection error\n\n" ++ show e)  showUnescaped :: Show a => a -> String@@ -62,10 +79,10 @@ replace :: [(String, String)] -> String -> String replace assocs s = T.unpack $ foldr replace' (T.pack s) assocs'   where-        assocs' :: [(Text, Text)]-        assocs'   = map (bimap T.pack T.pack) assocs-        replace' :: (Text, Text) -> Text -> Text-        replace' (a,b) = T.replace a b+    assocs' :: [(Text, Text)]+    assocs'   = map (bimap T.pack T.pack) assocs+    replace' :: (Text, Text) -> Text -> Text+    replace' (a,b) = T.replace a b  -- | Pretty-print the JSON encoding of the supplied value. prettyPrintEncoding :: ToJSON a => a -> IO ()

@@ -1,10 +1,12 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}  -------------------------------------------------------------------------------- -- Module: Alerta.ServantExtras@@ -16,16 +18,22 @@   ( FieldQueries   ) where -import           Alerta.Types       (FieldQuery, MatchType(..))+import           Alerta.Types        (FieldQuery, MatchType (..))  import           Data.List-import           Data.Monoid        ((<>))+import           Data.Monoid         ((<>)) import           Data.Proxy-import qualified Data.Text          as T--import           Servant.Common.Req (Req, appendToQueryString)+import qualified Data.Text           as T+import           Servant.API         ((:>))+#if MIN_VERSION_servant_client(0,12,0)+import           Servant.Client.Core (HasClient (..), Request,+                                      appendToQueryString)+#define REQ Request+#else import           Servant.Client-import           Servant.API        ((:>))+import           Servant.Common.Req  (Req, appendToQueryString)+#define REQ Req+#endif import           Web.HttpApiData  -- | We need this because Alerta for some reason requires `field` and `field!`@@ -36,17 +44,27 @@  data FieldQueries +#if !MIN_VERSION_servant_client(0,12,0) instance HasClient api => HasClient (FieldQueries :> api) where   type Client (FieldQueries :> api) = [FieldQuery] -> Client api    clientWithRoute Proxy req fqs =-    clientWithRoute (Proxy :: Proxy api) $ foldl' (flip f) req fqs where+    clientWithRoute (Proxy :: Proxy api) $ foldl' (flip applyFQ) req fqs -      f :: FieldQuery -> Req -> Req-      f (attr, txt, t, b) = appendToQueryString k (Just v) where-        k = toUrlPiece attr <> suffix-        v = prefix <> txt-        suffix = if b then "" else "!"-        prefix = case t of-          Regex   -> "~"-          Literal -> ""+#else+instance HasClient m api => HasClient m (FieldQueries :> api) where+  type Client m (FieldQueries :> api) = [FieldQuery] -> Client m api++  clientWithRoute m Proxy req fqs =+    clientWithRoute m (Proxy :: Proxy api) $ foldl' (flip applyFQ) req fqs++#endif++applyFQ :: FieldQuery -> REQ -> REQ+applyFQ (attr, txt, t, b) = appendToQueryString k (Just v) where+  k = toUrlPiece attr <> suffix+  v = prefix <> txt+  suffix = if b then "" else "!"+  prefix = case t of+    Regex   -> "~"+    Literal -> ""