Merge branch 'master' into sshpassword

This commit is contained in:
Joey Hess 2014-05-14 12:43:34 -04:00
commit db8590791f
254 changed files with 21262 additions and 17210 deletions

View file

@ -0,0 +1,284 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | Helper functions for creating forms when using Bootstrap v3.
-- This is a copy of the Yesod.Form.Bootstrap3 module that has been slightly
-- modified to be compatible with Yesod 1.0.1
module Assistant.WebApp.Bootstrap3
( -- * Rendering forms
renderBootstrap3
, BootstrapFormLayout(..)
, BootstrapGridOptions(..)
-- * Field settings
, bfs
, withPlaceholder
, withAutofocus
, withLargeInput
, withSmallInput
-- * Submit button
, bootstrapSubmit
, mbootstrapSubmit
, BootstrapSubmit(..)
) where
import Control.Arrow (second)
import Control.Monad (liftM)
import Data.Text (Text)
import Data.String (IsString(..))
import Yesod.Core
import qualified Data.Text as T
import Yesod.Form.Types
import Yesod.Form.Functions
-- | Create a new 'FieldSettings' with the classes that are
-- required by Bootstrap v3.
--
-- Since: yesod-form 1.3.8
bfs :: RenderMessage site msg => msg -> FieldSettings site
bfs msg =
FieldSettings (SomeMessage msg) Nothing Nothing Nothing [("class", "form-control")]
-- | Add a placeholder attribute to a field. If you need i18n
-- for the placeholder, currently you\'ll need to do a hack and
-- use 'getMessageRender' manually.
--
-- Since: yesod-form 1.3.8
withPlaceholder :: Text -> FieldSettings site -> FieldSettings site
withPlaceholder placeholder fs = fs { fsAttrs = newAttrs }
where newAttrs = ("placeholder", placeholder) : fsAttrs fs
-- | Add an autofocus attribute to a field.
--
-- Since: yesod-form 1.3.8
withAutofocus :: FieldSettings site -> FieldSettings site
withAutofocus fs = fs { fsAttrs = newAttrs }
where newAttrs = ("autofocus", "autofocus") : fsAttrs fs
-- | Add the @input-lg@ CSS class to a field.
--
-- Since: yesod-form 1.3.8
withLargeInput :: FieldSettings site -> FieldSettings site
withLargeInput fs = fs { fsAttrs = newAttrs }
where newAttrs = addClass "input-lg" (fsAttrs fs)
-- | Add the @input-sm@ CSS class to a field.
--
-- Since: yesod-form 1.3.8
withSmallInput :: FieldSettings site -> FieldSettings site
withSmallInput fs = fs { fsAttrs = newAttrs }
where newAttrs = addClass "input-sm" (fsAttrs fs)
addClass :: Text -> [(Text, Text)] -> [(Text, Text)]
addClass klass [] = [("class", klass)]
addClass klass (("class", old):rest) = ("class", T.concat [old, " ", klass]) : rest
addClass klass (other :rest) = other : addClass klass rest
-- | How many bootstrap grid columns should be taken (see
-- 'BootstrapFormLayout').
--
-- Since: yesod-form 1.3.8
data BootstrapGridOptions =
ColXs !Int
| ColSm !Int
| ColMd !Int
| ColLg !Int
deriving (Eq, Ord, Show)
toColumn :: BootstrapGridOptions -> String
toColumn (ColXs 0) = ""
toColumn (ColSm 0) = ""
toColumn (ColMd 0) = ""
toColumn (ColLg 0) = ""
toColumn (ColXs columns) = "col-xs-" ++ show columns
toColumn (ColSm columns) = "col-sm-" ++ show columns
toColumn (ColMd columns) = "col-md-" ++ show columns
toColumn (ColLg columns) = "col-lg-" ++ show columns
toOffset :: BootstrapGridOptions -> String
toOffset (ColXs 0) = ""
toOffset (ColSm 0) = ""
toOffset (ColMd 0) = ""
toOffset (ColLg 0) = ""
toOffset (ColXs columns) = "col-xs-offset-" ++ show columns
toOffset (ColSm columns) = "col-sm-offset-" ++ show columns
toOffset (ColMd columns) = "col-md-offset-" ++ show columns
toOffset (ColLg columns) = "col-lg-offset-" ++ show columns
addGO :: BootstrapGridOptions -> BootstrapGridOptions -> BootstrapGridOptions
addGO (ColXs a) (ColXs b) = ColXs (a+b)
addGO (ColSm a) (ColSm b) = ColSm (a+b)
addGO (ColMd a) (ColMd b) = ColMd (a+b)
addGO (ColLg a) (ColLg b) = ColLg (a+b)
addGO a b | a > b = addGO b a
addGO (ColXs a) other = addGO (ColSm a) other
addGO (ColSm a) other = addGO (ColMd a) other
addGO (ColMd a) other = addGO (ColLg a) other
addGO (ColLg _) _ = error "Yesod.Form.Bootstrap.addGO: never here"
-- | The layout used for the bootstrap form.
--
-- Since: yesod-form 1.3.8
data BootstrapFormLayout =
BootstrapBasicForm
| BootstrapInlineForm
| BootstrapHorizontalForm
{ bflLabelOffset :: !BootstrapGridOptions
, bflLabelSize :: !BootstrapGridOptions
, bflInputOffset :: !BootstrapGridOptions
, bflInputSize :: !BootstrapGridOptions
}
deriving (Show)
-- | Render the given form using Bootstrap v3 conventions.
--
-- Sample Hamlet for 'BootstrapHorizontalForm':
--
-- > <form .form-horizontal role=form method=post action=@{ActionR} enctype=#{formEnctype}>
-- > ^{formWidget}
-- > ^{bootstrapSubmit MsgSubmit}
--
-- Since: yesod-form 1.3.8
#if MIN_VERSION_yesod(1,2,0)
renderBootstrap3 :: Monad m => BootstrapFormLayout -> FormRender m a
#else
renderBootstrap3 :: BootstrapFormLayout -> FormRender sub master a
#endif
renderBootstrap3 formLayout aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
has (Just _) = True
has Nothing = False
widget = [whamlet|
#if MIN_VERSION_yesod(1,2,0)
$newline never
#endif
#{fragment}
$forall view <- views
<div .form-group :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.has-error>
$case formLayout
$of BootstrapBasicForm
$if nequals (fvId view) bootstrapSubmitId
<label for=#{fvId view}>#{fvLabel view}
^{fvInput view}
^{helpWidget view}
$of BootstrapInlineForm
$if nequals (fvId view) bootstrapSubmitId
<label .sr-only for=#{fvId view}>#{fvLabel view}
^{fvInput view}
^{helpWidget view}
$of f@(BootstrapHorizontalForm _ _ _ _)
$if nequals (fvId view) bootstrapSubmitId
<label .control-label .#{toOffset (bflLabelOffset f)} .#{toColumn (bflLabelSize f)} for=#{fvId view}>#{fvLabel view}
<div .#{toOffset (bflInputOffset f)} .#{toColumn (bflInputSize f)}>
^{fvInput view}
^{helpWidget view}
$else
<div .#{toOffset (addGO (bflInputOffset f) (addGO (bflLabelOffset f) (bflLabelSize f)))} .#{toColumn (bflInputSize f)}>
^{fvInput view}
^{helpWidget view}
|]
return (res, widget)
where
nequals a b = a /= b -- work around older hamlet versions not liking /=
-- | (Internal) Render a help widget for tooltips and errors.
#if MIN_VERSION_yesod(1,2,0)
helpWidget :: FieldView site -> WidgetT site IO ()
#else
helpWidget :: FieldView sub master -> GWidget sub master ()
#endif
helpWidget view = [whamlet|
$maybe tt <- fvTooltip view
<span .help-block>#{tt}
$maybe err <- fvErrors view
<span .help-block>#{err}
|]
-- | How the 'bootstrapSubmit' button should be rendered.
--
-- Since: yesod-form 1.3.8
data BootstrapSubmit msg =
BootstrapSubmit
{ bsValue :: msg
-- ^ The text of the submit button.
, bsClasses :: Text
-- ^ Classes added to the @<button>@.
, bsAttrs :: [(Text, Text)]
-- ^ Attributes added to the @<button>@.
} deriving (Show)
instance IsString msg => IsString (BootstrapSubmit msg) where
fromString msg = BootstrapSubmit (fromString msg) " btn-default " []
-- | A Bootstrap v3 submit button disguised as a field for
-- convenience. For example, if your form currently is:
--
-- > Person <$> areq textField "Name" Nothing
-- > <*> areq textField "Surname" Nothing
--
-- Then just change it to:
--
-- > Person <$> areq textField "Name" Nothing
-- > <*> areq textField "Surname" Nothing
-- > <* bootstrapSubmit "Register"
--
-- (Note that @<*@ is not a typo.)
--
-- Alternatively, you may also just create the submit button
-- manually as well in order to have more control over its
-- layout.
--
-- Since: yesod-form 1.3.8
#if MIN_VERSION_yesod(1,2,0)
bootstrapSubmit
:: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
=> BootstrapSubmit msg -> AForm m ()
#else
bootstrapSubmit :: (RenderMessage master msg) => BootstrapSubmit msg -> AForm sub master ()
#endif
bootstrapSubmit = formToAForm . liftM (second return) . mbootstrapSubmit
-- | Same as 'bootstrapSubmit' but for monadic forms. This isn't
-- as useful since you're not going to use 'renderBootstrap3'
-- anyway.
--
-- Since: yesod-form 1.3.8
#if MIN_VERSION_yesod(1,2,0)
mbootstrapSubmit
:: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
=> BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
#else
mbootstrapSubmit :: (RenderMessage master msg) => BootstrapSubmit msg -> MForm sub master (FormResult (), FieldView sub master)
#endif
mbootstrapSubmit (BootstrapSubmit msg classes attrs) =
let res = FormSuccess ()
widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]
fv = FieldView { fvLabel = ""
, fvTooltip = Nothing
, fvId = bootstrapSubmitId
, fvInput = widget
, fvErrors = Nothing
, fvRequired = False }
in return (res, fv)
-- | A royal hack. Magic id used to identify whether a field
-- should have no label. A valid HTML4 id which is probably not
-- going to clash with any other id should someone use
-- 'bootstrapSubmit' outside 'renderBootstrap3'.
bootstrapSubmitId :: Text
bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id"

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Common (module X) where
import Assistant.Common as X
@ -13,6 +15,9 @@ import Assistant.WebApp.Page as X
import Assistant.WebApp.Form as X
import Assistant.WebApp.Types as X
import Assistant.WebApp.RepoId as X
#if MIN_VERSION_yesod(1,2,0)
import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
#else
import Utility.Yesod as X hiding (textField, passwordField, selectField, selectFieldList, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
#endif
import Data.Text as X (Text)

View file

@ -68,8 +68,8 @@ s3InputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
<*> datacenterField AWS.S3
<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy)
<*> areq textField "Repository name" (Just "S3")
<*> areq (selectFieldList storageclasses) (bfs "Storage class") (Just StandardRedundancy)
<*> areq textField (bfs "Repository name") (Just "S3")
<*> enableEncryptionField
where
storageclasses :: [(Text, StorageClass)]
@ -84,7 +84,7 @@ glacierInputAForm defcreds = AWSInput
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
<*> datacenterField AWS.Glacier
<*> pure StandardRedundancy
<*> areq textField "Repository name" (Just "glacier")
<*> areq textField (bfs "Repository name") (Just "glacier")
<*> enableEncryptionField
awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds
@ -93,7 +93,7 @@ awsCredsAForm defcreds = AWSCreds
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text
accessKeyIDField help = areq (textField `withNote` help) "Access Key ID"
accessKeyIDField help = areq (textField `withNote` help) (bfs "Access Key ID")
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp = accessKeyIDField help
@ -104,10 +104,10 @@ accessKeyIDFieldWithHelp = accessKeyIDField help
|]
secretAccessKeyField :: Maybe Text -> MkAForm Text
secretAccessKeyField = areq passwordField "Secret Access Key"
secretAccessKeyField = areq passwordField (bfs "Secret Access Key")
datacenterField :: AWS.Service -> MkAForm Text
datacenterField service = areq (selectFieldList list) "Datacenter" defregion
datacenterField service = areq (selectFieldList list) (bfs "Datacenter") defregion
where
list = M.toList $ AWS.regionMap service
defregion = Just $ AWS.defaultRegion service
@ -120,7 +120,7 @@ postAddS3R :: Handler Html
postAddS3R = awsConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ s3InputAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ s3InputAForm defcreds
case result of
FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input
@ -143,7 +143,7 @@ postAddGlacierR :: Handler Html
postAddGlacierR = glacierConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ glacierInputAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ glacierInputAForm defcreds
case result of
FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input
@ -186,7 +186,7 @@ enableAWSRemote :: RemoteType -> UUID -> Widget
enableAWSRemote remotetype uuid = do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ awsCredsAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ awsCredsAForm defcreds
case result of
FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog

