fix build with xmpp and w/o webapp
This commit is contained in:
Joey Hess
parent
cfd3b16fe1
commit
3ef6b6a200
3 changed files with 27 additions and 37 deletions
|
|
@ -20,6 +20,7 @@ import qualified Remote
|
|||
import Utility.ThreadScheduler
|
||||
import Assistant.WebApp (UrlRenderer, renderUrl)
|
||||
import Assistant.WebApp.Types hiding (liftAssistant)
|
||||
import Assistant.WebApp.Configurators.XMPP (checkCloudRepos)
|
||||
import Assistant.Alert
|
||||
import Assistant.Pairing
|
||||
import Assistant.XMPP.Git
|
||||
|
|
@ -106,8 +107,9 @@ xmppClient urlrenderer d creds =
|
|||
maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c)
|
||||
handle _ (GotNetMessage m@(Pushing _ pushstage))
|
||||
| isPushInitiation pushstage = inAssistant $
|
||||
unlessM (queueNetPushMessage m) $
|
||||
void $ forkIO <~> handlePushInitiation urlrenderer m
|
||||
unlessM (queueNetPushMessage m) $ do
|
||||
let checker = checkCloudRepos urlrenderer
|
||||
void $ forkIO <~> handlePushInitiation checker m
|
||||
| otherwise = void $ inAssistant $ queueNetPushMessage m
|
||||
handle _ (Ignorable _) = noop
|
||||
handle _ (Unknown _) = noop
|
||||
|
|
|
|||
|
|
@ -50,21 +50,23 @@ xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do
|
|||
xmppNeeded = return ()
|
||||
#endif
|
||||
|
||||
{- Displays an alert suggesting to configure a cloud repo
|
||||
{- When appropriate, displays an alert suggesting to configure a cloud repo
|
||||
- to suppliment an XMPP remote. -}
|
||||
cloudRepoNeeded :: UrlRenderer -> UUID -> Assistant ()
|
||||
checkCloudRepos :: UrlRenderer -> Remote -> Assistant ()
|
||||
#ifdef WITH_XMPP
|
||||
cloudRepoNeeded urlrenderer for = do
|
||||
buddyname <- getBuddyName for
|
||||
url <- liftIO $ renderUrl urlrenderer (NeedCloudRepoR for) []
|
||||
close <- asIO1 removeAlert
|
||||
void $ addAlert $ cloudRepoNeededAlert buddyname $ AlertButton
|
||||
{ buttonLabel = "Add a cloud repository"
|
||||
, buttonUrl = url
|
||||
, buttonAction = Just close
|
||||
}
|
||||
checkCloudRepos urlrenderer r =
|
||||
unlessM (syncingToCloudRemote <$> getDaemonStatus) $ do
|
||||
buddyname <- getBuddyName $ Remote.uuid r
|
||||
url <- liftIO $
|
||||
renderUrl urlrenderer (NeedCloudRepoR $ Remote.uuid r) []
|
||||
close <- asIO1 removeAlert
|
||||
void $ addAlert $ cloudRepoNeededAlert buddyname $ AlertButton
|
||||
{ buttonLabel = "Add a cloud repository"
|
||||
, buttonUrl = url
|
||||
, buttonAction = Just close
|
||||
}
|
||||
#else
|
||||
cloudRepoNeeded = return ()
|
||||
checkCloudRepos _ _ = noop
|
||||
#endif
|
||||
|
||||
{- Returns the name of the friend corresponding to a
|
||||
|
|
@ -88,7 +90,7 @@ getNeedCloudRepoR for = page "Cloud repository needed" (Just Configuration) $ do
|
|||
buddyname <- liftAssistant $ getBuddyName for
|
||||
$(widgetFile "configurators/xmpp/needcloudrepo")
|
||||
#else
|
||||
needCloudRepoR = xmppPage $
|
||||
getNeedCloudRepoR = xmppPage $
|
||||
$(widgetFile "configurators/xmpp/disabled")
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -31,10 +31,6 @@ import qualified Remote as Remote
|
|||
import Remote.List
|
||||
import Utility.FileMode
|
||||
import Utility.Shell
|
||||
#ifdef WITH_WEBAPP
|
||||
import Assistant.WebApp (UrlRenderer)
|
||||
import Assistant.WebApp.Configurators.XMPP
|
||||
#endif
|
||||
|
||||
import Network.Protocol.XMPP
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -256,11 +252,11 @@ xmppRemotes cid = case baseJID <$> parseJID cid of
|
|||
where
|
||||
matching loc r = repoIsUrl r && repoLocation r == loc
|
||||
|
||||
handlePushInitiation :: UrlRenderer -> NetMessage -> Assistant ()
|
||||
handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant ()
|
||||
handlePushInitiation _ (Pushing cid CanPush) =
|
||||
unlessM (null <$> xmppRemotes cid) $
|
||||
sendNetMessage $ Pushing cid PushRequest
|
||||
handlePushInitiation urlrenderer (Pushing cid PushRequest) =
|
||||
handlePushInitiation checkcloudrepos (Pushing cid PushRequest) =
|
||||
go =<< liftAnnex (inRepo Git.Branch.current)
|
||||
where
|
||||
go Nothing = noop
|
||||
|
|
@ -276,29 +272,19 @@ handlePushInitiation urlrenderer (Pushing cid PushRequest) =
|
|||
void $ alertWhile (syncAlert [r]) $
|
||||
xmppPush cid
|
||||
(taggedPush u selfjid branch r)
|
||||
(handleDeferred urlrenderer)
|
||||
checkCloudRepos urlrenderer r
|
||||
handlePushInitiation urlrenderer (Pushing cid StartingPush) = do
|
||||
(handleDeferred checkcloudrepos)
|
||||
checkcloudrepos r
|
||||
handlePushInitiation checkcloudrepos (Pushing cid StartingPush) = do
|
||||
rs <- xmppRemotes cid
|
||||
unless (null rs) $ do
|
||||
void $ alertWhile (syncAlert rs) $
|
||||
xmppReceivePack cid (handleDeferred urlrenderer)
|
||||
mapM_ (checkCloudRepos urlrenderer) rs
|
||||
xmppReceivePack cid (handleDeferred checkcloudrepos)
|
||||
mapM_ checkcloudrepos rs
|
||||
handlePushInitiation _ _ = noop
|
||||
|
||||
handleDeferred :: UrlRenderer -> NetMessage -> Assistant ()
|
||||
handleDeferred :: (Remote -> Assistant ()) -> NetMessage -> Assistant ()
|
||||
handleDeferred = handlePushInitiation
|
||||
|
||||
checkCloudRepos :: UrlRenderer -> Remote -> Assistant ()
|
||||
-- TODO only display if needed
|
||||
checkCloudRepos urlrenderer r =
|
||||
#ifdef WITH_WEBAPP
|
||||
unlessM (syncingToCloudRemote <$> getDaemonStatus) $
|
||||
cloudRepoNeeded urlrenderer (Remote.uuid r)
|
||||
#else
|
||||
noop
|
||||
#endif
|
||||
|
||||
writeChunk :: Handle -> B.ByteString -> IO ()
|
||||
writeChunk h b = do
|
||||
B.hPut h b
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue