ngx-export-tools-extra 1.2.13 → 1.2.13.1
raw patch · 3 files changed
+23/−20 lines, 3 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Changelog.md +8/−0
- NgxExport/Tools/Aggregate.hs +13/−18
- ngx-export-tools-extra.cabal +2/−2
Changelog.md view
@@ -1,3 +1,11 @@+### 1.2.13.1++- Module *NgxExport.Tools.Aggregate*.+ + Remove unnecessary wrapping of the reported value in *Maybe*.+ + Drop dependency on modules from package *text*.+- Drop support for GHC versions older than *9.6* due to the updated constraints+ in revision *3* of package *base64-1.0* on Hackage.+ ### 1.2.13 - Module *NgxExport.Tools.Prometheus*.
NgxExport/Tools/Aggregate.hs view
@@ -65,8 +65,6 @@ import Text.Read #ifdef SNAP_AGGREGATE_SERVER-import qualified Data.Text as T-import qualified Data.Text.Encoding as T import Control.Monad.IO.Class import Control.Exception.Enclosed (handleAny) import Snap.Http.Server@@ -77,7 +75,7 @@ type AggregateValue a = (UTCTime, Map Int32 (UTCTime, Maybe a)) type Aggregate a = IORef (AggregateValue a) -type ReportValue a = Maybe (Int32, Maybe a)+type ReportValue a = (Int32, Maybe a) -- $aggregateServiceExporter --@@ -310,9 +308,8 @@ toNominalDiffTime = secondsToNominalDiffTime . asIntegerPart . fromIntegral . toSec -updateAggregate :: Aggregate a -> ReportValue a -> NominalDiffTime -> IO ()-updateAggregate a s int = do- let (pid, v) = fromJust s+updateAggregate :: Aggregate a -> NominalDiffTime -> ReportValue a -> IO ()+updateAggregate a int (!pid, !v) = do !t <- getCurrentTime atomicModifyIORef' a $ \(t', v') ->@@ -337,11 +334,10 @@ receiveAggregate :: FromJSON a => Aggregate a -> LazyByteString -> ByteString -> IO LazyByteString receiveAggregate a v sint = do- let !s = decode' v- !int = toNominalDiffTime $+ let !int = toNominalDiffTime $ fromMaybe (Min 5) $ readMaybe $ C8.unpack sint- when (isNothing s) $ throwUserError "Unreadable aggregate!"- updateAggregate a (fromJust s) int+ maybe (throwUserError "Unreadable aggregate!")+ (updateAggregate a int) $ decode' v return "done" sendAggregate :: ToJSON a =>@@ -405,9 +401,9 @@ receiveAggregateSnap :: FromJSON a => Aggregate a -> NominalDiffTime -> Snap () receiveAggregateSnap a int = handleAggregateExceptions "Exception while receiving aggregate" $ do- !s <- decode' <$> readRequestBody 65536- when (isNothing s) $ liftIO $ throwUserError "Unreadable aggregate!"- liftIO $ updateAggregate a (fromJust s) int+ v <- readRequestBody 65536+ maybe (liftIO $ throwUserError "Unreadable aggregate!")+ (liftIO . updateAggregate a int) $ decode' v finishWith emptyResponse sendAggregateSnap :: ToJSON a => Aggregate a -> Snap ()@@ -417,12 +413,11 @@ modifyResponse $ setContentType "application/json" writeLBS $ encode s -handleAggregateExceptions :: String -> Snap () -> Snap ()-handleAggregateExceptions cmsg = handleAny $ \e ->- writeErrorResponse 500 $ show (e :: SomeException)+handleAggregateExceptions :: ByteString -> Snap () -> Snap ()+handleAggregateExceptions cmsg = handleAny $ writeErrorResponse 500 . show where writeErrorResponse c msg = do- modifyResponse $ setResponseStatus c $ T.encodeUtf8 $ T.pack cmsg- writeBS $ T.encodeUtf8 $ T.pack msg+ modifyResponse $ setResponseStatus c cmsg+ writeBS $ C8.pack msg #endif
ngx-export-tools-extra.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-tools-extra-version: 1.2.13+version: 1.2.13.1 synopsis: More extra tools for Nginx Haskell module description: More extra tools for <https://github.com/lyokha/nginx-haskell-module Nginx Haskell module>.@@ -30,7 +30,7 @@ library default-language: Haskell2010- build-depends: base >= 4.8 && < 5+ build-depends: base >= 4.18 && < 5 , template-haskell >= 2.11.0.0 , bytestring >= 0.11.2.0 , base64 >= 1.0