diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index 420ab9a8f..05464f1ae 100755 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -21,12 +21,9 @@ jobs: - "--resolver lts-21 --stack-yaml stack-lts-21.yaml" - "--resolver lts-20 --stack-yaml stack-lts-20.yaml" - "--resolver lts-19 --stack-yaml stack-lts-19.yaml" - - "--resolver lts-18 --stack-yaml stack-lts-18.yaml" exclude: - os: "macos-latest" args: "--resolver lts-19 --stack-yaml stack-lts-19.yaml" - - os: "macos-latest" - args: "--resolver lts-18 --stack-yaml stack-lts-18.yaml" steps: - name: Clone project @@ -34,7 +31,7 @@ jobs: # Not sure how to have GHC not setup twice # Something with settings "ghc-version"? - # ["9.8", "9.6", "9.4", "9.2", "9.0", "8.10"] + # ["9.8", "9.6", "9.4", "9.2", "9.0"] - uses: haskell-actions/setup@v2 name: Setup Haskell Stack with: diff --git a/auto-update/ChangeLog.md b/auto-update/ChangeLog.md index 3d6cf4b51..9a48985d3 100644 --- a/auto-update/ChangeLog.md +++ b/auto-update/ChangeLog.md @@ -1,5 +1,15 @@ # ChangeLog for auto-update +## 0.2.3 + +* [#996](https://github.com/yesodweb/wai/pull/996): + Refactored the `Control.Debounce` logic to not leak threads. +* [#996](https://github.com/yesodweb/wai/pull/996): + Added extra `DebounceEdge` options for different types of debouncing. + * `LeadingMute`: Action on first trigger, and ignore any triggers during cooldown + * `TrailingDelay`: First trigger starts cooldown, and + triggers during cooldown extend the cooldown. Action when cooldown expires. + ## 0.2.2 * NewAPI: updateThreadName, reaperThreadName, debounceThreadName: @@ -14,19 +24,19 @@ * Creating Reaper.Internal to export Reaper constructor. * Hiding Reaper constructor. -* Add `reaperModify` to the `Reaper` API, allowing workload modification outside +* [#985](https://github.com/yesodweb/wai/pull/985): + Add `reaperModify` to the `Reaper` API, allowing workload modification outside of the main `reaperAction` loop. - [#985](https://github.com/yesodweb/wai/pull/985) ## 0.1.6 -* Add control of activation on leading vs. trailing edges for Control.Debounce - [#756](https://github.com/yesodweb/wai/pull/756) +* [#756](https://github.com/yesodweb/wai/pull/756): + Add control of activation on leading vs. trailing edges for Control.Debounce ## 0.1.5 -* Using the Strict and StrictData language extensions for GHC >8. - [#752](https://github.com/yesodweb/wai/pull/752) +* [#752](https://github.com/yesodweb/wai/pull/752): + Using the Strict and StrictData language extensions for GHC >8. ## 0.1.4.1 diff --git a/auto-update/Control/AutoUpdate.hs b/auto-update/Control/AutoUpdate.hs index c8faac5ec..0c67a3be4 100644 --- a/auto-update/Control/AutoUpdate.hs +++ b/auto-update/Control/AutoUpdate.hs @@ -115,6 +115,11 @@ data UpdateSettings a = UpdateSettings -- -- @since 0.1.0 , updateThreadName :: String + -- ^ Label of the thread being forked. + -- + -- Default: @"AutoUpdate"@ + -- + -- @since 0.2.2 } -- | Generate an action which will either read from an automatically diff --git a/auto-update/Control/Debounce.hs b/auto-update/Control/Debounce.hs index ce7e06d50..db8faa17f 100644 --- a/auto-update/Control/Debounce.hs +++ b/auto-update/Control/Debounce.hs @@ -23,23 +23,27 @@ -- -- @since 0.1.2 module Control.Debounce ( - -- * Type + -- * Creation + mkDebounce, + + -- * Settings DI.DebounceSettings, defaultDebounceSettings, - -- * Accessors + -- ** Accessors DI.debounceFreq, DI.debounceAction, DI.debounceEdge, DI.debounceThreadName, + + -- ** Edge types DI.leadingEdge, + DI.leadingMuteEdge, DI.trailingEdge, - - -- * Creation - mkDebounce, + DI.trailingDelayEdge, ) where -import Control.Concurrent (newEmptyMVar, threadDelay) +import Control.Concurrent (newMVar, threadDelay) import qualified Control.Debounce.Internal as DI -- | Default value for creating a 'DebounceSettings'. @@ -56,8 +60,11 @@ defaultDebounceSettings = -- | Generate an action which will trigger the debounced action to be performed. -- +-- /N.B. The generated action will always immediately return, regardless of the 'debounceFreq',/ +-- /as the debounced action (and the delay\/cooldown) is always performed in a separate thread./ +-- -- @since 0.1.2 mkDebounce :: DI.DebounceSettings -> IO (IO ()) mkDebounce settings = do - baton <- newEmptyMVar + baton <- newMVar () DI.mkDebounceInternal baton threadDelay settings diff --git a/auto-update/Control/Debounce/Internal.hs b/auto-update/Control/Debounce/Internal.hs index 5e81ff519..bad5ce403 100644 --- a/auto-update/Control/Debounce/Internal.hs +++ b/auto-update/Control/Debounce/Internal.hs @@ -5,19 +5,24 @@ module Control.Debounce.Internal ( DebounceSettings (..), DebounceEdge (..), leadingEdge, + leadingMuteEdge, trailingEdge, + trailingDelayEdge, mkDebounceInternal, ) where import Control.Concurrent (forkIO) import Control.Concurrent.MVar ( MVar, - takeMVar, + newEmptyMVar, + putMVar, tryPutMVar, tryTakeMVar, ) import Control.Exception (SomeException, handle, mask_) -import Control.Monad (forever, void) +import Control.Monad (void, when) +import GHC.Clock (getMonotonicTimeNSec) +import GHC.Conc (atomically, newTVarIO, readTVar, readTVarIO, writeTVar) import GHC.Conc.Sync (labelThread) -- | Settings to control how debouncing should work. @@ -49,10 +54,15 @@ data DebounceSettings = DebounceSettings -- ^ Whether to perform the action on the leading edge or trailing edge of -- the timeout. -- - -- Default: 'trailingEdge'. + -- Default: 'leadingEdge'. -- -- @since 0.1.6 , debounceThreadName :: String + -- ^ Label of the thread spawned when debouncing. + -- + -- Default: @"Debounce"@. + -- + -- @since 0.2.2 } -- | Setting to control whether the action happens at the leading and/or trailing @@ -64,42 +74,224 @@ data DebounceEdge -- If the trigger happens again during the cooldown, wait until the end of the cooldown -- and then perform the action again, then enter a new cooldown period. Leading + | -- | Perform the action immediately, and then begin a cooldown period. + -- If the trigger happens again during the cooldown, it is ignored. + LeadingMute | -- | Start a cooldown period and perform the action when the period ends. If another trigger -- happens during the cooldown, it has no effect. Trailing + | -- | Start a cooldown period and perform the action when the period ends. If another trigger + -- happens during the cooldown, it restarts the cooldown again. + TrailingDelay deriving (Show, Eq) -- | Perform the action immediately, and then begin a cooldown period. -- If the trigger happens again during the cooldown, wait until the end of the cooldown -- and then perform the action again, then enter a new cooldown period. -- +-- Example of how this style debounce works: +-- +-- > ! = function execution +-- > . = cooldown period +-- > X = debounced code execution +-- > +-- > ! ! ! ! +-- > ....... ....... ....... ....... +-- > X X X X +-- -- @since 0.1.6 leadingEdge :: DebounceEdge leadingEdge = Leading --- | Start a cooldown period and perform the action when the period ends. If another trigger --- happens during the cooldown, it has no effect. +-- | Perform the action immediately, and then begin a cooldown period. +-- If the trigger happens again during the cooldown, it is ignored. +-- +-- Example of how this style debounce works: +-- +-- > ! = function execution +-- > . = cooldown period +-- > X = debounced code execution +-- > +-- > ! ! ! ! +-- > ....... ....... +-- > X X +-- +-- @since 0.1.6 +leadingMuteEdge :: DebounceEdge +leadingMuteEdge = LeadingMute + +-- | Start a cooldown period and perform the action when the period ends. +-- If another trigger happens during the cooldown, it has no effect. +-- +-- Example of how this style debounce works: +-- +-- @ +-- ! = function execution +-- . = cooldown period +-- X = debounced code execution +-- +-- ! ! ! ! +-- ....... ....... +-- X X +-- @ -- -- @since 0.1.6 trailingEdge :: DebounceEdge trailingEdge = Trailing +-- | Start a cooldown period and perform the action when the period ends. +-- If another trigger happens during the cooldown, it restarts the cooldown again. +-- +-- /N.B. If a trigger happens DURING the 'debounceAction' it starts a new cooldown./ +-- /So if the 'debounceAction' takes longer than the 'debounceFreq', it might run/ +-- /again before the previous action has ended./ +-- +-- Example of how this style debounce works: +-- +-- @ +-- ! = function execution +-- . = cooldown period +-- X = debounced code execution +-- +-- ! ! ! ! +-- ....... ............... +-- X X +-- @ +-- +-- @since 0.1.6 +trailingDelayEdge :: DebounceEdge +trailingDelayEdge = TrailingDelay + mkDebounceInternal :: MVar () -> (Int -> IO ()) -> DebounceSettings -> IO (IO ()) -mkDebounceInternal baton delayFn (DebounceSettings freq action edge name) = do - tid <- mask_ $ forkIO $ forever $ do - takeMVar baton - case edge of - Leading -> do - ignoreExc action - delayFn freq - Trailing -> do - delayFn freq - -- Empty the baton of any other activations during the interval - void $ tryTakeMVar baton - ignoreExc action - labelThread tid name - return $ void $ tryPutMVar baton () +mkDebounceInternal baton delayFn (DebounceSettings freq action edge name) = + case edge of + Leading -> leadingDebounce <$> newEmptyMVar + LeadingMute -> pure leadingMuteDebounce + Trailing -> pure trailingDebounce + TrailingDelay -> trailingDelayDebounce <$> newTVarIO minBound + where + -- LEADING + -- + -- 1) try take baton to start + -- 2) succes -> empty trigger & start worker, failed -> fill trigger + -- 3) worker do action + -- 4) delay + -- 5) try take trigger + -- 6) success -> repeat action, failed -> put baton back + leadingDebounce trigger = do + -- 1) + success <- tryTakeMVar baton + case success of + -- 2) + Nothing -> void $ tryPutMVar trigger () + Just () -> do + void $ tryTakeMVar trigger + forkAndLabel loop + where + loop = do + -- 3) + ignoreExc action + -- 4) + delayFn freq + -- 5) + isTriggered <- tryTakeMVar trigger + case isTriggered of + -- 6) + Nothing -> putMVar baton () + Just () -> loop + -- LEADING MUTE + -- + -- 1) try take baton to start + -- 2) success -> start worker, failed -> die + -- 3) worker delay + -- 4) do action + -- 5) put baton back + leadingMuteDebounce = do + -- 1) + success <- tryTakeMVar baton + case success of + -- 2) + Nothing -> pure () + Just () -> + forkAndLabel $ do + -- 3) + ignoreExc action + -- 4) + delayFn freq + -- 5) + putMVar baton () + -- TRAILING + -- + -- 1) try take baton to start + -- 2) success -> start worker, failed -> die + -- 3) worker delay + -- 4) do action + -- 5) put baton back + trailingDebounce = do + -- 1) + success <- tryTakeMVar baton + case success of + -- 2) + Nothing -> pure () + Just () -> + forkAndLabel $ do + -- 3) + delayFn freq + -- 4) + ignoreExc action + -- 5) + putMVar baton () + -- TRAILING DELAY + -- + -- 1) get current time -> /now/ + -- 2) try take baton to start + -- 3) success -> set time var to /now/ & start worker, failed -> update time var to /now/ + -- 4) worker waits minimum delay + -- 5) check diff of time var with /now/ + -- 6) less -> wait the difference, same/more -> do action + -- 7) after action, recheck if there was any trigger + -- 8) put baton back + trailingDelayDebounce timeTVar = do + -- 1) + now <- getMonotonicTimeNSec + -- 2) + success <- tryTakeMVar baton + case success of + -- 3) + Nothing -> atomically $ do + oldTime <- readTVar timeTVar + when (oldTime < now) $ writeTVar timeTVar now + Just () -> do + atomically $ writeTVar timeTVar now + forkAndLabel $ loop freq + where + loop delay = do + -- 4) + delayFn delay + lastTrigger <- readTVarIO timeTVar + now <- getMonotonicTimeNSec + -- 5) + let diff = fromIntegral (now - lastTrigger) `div` 1000 + shouldWait = diff < freq + if shouldWait + -- 6) + then loop $ freq - diff + else do + ignoreExc action + timeAfterAction <- readTVarIO timeTVar + -- 7) + let wasTriggered = timeAfterAction > now + if wasTriggered + then do + updatedNow <- getMonotonicTimeNSec + let newDiff = fromIntegral (updatedNow - timeAfterAction) `div` 1000 + loop $ freq - newDiff + -- 8) + else putMVar baton () + forkAndLabel act = do + tid <- mask_ $ forkIO act + labelThread tid name ignoreExc :: IO () -> IO () ignoreExc = handle $ \(_ :: SomeException) -> return () diff --git a/auto-update/Control/Reaper.hs b/auto-update/Control/Reaper.hs index 5f136dde3..0f1d76cb7 100644 --- a/auto-update/Control/Reaper.hs +++ b/auto-update/Control/Reaper.hs @@ -96,6 +96,11 @@ data ReaperSettings workload item = ReaperSettings -- -- @since 0.1.1 , reaperThreadName :: String + -- ^ Label of the thread spawned by the reaper. + -- + -- Default: @"Reaper"@. + -- + -- @since 0.2.2 } -- | Default @ReaperSettings@ value, biased towards having a list of work diff --git a/auto-update/auto-update.cabal b/auto-update/auto-update.cabal index ccac45c1b..3bb537197 100644 --- a/auto-update/auto-update.cabal +++ b/auto-update/auto-update.cabal @@ -1,5 +1,5 @@ name: auto-update -version: 0.2.2 +version: 0.2.3 synopsis: Efficiently run periodic, on-demand actions description: API docs and the README are available at . homepage: https://github.com/yesodweb/wai diff --git a/auto-update/test/Control/DebounceSpec.hs b/auto-update/test/Control/DebounceSpec.hs index 0be944077..748d544ed 100644 --- a/auto-update/test/Control/DebounceSpec.hs +++ b/auto-update/test/Control/DebounceSpec.hs @@ -1,14 +1,33 @@ +{-# LANGUAGE NumericUnderscores #-} module Control.DebounceSpec (main, spec) where -import Control.Concurrent -import Control.Debounce +import Control.Concurrent ( + MVar, + newEmptyMVar, + takeMVar, + putMVar, + newMVar, + threadDelay, + tryReadMVar, + ) +import Control.Debounce ( + DebounceSettings(..), + leadingEdge, + leadingMuteEdge, + trailingEdge, + trailingDelayEdge, + defaultDebounceSettings, + ) import qualified Control.Debounce.Internal as DI -import Control.Monad +import Control.Monad (void) import Control.Monad.Catch -import Control.Retry -import Data.IORef -import Test.HUnit.Lang -import Test.Hspec +import Control.Retry (recovering, constantDelay, limitRetries) +import Data.IORef (IORef, readIORef, newIORef, modifyIORef) +import Data.Word (Word64) +import GHC.Clock (getMonotonicTime) +import Test.Hspec (Spec, describe, it, shouldReturn, hspec) +import Test.HUnit (assertBool) +import Test.HUnit.Lang (HUnitFailure (HUnitFailure)) spec :: Spec spec = describe "mkDebounce" $ do @@ -43,6 +62,39 @@ spec = describe "mkDebounce" $ do returnFromWait pause readIORef ref `shouldReturn` 2 + describe "LeadingMute edge" $ do + it "works for a single event" $ do + (ref, debounced, _baton, returnFromWait) <- getDebounce leadingMuteEdge + + debounced + waitUntil 5 $ readIORef ref `shouldReturn` 1 + + returnFromWait + pause + readIORef ref `shouldReturn` 1 + + -- Try another round + debounced + waitUntil 5 $ readIORef ref `shouldReturn` 2 + + returnFromWait + pause + readIORef ref `shouldReturn` 2 + + it "works for multiple events" $ do + (ref, debounced, baton, returnFromWait) <- getDebounce leadingMuteEdge + + debounced + waitForBatonToBeTaken baton + debounced + pause + debounced + waitUntil 5 $ readIORef ref `shouldReturn` 1 + debounced + + returnFromWait + pause + readIORef ref `shouldReturn` 1 describe "Trailing edge" $ do it "works for a single event" $ do @@ -50,7 +102,7 @@ spec = describe "mkDebounce" $ do debounced pause - waitUntil 5 $ readIORef ref `shouldReturn` 0 + readIORef ref `shouldReturn` 0 returnFromWait waitUntil 5 $ readIORef ref `shouldReturn` 1 @@ -70,11 +122,54 @@ spec = describe "mkDebounce" $ do waitForBatonToBeTaken baton debounced pause - waitUntil 5 $ readIORef ref `shouldReturn` 0 + readIORef ref `shouldReturn` 0 returnFromWait waitUntil 5 $ readIORef ref `shouldReturn` 1 + describe "TrailingDelay edge" $ do + it "works for a single event" $ do + (ref, debounced, _baton, _returnFromWait) <- getDebounce' True trailingDelayEdge + + debounced + readIORef ref `shouldReturn` 0 + + waitUntil 1 $ readIORef ref `shouldReturn` 1 + + -- Try another round + debounced + readIORef ref `shouldReturn` 1 + + waitUntil 1 $ readIORef ref `shouldReturn` 2 + + it "works for multiple events" $ do + (ref, debounced, _baton, _returnFromWait) <- getDebounce' True trailingDelayEdge + + start <- getMonotonicTime + + debounced + readIORef ref `shouldReturn` 0 + -- Asserts at end check that this timing gets added to the cooldown time + threadDelay 500_000 + + readIORef ref `shouldReturn` 0 + before2nd <- getMonotonicTime + debounced + readIORef ref `shouldReturn` 0 + threadDelay 500_000 + + readIORef ref `shouldReturn` 0 + threadDelay 250_000 + + readIORef ref `shouldReturn` 0 + + waitUntil 1 $ readIORef ref `shouldReturn` 1 + end <- getMonotonicTime + assertBool "Took less than 1 sec after retrigger" $ + end - before2nd > 1 + assertBool "Took less than 1.5 sec total" $ + end - start > 1.5 + -- | Make a controllable delay function getWaitAction :: IO (p -> IO (), IO ()) getWaitAction = do @@ -83,22 +178,28 @@ getWaitAction = do let returnFromWait = putMVar waitVar () return (waitAction, returnFromWait) --- | Get a debounce system with access to the internals for testing getDebounce :: DI.DebounceEdge -> IO (IORef Int, IO (), MVar (), IO ()) -getDebounce edge = do +getDebounce = getDebounce' False + +-- | Get a debounce system with access to the internals for testing +getDebounce' :: Bool -> DI.DebounceEdge -> IO (IORef Int, IO (), MVar (), IO ()) +getDebounce' useThreadDelay edge = do ref <- newIORef 0 let action = modifyIORef ref (+ 1) - (waitAction, returnFromWait) <- getWaitAction + (waitAction, returnFromWait) <- + if useThreadDelay + then pure (threadDelay, pure ()) + else getWaitAction - baton <- newEmptyMVar + baton <- newMVar () debounced <- DI.mkDebounceInternal baton waitAction defaultDebounceSettings - { debounceFreq = 5000000 -- unused + { debounceFreq = 1_000_000 -- !!! used in 'TrailingDelay' test , debounceAction = action , debounceEdge = edge } @@ -107,14 +208,16 @@ getDebounce edge = do -- | Pause briefly (100ms) pause :: IO () -pause = threadDelay 100000 +pause = threadDelay 100_000 waitForBatonToBeTaken :: MVar () -> IO () -waitForBatonToBeTaken baton = waitUntil 5 $ tryReadMVar baton `shouldReturn` Nothing +waitForBatonToBeTaken baton = + waitUntil 5 $ tryReadMVar baton `shouldReturn` Nothing -- | Wait up to n seconds for an action to complete without throwing an HUnitFailure waitUntil :: Int -> IO a -> IO () -waitUntil n action = recovering policy [handler] (\_status -> void action) +waitUntil n action = + recovering policy [handler] (\_status -> void action) where policy = constantDelay 1000 `mappend` limitRetries (n * 1000) -- 1ms * n * 1000 tries = n seconds handler _status = Handler (\HUnitFailure{} -> return True) diff --git a/stack-lts-18.yaml b/stack-lts-18.yaml deleted file mode 100644 index 275761a25..000000000 --- a/stack-lts-18.yaml +++ /dev/null @@ -1,34 +0,0 @@ -resolver: lts-18.28 -packages: -- ./auto-update -- ./mime-types -- ./recv -- ./time-manager -- ./wai -- ./wai-app-static -- ./wai-conduit -- ./wai-extra -- ./wai-frontend-monadcgi -- ./wai-http2-extra -- ./wai-websockets -- ./warp -- ./warp-tls -flags: - wai-extra: - build-example: true -nix: - enable: false - packages: - - fcgi - - zlib -extra-deps: - - crypton-0.33 - - crypton-x509-1.7.6 - - crypton-x509-store-1.6.9 - - crypton-x509-validation-1.6.12 - - http-semantics-0.2.0 - - http2-5.3.1 - - network-byte-order-0.1.7 - - network-control-0.1.0 - - tls-1.7.0 - - unix-time-0.4.11 diff --git a/stack-lts-19.yaml b/stack-lts-19.yaml index c55b7ee60..b7b9dbfcf 100644 --- a/stack-lts-19.yaml +++ b/stack-lts-19.yaml @@ -12,7 +12,7 @@ packages: - ./wai-http2-extra - ./wai-websockets - ./warp -- ./warp-quic +# - ./warp-quic - ./warp-tls flags: wai-extra: @@ -24,23 +24,16 @@ nix: - zlib extra-deps: - basement-0.0.16 - - crypto-token-0.1.1 - - crypton-0.34 - - crypton-x509-1.7.6 + - crypto-token-0.1.2 + - crypton-1.0.1 + - crypton-x509-1.7.7 - crypton-x509-store-1.6.9 - - crypton-x509-system-1.6.7 - crypton-x509-validation-1.6.12 - - fast-logger-3.2.2 - - http-semantics-0.2.0 - - http2-5.3.1 - - http3-0.0.16 + - http-semantics-0.2.1 + - http2-5.3.4 - memory-0.18.0 - - network-3.1.4.0 - network-byte-order-0.1.7 - - network-control-0.1.0 - - network-udp-0.0.0 - - quic-0.2.1 - - sockaddr-0.0.1 - - tls-2.0.6 - - tls-session-manager-0.0.5 - - unix-time-0.4.12 + - network-control-0.1.3 + - tls-2.1.3 + - tls-session-manager-0.0.7 + - unix-time-0.4.16 diff --git a/stack-lts-20.yaml b/stack-lts-20.yaml index bd2049311..217a1a78f 100644 --- a/stack-lts-20.yaml +++ b/stack-lts-20.yaml @@ -12,7 +12,7 @@ packages: - ./wai-http2-extra - ./wai-websockets - ./warp -- ./warp-quic +# - ./warp-quic - ./warp-tls flags: wai-extra: @@ -24,23 +24,17 @@ nix: - zlib extra-deps: - cgi-3001.5.0.1 - - crypto-token-0.1.1 - - crypton-0.34 - - crypton-x509-1.7.6 + - crypto-token-0.1.2 + - crypton-1.0.1 + - crypton-x509-1.7.7 - crypton-x509-store-1.6.9 - - crypton-x509-system-1.6.7 - crypton-x509-validation-1.6.12 - - fast-logger-3.2.2 - - http-semantics-0.2.0 - - http2-5.3.1 - - http3-0.0.16 + - http-semantics-0.2.1 + - http2-5.3.4 - memory-0.18.0 - multipart-0.2.1 - network-byte-order-0.1.7 - - network-control-0.1.0 - - network-udp-0.0.0 - - quic-0.2.1 - - sockaddr-0.0.1 - - tls-2.0.6 - - tls-session-manager-0.0.5 - - unix-time-0.4.12 + - network-control-0.1.3 + - tls-2.1.3 + - tls-session-manager-0.0.7 + - unix-time-0.4.16 diff --git a/stack-lts-21.yaml b/stack-lts-21.yaml index 06c4c6f22..60b638e7e 100644 --- a/stack-lts-21.yaml +++ b/stack-lts-21.yaml @@ -12,7 +12,7 @@ packages: - ./wai-http2-extra - ./wai-websockets - ./warp -- ./warp-quic +# - ./warp-quic - ./warp-tls flags: wai-extra: @@ -23,19 +23,13 @@ nix: - fcgi - zlib extra-deps: - - crypto-token-0.1.1 - - crypton-1.0.0 - - crypton-x509-1.7.6 + - crypto-token-0.1.2 + - crypton-1.0.1 + - crypton-x509-1.7.7 - crypton-x509-store-1.6.9 - - crypton-x509-system-1.6.7 - crypton-x509-validation-1.6.12 - - http-semantics-0.2.0 - - http2-5.3.1 - - http3-0.0.16 - - network-control-0.1.0 - - network-udp-0.0.0 - - quic-0.2.1 - - sockaddr-0.0.1 - - tls-2.0.6 - - tls-session-manager-0.0.5 - - unix-time-0.4.12 + - http-semantics-0.2.1 + - http2-5.3.4 + - network-control-0.1.3 + - tls-2.1.3 + - tls-session-manager-0.0.7 diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 10a7f942d..8942b80ed 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -23,9 +23,8 @@ nix: - fcgi - zlib extra-deps: - - cgi-3001.5.0.1 - - http3-0.0.16 - - multipart-0.2.1 + - http3-0.0.18 - network-udp-0.0.0 - - quic-0.2.1 + - quic-0.2.3 - sockaddr-0.0.1 + - tls-2.1.3 diff --git a/stack.yaml b/stack.yaml index 6b19a4193..83a113b35 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-22.31 +resolver: lts-22.39 packages: - ./auto-update - ./mime-types @@ -23,13 +23,13 @@ nix: - fcgi - zlib extra-deps: - - crypto-token-0.1.1 + - crypto-token-0.1.2 - http-semantics-0.2.0 - http2-5.3.1 - http3-0.0.16 - network-control-0.1.0 - network-udp-0.0.0 - - quic-0.2.1 + - quic-0.2.3 - sockaddr-0.0.1 - - tls-2.0.6 - - tls-session-manager-0.0.5 + - tls-2.1.3 + - tls-session-manager-0.0.7 diff --git a/warp-tls/warp-tls.cabal b/warp-tls/warp-tls.cabal index 4fbad479e..cbbbdc78c 100644 --- a/warp-tls/warp-tls.cabal +++ b/warp-tls/warp-tls.cabal @@ -22,7 +22,7 @@ Library , bytestring >= 0.9 , wai >= 3.2 && < 3.3 , warp >= 3.3.29 && < 3.5 - , data-default >= 0.8 + , data-default , tls >= 1.7 && < 2.2 , network >= 2.2.1 , streaming-commons