From e2d17322ed3585759e95934a69443cb5576eb0fc Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Mon, 27 Mar 2023 19:51:20 +0300
Subject: [PATCH] accepted 6Dpwned28fg ettime-non-linux

---
 docs/devlog.md                                 |  7 +++++++
 flake.lock                                     |  6 +++---
 flake.nix                                      |  2 +-
 hbs2-core/lib/HBS2/Clock.hs                    | 12 ++++++++++--
 hbs2-peer/app/BlockDownload.hs                 |  3 +--
 hbs2-peer/app/PeerTypes.hs                     |  6 ++----
 hbs2-storage-simple/lib/HBS2/Storage/Simple.hs |  5 +----
 7 files changed, 25 insertions(+), 16 deletions(-)

diff --git a/docs/devlog.md b/docs/devlog.md
index d187fb70..4e9f63bf 100644
--- a/docs/devlog.md
+++ b/docs/devlog.md
@@ -1,3 +1,10 @@
+## 2023-03-27
+
+PR: gettime-non-linux
+  branch: pr-gettime-non-linux
+  commit: a2cd4d575f965dc9c71b69a1355d6603129f2373
+  Исправляет получение текущего времени для MacOS.
+  Также добавлены "x86_64-darwin" и "aarch64-darwin" во flake.nix.
 
 ## 2023-03-27
 
diff --git a/flake.lock b/flake.lock
index 4fa12a2b..c41c492b 100644
--- a/flake.lock
+++ b/flake.lock
@@ -197,11 +197,11 @@
         ]
       },
       "locked": {
-        "lastModified": 1672641093,
-        "narHash": "sha256-v0Uj3gkDWPdnXZUKpJGD7RxIOncTexhN0csIop36yug=",
+        "lastModified": 1679933705,
+        "narHash": "sha256-UOd70L+FKQLmGjA3IqjFaBpaS/dZMSABtRgVDY3lBCg=",
         "owner": "voidlizard",
         "repo": "hspup",
-        "rev": "031d27dea1505fd68cd603da7e72eb5eefd348fd",
+        "rev": "6b969a9de1f9800ebfc61c51252b8647123c51bb",
         "type": "github"
       },
       "original": {
diff --git a/flake.nix b/flake.nix
index d66b6aba..baddc891 100644
--- a/flake.nix
+++ b/flake.nix
@@ -26,7 +26,7 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
 
  haskell-flake-utils.lib.simpleCabalProject2flake {
    inherit self nixpkgs;
-   systems = [ "x86_64-linux" "aarch64-linux" ];
+   systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
    name = "hbs2";
 
    haskellFlakes = with inputs; [
diff --git a/hbs2-core/lib/HBS2/Clock.hs b/hbs2-core/lib/HBS2/Clock.hs
index 6454aa09..6d6db9cb 100644
--- a/hbs2-core/lib/HBS2/Clock.hs
+++ b/hbs2-core/lib/HBS2/Clock.hs
@@ -1,4 +1,5 @@
 {-# Language FunctionalDependencies #-}
+{-# LANGUAGE CPP #-}
 module HBS2.Clock
   ( module HBS2.Clock
   , module System.Clock
@@ -71,5 +72,12 @@ class Expires a where
   -- FIXME: dangerous!
   expiresIn _ = Nothing
 
-
-
+-- | Use coarse clock timer. This timer has 1ms resolution but is much
+-- faster comparing to the ordinary one. Is used on Linux, on MacOS
+-- provides ordinary one.
+getTimeCoarse :: IO TimeSpec
+#ifdef linux_HOST_OS
+getTimeCoarse = getTime MonotonicCoarse
+#else
+getTimeCoarse = getTime Monotonic
+#endif
diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs
index e3aff81c..e6ed9c76 100644
--- a/hbs2-peer/app/BlockDownload.hs
+++ b/hbs2-peer/app/BlockDownload.hs
@@ -312,8 +312,7 @@ instance HasPeerLocator e m => HasPeerLocator e (BlockDownloadM e m) where
 updatePeerInfo :: MonadIO m => Bool -> PeerInfo e -> m ()
 updatePeerInfo onError pinfo = do
 
-  -- FIXME: macos-support-3
-  t1 <- liftIO $ getTime MonotonicCoarse
+  t1 <- liftIO getTimeCoarse
 
   void $ liftIO $ atomically $ do
 
diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs
index cf456b58..33fd3da4 100644
--- a/hbs2-peer/app/PeerTypes.hs
+++ b/hbs2-peer/app/PeerTypes.hs
@@ -204,8 +204,7 @@ fetchBlockState :: MonadIO m => Hash HbSync -> BlockDownloadM e m BlockState
 fetchBlockState h = do
   sh <- asks (view blockState)
   liftIO do
-    -- FIXME: macos-support-2
-    now     <- getTime MonotonicCoarse
+    now     <- getTimeCoarse
     tvlast  <- newTVarIO now
     tvreq   <- newTVarIO 0
     tvsz    <- newTVarIO False
@@ -232,8 +231,7 @@ delBlockState h = do
 incBlockSizeReqCount :: MonadIO m => Hash HbSync -> BlockDownloadM e m ()
 incBlockSizeReqCount h = do
   blk  <- fetchBlockState h
-  -- FIXME: macos-support-4
-  now  <- liftIO $ getTime MonotonicCoarse
+  now  <- liftIO getTimeCoarse
   seen <- liftIO $ readTVarIO (view bsLastSeen blk)
   let elapsed = realToFrac (toNanoSecs (now - seen))  / 1e9
   noSize <- liftIO $ readTVarIO (view bsHasSize blk) <&> not
diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
index 428edf35..53f7c8d7 100644
--- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
+++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
@@ -105,10 +105,7 @@ touchForRead ss k  = liftIO $ do
 
       bsmm <- unsafeMMapFile (simpleBlockFileName ss k)
 
-      -- FIXME: macos-support-1
-      --  вынести функцию в библиотеку
-      --  обернуть в CPP
-      tick <- getTime MonotonicCoarse
+      tick <- getTimeCoarse
 
       atomically $ do
         modifyTVar' mmaped (HashMap.insert k bsmm)