View file

@ -89,8 +89,8 @@ deleteCurrentRepository = dangerPage $ do
havegitremotes <- haveremotes syncGitRemotes
havedataremotes <- haveremotes syncDataRemotes
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sanityVerifierAForm $
SanityVerifier magicphrase
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
sanityVerifierAForm $ SanityVerifier magicphrase
case result of
FormSuccess _ -> liftH $ do
dir <- liftAnnex $ fromRepo Git.repoPath
@ -122,7 +122,7 @@ data SanityVerifier = SanityVerifier T.Text
sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier
sanityVerifierAForm template = SanityVerifier
<$> areq checksanity "Confirm deletion?" Nothing
<$> areq checksanity (bfs "Confirm deletion?") Nothing
where
checksanity = checkBool (\input -> SanityVerifier input == template)
insane textField

View file

@ -142,9 +142,9 @@ setRepoConfig uuid mremote oldc newc = do
editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
editRepositoryAForm mremote def = RepoConfig
<$> areq (if ishere then readonlyTextField else textField)
"Name" (Just $ repoName def)
<*> aopt textField "Description" (Just $ repoDescription def)
<*> areq (selectFieldList groups `withNote` help) "Repository group" (Just $ repoGroup def)
(bfs "Name") (Just $ repoName def)
<*> aopt textField (bfs "Description") (Just $ repoDescription def)
<*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def)
<*> associateddirectory
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
where
@ -166,7 +166,7 @@ editRepositoryAForm mremote def = RepoConfig
associateddirectory = case repoAssociatedDirectory def of
Nothing -> aopt hiddenField "" Nothing
Just d -> aopt textField "Associated directory" (Just $ Just d)
Just d -> aopt textField (bfs "Associated directory") (Just $ Just d)
getEditRepositoryR :: RepoId -> Handler Html
getEditRepositoryR = postEditRepositoryR
@ -195,7 +195,7 @@ editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
curr <- liftAnnex $ getRepoConfig uuid mremote
liftAnnex $ checkAssociatedDirectory curr mremote
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ editRepositoryAForm mremote curr
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr
case result of
FormSuccess input -> liftH $ do
setRepoConfig uuid mremote curr input

View file

@ -64,10 +64,10 @@ runFsckForm new activity = case activity of
u <- liftAnnex getUUID
repolist <- liftAssistant (getrepolist ru)
runFormPostNoToken $ \msg -> do
(reposRes, reposView) <- mreq (selectFieldList repolist) "" (Just ru)
(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 )
(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t)
(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r)
(reposRes, reposView) <- mreq (selectFieldList repolist) (bfs "") (Just ru)
(durationRes, durationView) <- mreq intField (bfs "") (Just $ durationSeconds d `quot` 60 )
(timeRes, timeView) <- mreq (selectFieldList times) (bfs "") (Just t)
(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) (bfs "") (Just r)
let form = do
webAppFormAuthToken
$(widgetFile "configurators/fsck/formcontent")
@ -175,7 +175,8 @@ fsckPreferencesAForm def = FsckPreferences
runFsckPreferencesForm :: Handler ((FormResult FsckPreferences, Widget), Enctype)
runFsckPreferencesForm = do
prefs <- liftAnnex getFsckPreferences
runFormPostNoToken $ renderBootstrap $ fsckPreferencesAForm prefs
runFormPostNoToken $ renderBootstrap3 formLayout $ fsckPreferencesAForm prefs
where formLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 10)
showFsckPreferencesForm :: Widget
showFsckPreferencesForm = do

