factor out Utility.MonotonicClock

diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index 40152f2839d1fb38f14011176e6e7fcd2dd18ce8..533cd3a500e7d719fad5a0b659fc6801b8f440a6 100644 (file)
--- a/P2P/Annex.hs
+++ b/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)

diff --git a/P2P/IO.hs b/P2P/IO.hs
index aa52973b61aa85ead8c9683a1be7d4e71c9dfa10..cd725c6e9e4b91489dbf36801779361a1dfc384a 100644 (file)
--- a/P2P/IO.hs
+++ b/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

diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index da66e6aaeda4c76e21807c98a4a32334e76bf4a8..228e3cd1dab30d669d6f2e06655f1fa029acc1f2 100644 (file)
--- a/P2P/Protocol.hs
+++ b/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

diff --git a/Utility/MonotonicClock.hs b/Utility/MonotonicClock.hs
new file mode 100644 (file)
index 0000000..af5c20c
--- /dev/null
+++ b/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

diff --git a/git-annex.cabal b/git-annex.cabal
index 93dd3430836e837d9dcc14acbbfa13917be88a7f..5489c24b0e8122957b1d538d476504afbf2442cf 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1009,6 +1009,7 @@ Executable git-annex
     Utility.Base64
     Utility.Batch
     Utility.Bloom
+    Utility.MonotonicClock
     Utility.CoProcess
     Utility.CopyFile
     Utility.Daemon