factor out Utility.MonotonicClock

P2P/Annex.hs

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

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

P2P/Protocol.hs

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

Utility/MonotonicClock.hs

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

git-annex.cabal

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