View file

@ -83,8 +83,8 @@ iaInputAForm :: Maybe CredPair -> MkAForm IAInput
iaInputAForm defcreds = IAInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
<*> areq (selectFieldList mediatypes) "Media Type" (Just MediaOmitted)
<*> areq (textField `withExpandableNote` ("Help", itemNameHelp)) "Item Name" Nothing
<*> areq (selectFieldList mediatypes) (bfs "Media Type") (Just MediaOmitted)
<*> areq (textField `withExpandableNote` ("Help", itemNameHelp)) (bfs "Item Name") Nothing
where
mediatypes :: [(Text, MediaType)]
mediatypes = map (\t -> (T.pack $ showMediaType t, t)) [minBound..]
@ -126,7 +126,7 @@ postAddIAR :: Handler Html
postAddIAR = iaConfigurator $ do
defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ iaInputAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaInputAForm defcreds
case result of
FormSuccess input -> liftH $ do
let name = escapeBucket $ T.unpack $ itemName input
@ -165,7 +165,7 @@ enableIARemote :: UUID -> Widget
enableIARemote uuid = do
defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ iaCredsAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaCredsAForm defcreds
case result of
FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog

View file

@ -143,7 +143,7 @@ defaultRepositoryPath firstrun = do
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) ""
(pathRes, pathView) <- mreq (repositoryPathField True) (bfs "")
(Just $ T.pack $ addTrailingPathSeparator defpath)
let (err, errmsg) = case pathRes of
FormMissing -> (False, "")
@ -217,10 +217,10 @@ getCombineRepositoryR newrepopath newrepouuid = do
remotename = takeFileName newrepopath
selectDriveForm :: [RemovableDrive] -> Hamlet.Html -> MkMForm RemovableDrive
selectDriveForm drives = renderBootstrap $ RemovableDrive
selectDriveForm drives = renderBootstrap3 bootstrapFormLayout $ RemovableDrive
<$> pure Nothing
<*> areq (selectFieldList pairs `withNote` onlywritable) "Select drive:" Nothing
<*> areq textField "Use this directory on the drive:"
<*> areq (selectFieldList pairs `withNote` onlywritable) (bfs "Select drive:") Nothing
<*> areq textField (bfs "Use this directory on the drive:")
(Just $ T.pack gitAnnexAssistantDefaultDir)
where
pairs = zip (map describe drives) (map mountPoint drives)

View file

@ -265,8 +265,8 @@ data InputSecret = InputSecret { secretText :: Maybe Text }
promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler Html
promptSecret msg cont = pairPage $ do
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $
InputSecret <$> aopt textField "Secret phrase" Nothing
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
InputSecret <$> aopt textField (bfs "Secret phrase") Nothing
case result of
FormSuccess v -> do
let rawsecret = fromMaybe "" $ secretText v

View file

@ -36,13 +36,13 @@ data PrefsForm = PrefsForm
prefsAForm :: PrefsForm -> MkAForm PrefsForm
prefsAForm def = PrefsForm
<$> areq (storageField `withNote` diskreservenote)
"Disk reserve" (Just $ diskReserve def)
(bfs "Disk reserve") (Just $ diskReserve def)
<*> areq (positiveIntField `withNote` numcopiesnote)
"Number of copies" (Just $ numCopies def)
(bfs "Number of copies") (Just $ numCopies def)
<*> areq (checkBoxField `withNote` autostartnote)
"Auto start" (Just $ autoStart def)
<*> areq (selectFieldList autoUpgradeChoices)
autoUpgradeLabel (Just $ autoUpgrade def)
(bfs autoUpgradeLabel) (Just $ autoUpgrade def)
<*> areq (checkBoxField `withNote` debugnote)
"Enable debug logging" (Just $ debugEnabled def)
where
@ -109,7 +109,7 @@ postPreferencesR :: Handler Html
postPreferencesR = page "Preferences" (Just Configuration) $ do
((result, form), enctype) <- liftH $ do
current <- liftAnnex getPrefs
runFormPostNoToken $ renderBootstrap $ prefsAForm current
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ prefsAForm current
case result of
FormSuccess new -> liftH $ do
liftAnnex $ storePrefs new

View file

