diff options
author | 2012-09-24 14:48:47 -0400 | |
---|---|---|
committer | 2012-09-24 14:48:47 -0400 | |
commit | 38dadcf24873ced5e8e375669d56022d0ce7cc16 (patch) | |
tree | be5c915b40839bba9b2b7f5bc2322b99ce7d2d7e /Assistant/WebApp/Configurators.hs | |
parent | dd502bdae1be6a91b0c5f2f7996b1dc8d5f0cfc4 (diff) |
license the webapp under the AGPL 3+
This means that anyone serving up the webapp to users as a service
(ie, without providing any git-annex binary at all to the user) still needs
to provide a link to the source code for it, including any modifications
they may make.
This may make git-annex be covered by the AGPL as a whole when it is built
with the webapp. If in doubt, you should ask a lawyer.
When git-annex is built with the webapp disabled, no AGPLed code is used.
Even building in the assistant does not pull in AGPLed code.
Diffstat (limited to 'Assistant/WebApp/Configurators.hs')
-rw-r--r-- | Assistant/WebApp/Configurators.hs | 91 |
1 files changed, 0 insertions, 91 deletions
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs deleted file mode 100644 index 3f6a3f3e1..000000000 --- a/Assistant/WebApp/Configurators.hs +++ /dev/null @@ -1,91 +0,0 @@ -{- git-annex assistant webapp configurators - - - - Copyright 2012 Joey Hess <joey@kitenet.net> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} - -module Assistant.WebApp.Configurators where - -import Assistant.Common -import Assistant.WebApp -import Assistant.WebApp.Types -import Assistant.WebApp.SideBar -import Assistant.DaemonStatus -import Assistant.WebApp.Configurators.Local -import Utility.Yesod -import qualified Remote -import qualified Types.Remote as Remote -import Annex.UUID (getUUID) -import Logs.Remote -import Logs.Trust - -import Yesod -import Data.Text (Text) -import qualified Data.Map as M - -{- The main configuration screen. -} -getConfigR :: Handler RepHtml -getConfigR = ifM (inFirstRun) - ( getFirstRepositoryR - , bootstrap (Just Config) $ do - sideBarDisplay - setTitle "Configuration" - $(widgetFile "configurators/main") - ) - -{- Lists known repositories, followed by options to add more. -} -getRepositoriesR :: Handler RepHtml -getRepositoriesR = bootstrap (Just Config) $ do - sideBarDisplay - setTitle "Repositories" - repolist <- lift $ repoList False - $(widgetFile "configurators/repositories") - -{- A numbered list of known repositories, including the current one. -} -repoList :: Bool -> Handler [(String, String, Maybe (Route WebApp))] -repoList onlyconfigured - | onlyconfigured = list =<< configured - | otherwise = list =<< (++) <$> configured <*> unconfigured - where - configured = do - rs <- filter (not . Remote.readonly) . knownRemotes <$> - (liftIO . getDaemonStatus =<< daemonStatus <$> getYesod) - runAnnex [] $ do - u <- getUUID - return $ zip (u : map Remote.uuid rs) (repeat Nothing) - unconfigured = runAnnex [] $ do - m <- readRemoteLog - catMaybes . map (findtype m) . snd - <$> (trustPartition DeadTrusted $ M.keys m) - findtype m u = case M.lookup u m of - Nothing -> Nothing - Just c -> case M.lookup "type" c of - Just "rsync" -> u `enableswith` EnableRsyncR - Just "directory" -> u `enableswith` EnableDirectoryR - _ -> Nothing - u `enableswith` r = Just (u, Just $ r u) - list l = runAnnex [] $ do - let l' = nubBy (\x y -> fst x == fst y) l - zip3 - <$> pure counter - <*> Remote.prettyListUUIDs (map fst l') - <*> pure (map snd l') - counter = map show ([1..] :: [Int]) - -{- An intro message, list of repositories, and nudge to make more. -} -introDisplay :: Text -> Widget -introDisplay ident = do - webapp <- lift getYesod - repolist <- lift $ repoList True - let n = length repolist - let numrepos = show n - let notenough = n < enough - let barelyenough = n == enough - let morethanenough = n > enough - $(widgetFile "configurators/intro") - lift $ modifyWebAppState $ \s -> s { showIntro = False } - where - enough = 2 |