factor out Utility.MonotonicClock

This commit is contained in:
Joey Hess 2024-07-03 17:54:01 -04:00
parent 543c610a31
commit 5b6150e5d5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 30 additions and 15 deletions

View file

@ -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)

View file

@ -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

View file

@ -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
View 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

View file

@ -1009,6 +1009,7 @@ Executable git-annex
Utility.Base64
Utility.Batch
Utility.Bloom
Utility.MonotonicClock
Utility.CoProcess
Utility.CopyFile
Utility.Daemon