e152c322f8Added to change notification to P2P protocol. Switched to a TBChan so that a single long-running thread can be started, and serve perhaps intermittent requests for change notifications, without buffering all changes in memory. The P2P runner currently starts up a new thread each times it waits for a change, but that should allow later reusing a thread. Although each connection from a peer will still need a new watcher thread to run. The dependency on stm-chans is more or less free; some stuff in yesod uses it, so it was already indirectly pulled in when building with the webapp. This commit was sponsored by Francois Marier on Patreon.
49 lines
1.1 KiB
Haskell
49 lines
1.1 KiB
Haskell
{- git-annex-shell command
|
|
-
|
|
- Copyright 2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.NotifyChanges where
|
|
|
|
import Command
|
|
import Annex.ChangedRefs
|
|
import Utility.DirWatcher
|
|
import Utility.DirWatcher.Types
|
|
import qualified Git
|
|
import Git.Sha
|
|
import RemoteDaemon.Transport.Ssh.Types
|
|
import Utility.SimpleProtocol
|
|
|
|
import Control.Concurrent
|
|
import Control.Concurrent.Async
|
|
import Control.Concurrent.STM
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $
|
|
command "notifychanges" SectionPlumbing
|
|
"sends notification when git refs are changed"
|
|
paramNothing (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withNothing start
|
|
|
|
start :: CommandStart
|
|
start = do
|
|
h <- watchChangedRefs
|
|
|
|
-- No messages need to be received from the caller,
|
|
-- but when it closes the connection, notice and terminate.
|
|
let receiver = forever $ void $ getProtocolLine stdin
|
|
let sender = forever $ send . CHANGED =<< waitChangedRefs h
|
|
|
|
liftIO $ send READY
|
|
void $ liftIO $ concurrently sender receiver
|
|
liftIO $ stopWatchingChangedRefs h
|
|
stop
|
|
|
|
send :: Notification -> IO ()
|
|
send n = do
|
|
putStrLn $ unwords $ formatMessage n
|
|
hFlush stdout
|