module Cachix.Client.WatchStore
  ( startWorkers,
  )
where

import Cachix.Client.Push
import qualified Cachix.Client.PushQueue as PushQueue
import qualified Control.Concurrent.STM.TBQueue as TBQueue
import Data.List (isSuffixOf)
import Hercules.CNix.Store (Store)
import qualified Hercules.CNix.Store as Store
import Protolude
import System.FSNotify

startWorkers :: Store -> Int -> PushParams IO () -> IO ()
startWorkers :: Store -> Int -> PushParams IO () -> IO ()
startWorkers Store
store Int
numWorkers PushParams IO ()
pushParams = do
  (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WatchManager
mgr -> Int -> (Queue -> IO (IO ())) -> PushParams IO () -> IO ()
PushQueue.startWorkers Int
numWorkers (Store -> WatchManager -> Queue -> IO (IO ())
producer Store
store WatchManager
mgr) PushParams IO ()
pushParams

producer :: Store -> WatchManager -> PushQueue.Queue -> IO (IO ())
producer :: Store -> WatchManager -> Queue -> IO (IO ())
producer Store
store WatchManager
mgr Queue
queue = do
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
"Watching /nix/store for new store paths ..."
  WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchDir WatchManager
mgr FilePath
"/nix/store" ActionPredicate
filterOnlyStorePaths (Store -> Queue -> Action
queueStorePathAction Store
store Queue
queue)

queueStorePathAction :: Store -> PushQueue.Queue -> Event -> IO ()
queueStorePathAction :: Store -> Queue -> Action
queueStorePathAction Store
store Queue
queue (Removed FilePath
lockFile UTCTime
_ Bool
_) = do
  StorePath
sp <- Store -> ByteString -> IO StorePath
Store.parseStorePath Store
store (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
dropLast Int
5 FilePath
lockFile)
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Queue -> StorePath -> STM ()
forall a. TBQueue a -> a -> STM ()
TBQueue.writeTBQueue Queue
queue StorePath
sp
queueStorePathAction Store
_ Queue
_ Event
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

dropLast :: Int -> [a] -> [a]
dropLast :: Int -> [a] -> [a]
dropLast Int
index [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
index) [a]
xs

-- we queue store paths after their lock has been removed
filterOnlyStorePaths :: ActionPredicate
filterOnlyStorePaths :: ActionPredicate
filterOnlyStorePaths (Removed FilePath
fp UTCTime
_ Bool
_)
  | FilePath
".drv.lock" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
  | FilePath
".lock" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
True
filterOnlyStorePaths Event
_ = Bool
False