@ -76,10 +76,10 @@ sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
#endif
sshInputAForm hostnamefield def = SshInput
<$> aopt check_hostname "Host name" (Just $ inputHostname def)
<*> aopt check_username "User name" (Just $ inputUsername def)
<*> aopt textField "Directory" (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def)
<*> areq intField "Port" (Just $ inputPort def)
<$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def)
<*> aopt check_username (bfs "User name") (Just $ inputUsername def)
<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def)
<*> areq intField (bfs "Port") (Just $ inputPort def)
where
check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack)
bad_username textField
@ -121,7 +121,7 @@ postAddSshR :: Handler Html
postAddSshR = sshConfigurator $ do
username <- liftIO $ T.pack <$> myUserName
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sshInputAForm textField $
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField $
SshInput Nothing (Just username) Nothing 22
case result of
FormSuccess sshinput -> do
@ -174,7 +174,7 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of
(Just sshinput, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sshInputAForm textField sshinput
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField sshinput
case result of
FormSuccess sshinput'
| isRsyncNet (inputHostname sshinput') ->
@ -456,7 +456,7 @@ getAddRsyncNetR = postAddRsyncNetR
postAddRsyncNetR :: Handler Html
postAddRsyncNetR = do
((result, form), enctype) <- runFormPostNoToken $
renderBootstrap $ sshInputAForm hostnamefield $
renderBootstrap3 bootstrapFormLayout $ sshInputAForm hostnamefield $
SshInput Nothing Nothing Nothing 22
let showform status = inpage $
$(widgetFile "configurators/rsync.net/add")

View file

@ -27,9 +27,9 @@ data UnusedForm = UnusedForm
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
unusedForm def msg = do
(enableRes, enableView) <- mreq (selectFieldList enabledisable) ""
(enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "")
(Just $ enableExpire def)
(whenRes, whenView) <- mreq intField ""
(whenRes, whenView) <- mreq intField (bfs "")
(Just $ expireWhen def)
let form = do
webAppFormAuthToken

View file

@ -45,16 +45,16 @@ toCredPair input = (T.unpack $ user input, T.unpack $ password input)
boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput
boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds)
<$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
<*> areq passwordField (bfs "Box.com Password") (T.pack . snd <$> defcreds)
<*> areq checkBoxField "Share this account with other devices and friends?" (Just True)
<*> areq textField "Directory" (Just "annex")
<*> areq textField (bfs "Directory") (Just "annex")
<*> enableEncryptionField
webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds)
<$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
<*> areq passwordField (bfs "Password") (T.pack . snd <$> defcreds)
<*> pure False
<*> pure T.empty
<*> pure NoEncryption -- not used!
@ -66,7 +66,8 @@ postAddBoxComR :: Handler Html
postAddBoxComR = boxConfigurator $ do
defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ boxComAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout
$ boxComAForm defcreds
case result of
FormSuccess input -> liftH $
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList
@ -109,7 +110,8 @@ postEnableWebDAVR uuid = do
maybe (pure Nothing) previouslyUsedWebDAVCreds $
urlHost url
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ webDAVCredsAForm defcreds
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
webDAVCredsAForm defcreds
case result of
FormSuccess input -> liftH $
makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty

View file

@ -99,7 +99,7 @@ xmppform :: Route WebApp -> Handler Html
xmppform next = xmppPage $ do
((result, form), enctype) <- liftH $ do
oldcreds <- liftAnnex getXMPPCreds
runFormPostNoToken $ renderBootstrap $ xmppAForm $
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ xmppAForm $
creds2Form <$> oldcreds
let showform problem = $(widgetFile "configurators/xmpp")
case result of
@ -162,8 +162,8 @@ creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def)
<*> areq passwordField "Password" Nothing
<$> areq jidField (bfs "Jabber address") (formJID <$> def)
<*> areq passwordField (bfs "Password") Nothing
jidField :: MkField Text
jidField = checkBool (isJust . parseJID) bad textField

View file

