factor out Utility.MonotonicClock
This commit is contained in:
parent
543c610a31
commit
5b6150e5d5
5 changed files with 30 additions and 15 deletions
|
@ -24,6 +24,7 @@ import Logs.Location
|
|||
import Types.NumCopies
|
||||
import Utility.Metered
|
||||
import Utility.HumanTime
|
||||
import Utility.MonotonicClock
|
||||
import Annex.Verify
|
||||
|
||||
import Control.Monad.Free
|
||||
|
@ -117,7 +118,7 @@ runLocal runst runner a = case a of
|
|||
let checkts = case mts of
|
||||
Nothing -> return True
|
||||
Just ts -> do
|
||||
now <- liftIO getMonotonicTimestampIO
|
||||
now <- liftIO currentMonotonicTimestamp
|
||||
return (now < ts)
|
||||
v <- tryNonAsync $
|
||||
ifM (Annex.Content.inAnnex k)
|
||||
|
|
13
P2P/IO.hs
13
P2P/IO.hs
|
@ -25,7 +25,6 @@ module P2P.IO
|
|||
, describeProtoFailure
|
||||
, runNetProto
|
||||
, runNet
|
||||
, getMonotonicTimestampIO
|
||||
) where
|
||||
|
||||
import Common
|
||||
|
@ -39,6 +38,7 @@ import Utility.Metered
|
|||
import Utility.Tor
|
||||
import Utility.FileMode
|
||||
import Utility.Debug
|
||||
import Utility.MonotonicClock
|
||||
import Types.UUID
|
||||
import Annex.ChangedRefs
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
@ -54,11 +54,6 @@ import qualified Data.ByteString as B
|
|||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Network.Socket as S
|
||||
import System.PosixCompat.Files (groupReadMode, groupWriteMode, otherReadMode, otherWriteMode)
|
||||
#if MIN_VERSION_clock(0,3,0)
|
||||
import qualified System.Clock as Clock
|
||||
#else
|
||||
import qualified System.Posix.Clock as Clock
|
||||
#endif
|
||||
|
||||
-- Type of interpreters of the Proto free monad.
|
||||
type RunProto m = forall a. Proto a -> m (Either ProtoFailure a)
|
||||
|
@ -289,7 +284,7 @@ runNet runst conn runner f = case f of
|
|||
GetProtocolVersion next ->
|
||||
liftIO (readTVarIO versiontvar) >>= runner . next
|
||||
GetMonotonicTimestamp next ->
|
||||
liftIO getMonotonicTimestampIO >>= runner . next
|
||||
liftIO currentMonotonicTimestamp >>= runner . next
|
||||
where
|
||||
-- This is only used for running Net actions when relaying,
|
||||
-- so it's ok to use runNetProto, despite it not supporting
|
||||
|
@ -460,7 +455,3 @@ relayReader v hout = loop
|
|||
else getsome (b:bs)
|
||||
|
||||
chunk = 65536
|
||||
|
||||
getMonotonicTimestampIO :: IO MonotonicTimestamp
|
||||
getMonotonicTimestampIO = (MonotonicTimestamp . fromIntegral . Clock.sec)
|
||||
<$> Clock.getTime Clock.Monotonic
|
||||
|
|
|
@ -26,6 +26,7 @@ import Utility.Applicative
|
|||
import Utility.PartialPrelude
|
||||
import Utility.Metered
|
||||
import Utility.FileSystemEncoding
|
||||
import Utility.MonotonicClock
|
||||
import Git.FilePath
|
||||
import Annex.ChangedRefs (ChangedRefs)
|
||||
|
||||
|
@ -71,9 +72,6 @@ data Validity = Valid | Invalid
|
|||
newtype Bypass = Bypass (S.Set UUID)
|
||||
deriving (Show, Monoid, Semigroup)
|
||||
|
||||
newtype MonotonicTimestamp = MonotonicTimestamp Integer
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- | Messages in the protocol. The peer that makes the connection
|
||||
-- always initiates requests, and the other peer makes responses to them.
|
||||
data Message
|
||||
|
|
24
Utility/MonotonicClock.hs
Normal file
24
Utility/MonotonicClock.hs
Normal file
|
@ -0,0 +1,24 @@
|
|||
{- Monotonic clocks
|
||||
-
|
||||
- Copyright 2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.MonotonicClock where
|
||||
|
||||
#if MIN_VERSION_clock(0,3,0)
|
||||
import qualified System.Clock as Clock
|
||||
#else
|
||||
import qualified System.Posix.Clock as Clock
|
||||
#endif
|
||||
|
||||
newtype MonotonicTimestamp = MonotonicTimestamp Integer
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
currentMonotonicTimestamp :: IO MonotonicTimestamp
|
||||
currentMonotonicTimestamp =
|
||||
(MonotonicTimestamp . fromIntegral . Clock.sec)
|
||||
<$> Clock.getTime Clock.Monotonic
|
|
@ -1009,6 +1009,7 @@ Executable git-annex
|
|||
Utility.Base64
|
||||
Utility.Batch
|
||||
Utility.Bloom
|
||||
Utility.MonotonicClock
|
||||
Utility.CoProcess
|
||||
Utility.CopyFile
|
||||
Utility.Daemon
|
||||
|
|
Loading…
Add table
Reference in a new issue