@ -15,10 +15,20 @@ module Assistant.WebApp.Form where
import Assistant.WebApp.Types
import Assistant.Gpg
#if MIN_VERSION_yesod(1,2,0)
import Yesod hiding (textField, passwordField)
import Yesod.Form.Fields as F
#else
import Yesod hiding (textField, passwordField, selectField, selectFieldList)
import Yesod.Form.Fields as F hiding (selectField, selectFieldList)
#endif
import Assistant.WebApp.Bootstrap3 hiding (bfs)
import Data.String (IsString (..))
import Data.Text (Text)
import Control.Monad (unless)
import Data.Maybe (listToMaybe)
{- Yesod's textField sets the required attribute for required fields.
- We don't want this, because many of the forms used in this webapp
- display a modal dialog when submitted, which interacts badly with
@ -48,6 +58,54 @@ passwordField = F.passwordField
|]
}
{- In older Yesod versions attrs is written into the <option> tag instead of the
- surrounding <select>. This breaks the Bootstrap 3 layout of select fields as
- it requires the "form-control" class on the <select> tag.
- We need to change that to behave the same way as in newer versions.
-}
#if ! MIN_VERSION_yesod(1,2,0)
selectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
selectFieldList = selectField . optionsPairs
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
selectField = selectFieldHelper
(\theId name attrs inside -> [whamlet|<select ##{theId} name=#{name} *{attrs}>^{inside}|]) -- outside
(\_theId _name isSel -> [whamlet|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
(\_theId _name _attrs value isSel text -> [whamlet|<option value=#{value} :isSel:selected>#{text}|]) -- inside
selectFieldHelper :: (Eq a, RenderMessage master FormMessage)
=> (Text -> Text -> [(Text, Text)] -> GWidget sub master () -> GWidget sub master ())
-> (Text -> Text -> Bool -> GWidget sub master ())
-> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> GWidget sub master ())
-> GHandler sub master (OptionList a) -> Field sub master a
selectFieldHelper outside onOpt inside opts' = Field
{ fieldParse = \x -> do
opts <- opts'
return $ selectParser opts x
, fieldView = \theId name attrs val isReq -> do
opts <- fmap olOptions $ lift opts'
outside theId name attrs $ do
unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
flip mapM_ opts $ \opt -> inside
theId
name
((if isReq then (("required", "required"):) else id) attrs)
(optionExternalValue opt)
((render opts val) == optionExternalValue opt)
(optionDisplay opt)
}
where
render _ (Left _) = ""
render opts (Right a) = maybe "" optionExternalValue $ listToMaybe $ filter ((== a) . optionInternalValue) opts
selectParser _ [] = Right Nothing
selectParser opts (s:_) = case s of
"" -> Right Nothing
"none" -> Right Nothing
x -> case olReadExternal opts x of
Nothing -> Left $ SomeMessage $ MsgInvalidEntry x
Just y -> Right $ Just y
#endif
{- Makes a note widget be displayed after a field. -}
#if MIN_VERSION_yesod(1,2,0)
withNote :: (Monad m, ToWidget (HandlerSite m) a) => Field m v -> a -> Field m v
@ -67,7 +125,7 @@ withExpandableNote :: (Monad m, ToWidget (HandlerSite m) w) => Field m v -> (Str
withExpandableNote :: Field sub master v -> (String, GWidget sub master ()) -> Field sub master v
#endif
withExpandableNote field (toggle, note) = withNote field $ [whamlet|
<a .btn data-toggle="collapse" data-target="##{ident}">#{toggle}</a>
<a .btn .btn-default data-toggle="collapse" data-target="##{ident}">#{toggle}</a>
<div ##{ident} .collapse>
^{note}
|]
@ -80,10 +138,27 @@ enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT sit
#else
enableEncryptionField :: RenderMessage master FormMessage => AForm sub master EnableEncryption
#endif
enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just SharedEncryption)
enableEncryptionField = areq (selectFieldList choices) (bfs "Encryption") (Just SharedEncryption)
where
choices :: [(Text, EnableEncryption)]
choices =
[ ("Encrypt all data", SharedEncryption)
, ("Disable encryption", NoEncryption)
]
{- Defines the layout used by the Bootstrap3 form helper -}
bootstrapFormLayout :: BootstrapFormLayout
bootstrapFormLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 10)
{- Adds the form-control class used by Bootstrap3 for layout to a field
- This is the same as Yesod.Form.Bootstrap3.bfs except it takes just a Text
- parameter as I couldn't get the original bfs to compile due to type ambiguities.
-}
bfs :: Text -> FieldSettings master
bfs msg = FieldSettings
{ fsLabel = SomeMessage msg
, fsName = Nothing
, fsId = Nothing
, fsAttrs = [("class", "form-control")]
, fsTooltip = Nothing
}

View file

@ -27,11 +27,12 @@ import qualified Data.Map as M
gpgKeyDisplay :: KeyId -> Maybe UserId -> Widget
gpgKeyDisplay keyid userid = [whamlet|
<span title="key id #{keyid}">
<i .icon-user></i> #
$maybe name <- userid
#{name}
$nothing
key id #{keyid}
<span .glyphicon .glyphicon-user>
\
$maybe name <- userid
#{name}
$nothing
key id #{keyid}
|]
genKeyModal :: Widget

View file

@ -59,14 +59,12 @@ customPage' with_longpolling navbaritem content = do
Nothing -> do
navbar <- map navdetails <$> selectNavBar
pageinfo <- widgetToPageContent $ do
addStylesheet $ StaticR bootstrap_css
addStylesheet $ StaticR bootstrap_responsive_css
addScript $ StaticR jquery_full_js
addScript $ StaticR bootstrap_dropdown_js
addScript $ StaticR bootstrap_modal_js
addScript $ StaticR bootstrap_collapse_js
addStylesheet $ StaticR css_bootstrap_css
addStylesheet $ StaticR css_bootstrap_theme_css
addScript $ StaticR js_jquery_full_js
addScript $ StaticR js_bootstrap_js
when with_longpolling $
addScript $ StaticR longpolling_js
addScript $ StaticR js_longpolling_js
$(widgetFile "page")
giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")
Just msg -> error msg

View file

@ -113,10 +113,10 @@ cloudRepoList = repoListDisplay RepoSelector
repoListDisplay :: RepoSelector -> Widget
repoListDisplay reposelector = do
autoUpdate ident (NotifierRepoListR reposelector) (10 :: Int) (10 :: Int)
addScript $ StaticR jquery_ui_core_js
addScript $ StaticR jquery_ui_widget_js
addScript $ StaticR jquery_ui_mouse_js
addScript $ StaticR jquery_ui_sortable_js
addScript $ StaticR js_jquery_ui_core_js
addScript $ StaticR js_jquery_ui_widget_js
addScript $ StaticR js_jquery_ui_mouse_js
addScript $ StaticR js_jquery_ui_sortable_js
repolist <- liftH $ repoList reposelector
let addmore = nudgeAddMore reposelector

View file

@ -38,7 +38,7 @@ sideBarDisplay = do
bootstrapclass :: AlertClass -> Text
bootstrapclass Activity = "alert-info"
bootstrapclass Warning = "alert"
bootstrapclass Error = "alert-error"
bootstrapclass Error = "alert-danger"
bootstrapclass Success = "alert-success"
bootstrapclass Message = "alert-info"
@ -106,4 +106,4 @@ htmlIcon UpgradeIcon = bootstrapIcon "arrow-up"
htmlIcon ConnectionIcon = bootstrapIcon "signal"
bootstrapIcon :: Text -> Widget
bootstrapIcon name = [whamlet|<i .icon-#{name}></i>|]
bootstrapIcon name = [whamlet|<span .glyphicon .glyphicon-#{name}>|]

View file

@ -73,8 +73,10 @@ instance Yesod WebApp where
defaultLayout content = do
webapp <- getYesod
pageinfo <- widgetToPageContent $ do
addStylesheet $ StaticR bootstrap_css
addStylesheet $ StaticR bootstrap_responsive_css
addStylesheet $ StaticR css_bootstrap_css
addStylesheet $ StaticR css_bootstrap_theme_css
addScript $ StaticR js_jquery_full_js
addScript $ StaticR js_bootstrap_js
$(widgetFile "error")
giveUrlRenderer $(hamletFile $ hamletTemplate "bootstrap")

View file

@ -460,6 +460,11 @@ mangleCode = flip_colon
-
- Nothing
- -> foo
-
- -- This is not yet handled!
- ComplexConstructor var var
- var var
- -> foo
-}
case_layout_multiline = parsecAndReplace $ do
void newline

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Applicative where

View file

@ -2,7 +2,7 @@
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Base64 (toB64, fromB64Maybe, fromB64) where

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -3,7 +3,7 @@
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Data where

View file

@ -2,7 +2,7 @@
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-
-
- And now a rant:

View file

@ -6,7 +6,7 @@
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.DirWatcher.FSEvents where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.DirWatcher.INotify where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE ForeignFunctionInterface #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.DirWatcher.Types where

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.DirWatcher.Win32Notify where

View file

@ -2,7 +2,7 @@
-
- Copyright 2011-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012, 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE ForeignFunctionInterface, CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Dot where -- import qualified

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE ScopedTypeVariables #-}

View file

@ -5,7 +5,7 @@
-
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.ExternalSHA (externalSHA) where

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Format (

View file

@ -7,7 +7,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.FreeDesktop (

View file

@ -5,7 +5,7 @@
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.HumanNumber where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.HumanTime (

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.InodeCache where

View file

@ -2,7 +2,7 @@
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.JSONStream (

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.LinuxMkLibs where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -12,7 +12,7 @@
-
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE Rank2Types, KindSignatures #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE TypeSynonymInstances #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Monad where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Network where

View file

@ -8,7 +8,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.NotificationBroadcaster (

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.OSX where

View file

@ -2,7 +2,7 @@
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Parallel where

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE PackageImports, CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Percentage (

View file

@ -4,7 +4,7 @@
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -3,7 +3,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP, Rank2Types #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Rsync where

View file

@ -5,7 +5,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.SafeCommand where

View file

@ -2,7 +2,7 @@
-
- Copyright 2013-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Scheduled (

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2013-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.SimpleProtocol (

View file

@ -2,7 +2,7 @@
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.SshConfig where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.ThreadLock where

View file

@ -3,7 +3,7 @@
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
- Copyright 2011 Bas van Dijk & Roel van Dijk
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE ForeignFunctionInterface #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2011,2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.Verifiable where

View file

@ -2,7 +2,7 @@
-
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings, CPP, RankNTypes #-}

View file

@ -2,7 +2,7 @@
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
module Utility.WinLock (

View file

@ -2,7 +2,7 @@
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
- License: BSD-2-clause
-}
{-# LANGUAGE ForeignFunctionInterface #-}

View file

@ -28,6 +28,7 @@ import Yesod as Y
#else
import Yesod as Y hiding (Html)
#endif
import Assistant.WebApp.Bootstrap3 as Y hiding (bfs)
#ifndef __NO_TH__
import Yesod.Default.Util
import Language.Haskell.TH.Syntax (Q, Exp)

View file

@ -2,7 +2,7 @@
*
* Copyright 2012, 2014 Joey Hess <joey@kitenet.net>
*
* Licensed under the GNU GPL version 3 or higher.
* License: BSD-2-clause
*/
/* Include appropriate headers for the OS, and define what will be used to

View file

@ -2,7 +2,7 @@
*
* Copyright 2012 Joey Hess <joey@kitenet.net>
*
* Licensed under the GNU GPL version 3 or higher.
* License: BSD-2-clause
*/
#include <stdio.h>

4
debian/changelog vendored
View file

@ -1,11 +1,13 @@
git-annex (5.20140422) UNRELEASED; urgency=medium
* webapp: Switched to bootstrap 3.
Thanks, Sören Brunk.
* Standalone builds now check gpg signatures before upgrading.
* Simplified repository description line format. The remote name,
if any, is always in square brackets after the description.
* assistant: Clean up stale tmp files on startup.
-- Joey Hess <joeyh@debian.org> Wed, 23 Apr 2014 12:43:39 -0400
-- Joey Hess <joeyh@debian.org> Fri, 02 May 2014 15:28:53 -0300
git-annex (5.20140421) unstable; urgency=medium

72
debian/copyright vendored
View file

@ -7,11 +7,20 @@ License: GPL-3+
Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/*
Copyright: © 2012-2014 Joey Hess <joey@kitenet.net>
© 2014 Sören Brunk
License: AGPL-3+
Files: Utility/ThreadScheduler.hs
Copyright: 2011 Bas van Dijk & Roel van Dijk
2012 Joey Hess <joey@kitenet.net>
2012, 2013 Joey Hess <joey@kitenet.net>
License: BSD-2-clause
Files: Utility/*
Copyright: 2012-2014 Joey Hess <joey@kitenet.net>
License: BSD-2-clause
Files: Utility/Gpg.hs Utility/DirWatcher*
Copyright: © 2010-2014 Joey Hess <joey@kitenet.net>
License: GPL-3+
Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/*
@ -88,23 +97,28 @@ License: MIT or GPL-2
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Files: static/bootstrap* static/glyphicons-halflings*
Copyright: 2012 Twitter, Inc.
License: Apache-2.0
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
.
http://www.apache.org/licenses/LICENSE-2.0
.
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
.
The complete text of the Apache License is distributed in
/usr/share/common-licenses/Apache-2.0 on Debian systems.
Files: static/*/bootstrap* static/*/glyphicons-halflings*
Copyright: 2012-2014 Twitter, Inc.
License: MIT
Copyright (c) 2011-2014 Twitter, Inc
.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
.
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
License: GPL-3+
The full text of version 3 of the GPL is distributed as doc/license/GPL in
@ -116,6 +130,28 @@ License: LGPL-2.1+
in this package's source, or in /usr/share/common-licenses/LGPL-2.1
on Debian systems.
License: BSD-2-clause
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
.
THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.
License: AGPL-3+
GNU AFFERO GENERAL PUBLIC LICENSE
Version 3, 19 November 2007

View file

@ -0,0 +1,22 @@
[[!comment format=mdwn
username="https://www.google.com/accounts/o8/id?id=AItOawkAUMhKOSkh9JaBA6xst3XxQIIsDEq5Zd4"
nickname="Ovidiu"
subject="Still having this problem"
date="2014-05-09T12:53:02Z"
content="""
[2014-05-09 07:37:42 SAST] Transferrer: Uploaded 1-564 Erk..08_04.pdf
ok
(Recording state in git...)
(Recording state in git...)
(Recording state in git...)
git-annex: /etc/resolv.conf: openFile: does not exist (No such file or directory)
[2014-05-09 08:39:53 SAST] NetWatcherFallback: Syncing with box.com, gitannexbackup
I saw it in the log file but I have no idea what triggered it.
Using the .dmg install for Mac OsX
Version: 5.20140420-ga25b8bb
Build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash
on Mac OSX 10.9.2
"""]]

View file

@ -0,0 +1,8 @@
[[!comment format=mdwn
username="http://johan.kiviniemi.name/"
nickname="Johan"
subject="comment 10"
date="2014-05-01T01:33:10Z"
content="""
Note to self: I experienced this bug with the standalone tarball release (5.20140421) as well, so its not caused by something that is different on my system wrt. git-annexs dependencies etc.
"""]]

View file

@ -0,0 +1,14 @@
[[!comment format=mdwn
username="http://xlogon.net/yminus"
nickname="http://xlogon.net/yminus"
subject="comment 4"
date="2014-05-08T21:12:49Z"
content="""
When will this issue be fixed? Currently my Jabber account is on jabber.ccc.de.
This is the error message:
Unable to connect to the Jabber server. Maybe you entered the wrong password? (Error message: host jabberd.jabber.ccc.de.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"bad-protocol\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}); host jabberd.jabber.ccc.de.:80 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"bad-protocol\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}))
Can you advise me another trustworthy non-profit and free (free as in free beer\" as well as \"free as in free speech\") jabber server?
"""]]

View file

@ -0,0 +1,29 @@
### Please describe the problem.
Every time git-annex launches (after a reboot). It prompts me to finish upgrade, even though the binary is not updated. (All my repos are set to not auto update and this happens on all my repos).
### What steps will reproduce the problem?
Relaunching git-annex.
### What version of git-annex are you using? On what operating system?
OS X 10.9
git-annex version: 5.20140419-g477c0c0
build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash
key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL
remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external
### Please provide any additional information below.
[[!format sh """
# If you can, paste a complete transcript of the problem occurring here.
# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log
# End of transcript or log.
"""]]

View file

@ -0,0 +1,20 @@
### Please describe the problem.
When starting git-annex Version: 5.20140420-ga25b8bb Build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash on My MBP running OSX 10.9.2 I get a notification about: An upgrade of git-annex is available. (version 5.20140421)
I then click UPGRADE and then get this message: Internal Server Error Cannot find old distribution bundle; not upgrading.
### What steps will reproduce the problem?
See problem description above, not sure what else to say.
### What version of git-annex are you using? On what operating system?
See problem description above, not sure what else to say.
### Please provide any additional information below.
[[!format sh """
# If you can, paste a complete transcript of the problem occurring here.
# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log
# End of transcript or log.
"""]]

View file

@ -0,0 +1,13 @@
[[!comment format=mdwn
username="https://www.google.com/accounts/o8/id?id=AItOawkAUMhKOSkh9JaBA6xst3XxQIIsDEq5Zd4"
nickname="Ovidiu"
subject="fixed"
date="2014-05-09T13:12:59Z"
content="""
re-downloaded the old version, re-isntalled and now it actually starts downlaoding the new version => http://screencast.com/t/id2Ng57Z9
NOT sure though, why it now uploads the new version to all repositories? i.e. box.com? IS there a reason for this?
Transfers
git-annex.dmg (for upgrade)→box.com 42% of 22.52 MiB
"""]]

View file

@ -0,0 +1,24 @@
[[!comment format=mdwn
username="https://www.google.com/accounts/o8/id?id=AItOawkAUMhKOSkh9JaBA6xst3XxQIIsDEq5Zd4"
nickname="Ovidiu"
subject="spoke too soon"
date="2014-05-09T13:23:52Z"
content="""
Stuck in a loop, now with every restart of git-annex it downloads the update and then uploads it to all my repositories again:
http://screencast.com/t/Ow7SlPVaS68
And then it says:
Finished upgrading git-annex to version 5.20140420-ga25b8bb
BUT that is the OLD version not the new one :-/
NEXT TRY:
killed all processes of git and git-annex, restart.
Was greeted by:
An upgrade of git-annex is available.
(version 5.20140421)
Klicked the Upgrade button.
Nothing happens, except that the upgrade notice disappeared :-/
"""]]

Some files were not shown because too many files have changed in this diff Show more