mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions 1

WIP yesod 1.2

Browse source
This commit is contained in:
Joey Hess 2013-06-02 15:57:22 -04:00
parent 92f036fcb4
commit 79fd677805
18 changed files with 94 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

26
Assistant/WebApp/Configurators/AWS.hs
View file

@ -63,7 +63,7 @@ data AWSCreds = AWSCreds Text Text
extractCreds :: AWSInput -> AWSCreds
extractCreds i = AWSCreds (accessKeyID i) (secretAccessKey i)
s3InputAForm :: Maybe CredPair -> AForm WebApp WebApp AWSInput
s3InputAForm :: Maybe CredPair -> AForm Handler AWSInput
s3InputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
@ -78,7 +78,7 @@ s3InputAForm defcreds = AWSInput
, ("Reduced redundancy (costs less)", ReducedRedundancy)
]
glacierInputAForm :: Maybe CredPair -> AForm WebApp WebApp AWSInput
glacierInputAForm :: Maybe CredPair -> AForm Handler AWSInput
glacierInputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
@ -87,15 +87,15 @@ glacierInputAForm defcreds = AWSInput
<*> areq textField "Repository name" (Just "glacier")
<*> enableEncryptionField
awsCredsAForm :: Maybe CredPair -> AForm WebApp WebApp AWSCreds
awsCredsAForm :: Maybe CredPair -> AForm Handler AWSCreds
awsCredsAForm defcreds = AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
accessKeyIDField :: Widget -> Maybe Text -> AForm WebApp WebApp Text
accessKeyIDField :: Widget -> Maybe Text -> AForm Handler Text
accessKeyIDField help def = areq (textField `withNote` help) "Access Key ID" def
accessKeyIDFieldWithHelp :: Maybe Text -> AForm WebApp WebApp Text
accessKeyIDFieldWithHelp :: Maybe Text -> AForm Handler Text
accessKeyIDFieldWithHelp def = accessKeyIDField help def
where
help = [whamlet|
@ -103,10 +103,10 @@ accessKeyIDFieldWithHelp def = accessKeyIDField help def
Get Amazon access keys
|]
secretAccessKeyField :: Maybe Text -> AForm WebApp WebApp Text
secretAccessKeyField :: Maybe Text -> AForm Handler Text
secretAccessKeyField def = areq passwordField "Secret Access Key" def
datacenterField :: AWS.Service -> AForm WebApp WebApp Text
datacenterField :: AWS.Service -> AForm Handler Text
datacenterField service = areq (selectFieldList list) "Datacenter" defregion
where
list = M.toList $ AWS.regionMap service
@ -119,10 +119,10 @@ postAddS3R :: Handler RepHtml
#ifdef WITH_S3
postAddS3R = awsConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ s3InputAForm defcreds
case result of
FormSuccess input -> lift $ do
FormSuccess input -> handlerToWidget $ do
let name = T.unpack $ repoName input
makeAWSRemote S3.remote (extractCreds input) name setgroup $ M.fromList
[ configureEncryption $ enableEncryption input
@ -145,10 +145,10 @@ postAddGlacierR :: Handler RepHtml
#ifdef WITH_S3
postAddGlacierR = glacierConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ glacierInputAForm defcreds
case result of
FormSuccess input -> lift $ do
FormSuccess input -> handlerToWidget $ do
let name = T.unpack $ repoName input
makeAWSRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList
[ configureEncryption $ enableEncryption input
@ -191,10 +191,10 @@ enableAWSRemote :: RemoteType -> UUID -> Widget
#ifdef WITH_S3
enableAWSRemote remotetype uuid = do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ awsCredsAForm defcreds
case result of
FormSuccess creds -> lift $ do
FormSuccess creds -> handlerToWidget $ do
m <- liftAnnex readRemoteLog
let name = fromJust $ M.lookup "name" $
fromJust $ M.lookup uuid m

8
Assistant/WebApp/Configurators/Delete.hs
View file

@ -72,14 +72,14 @@ postDeleteCurrentRepositoryR = deleteCurrentRepository
deleteCurrentRepository :: Handler RepHtml
deleteCurrentRepository = dangerPage $ do
reldir <- fromJust . relDir <$> lift getYesod
reldir <- fromJust . relDir <$> handlerToWidget getYesod
havegitremotes <- haveremotes syncGitRemotes
havedataremotes <- haveremotes syncDataRemotes
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ sanityVerifierAForm $
SanityVerifier magicphrase
case result of
FormSuccess _ -> lift $ do
FormSuccess _ -> handlerToWidget $ do
dir <- liftAnnex $ fromRepo Git.repoPath
liftIO $ removeAutoStartFile dir
@ -107,7 +107,7 @@ deleteCurrentRepository = dangerPage $ do
data SanityVerifier = SanityVerifier T.Text
deriving (Eq)
sanityVerifierAForm :: SanityVerifier -> AForm WebApp WebApp SanityVerifier
sanityVerifierAForm :: SanityVerifier -> AForm Handler SanityVerifier
sanityVerifierAForm template = SanityVerifier
<$> areq checksanity "Confirm deletion?" Nothing
where

6
Assistant/WebApp/Configurators/Edit.hs
View file

@ -132,7 +132,7 @@ setRepoConfig uuid mremote oldc newc = do
legalName = makeLegalName . T.unpack . repoName
editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig
editRepositoryAForm :: RepoConfig -> AForm Handler RepoConfig
editRepositoryAForm def = RepoConfig
<$> areq textField "Name" (Just $ repoName def)
<*> aopt textField "Description" (Just $ repoDescription def)
@ -177,10 +177,10 @@ editForm new uuid = page "Configure repository" (Just Configuration) $ do
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
curr <- liftAnnex $ getRepoConfig uuid mremote
liftAnnex $ checkAssociatedDirectory curr mremote
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ editRepositoryAForm curr
case result of
FormSuccess input -> lift $ do
FormSuccess input -> handlerToWidget $ do
setRepoConfig uuid mremote curr input
liftAnnex $ checkAssociatedDirectory input mremote
redirect DashboardR

14
Assistant/WebApp/Configurators/IA.hs
View file

@ -79,7 +79,7 @@ showMediaType MediaVideo = "videos & movies"
showMediaType MediaAudio = "audio & music"
showMediaType MediaOmitted = "other"
iaInputAForm :: Maybe CredPair -> AForm WebApp WebApp IAInput
iaInputAForm :: Maybe CredPair -> AForm Handler IAInput
iaInputAForm defcreds = IAInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
@ -99,7 +99,7 @@ itemNameHelp = [whamlet|
will be uploaded to your Internet Archive item.
|]
iaCredsAForm :: Maybe CredPair -> AForm WebApp WebApp AWS.AWSCreds
iaCredsAForm :: Maybe CredPair -> AForm Handler AWS.AWSCreds
iaCredsAForm defcreds = AWS.AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
@ -110,7 +110,7 @@ previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $
AWS.isIARemoteConfig . Remote.config
#endif
accessKeyIDFieldWithHelp :: Maybe Text -> AForm WebApp WebApp Text
accessKeyIDFieldWithHelp :: Maybe Text -> AForm Handler Text
accessKeyIDFieldWithHelp def = AWS.accessKeyIDField help def
where
help = [whamlet|
@ -125,10 +125,10 @@ postAddIAR :: Handler RepHtml
#ifdef WITH_S3
postAddIAR = iaConfigurator $ do
defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ iaInputAForm defcreds
case result of
FormSuccess input -> lift $ do
FormSuccess input -> handlerToWidget $ do
let name = escapeBucket $ T.unpack $ itemName input
AWS.makeAWSRemote S3.remote (extractCreds input) name setgroup $
M.fromList $ catMaybes
@ -167,10 +167,10 @@ postEnableIAR _ = error "S3 not supported by this build"
enableIARemote :: UUID -> Widget
enableIARemote uuid = do
defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ iaCredsAForm defcreds
case result of
FormSuccess creds -> lift $ do
FormSuccess creds -> handlerToWidget $ do
m <- liftAnnex readRemoteLog
let name = fromJust $ M.lookup "name" $
fromJust $ M.lookup uuid m

22
Assistant/WebApp/Configurators/Local.hs
View file

@ -46,7 +46,7 @@ data RepositoryPath = RepositoryPath Text
-
- Validates that the path entered is not empty, and is a safe value
- to use as a repository. -}
repositoryPathField :: forall sub. Bool -> Field sub WebApp Text
repositoryPathField :: forall (m :: * -> *). (MonadIO m, HandlerSite m ~ WebApp) => Bool -> Field m Text
repositoryPathField autofocus = Field
#if ! MIN_VERSION_yesod_form(1,2,0)
{ fieldParse = parse
@ -119,7 +119,7 @@ defaultRepositoryPath firstrun = do
)
legit d = not <$> doesFileExist (d </> "git-annex")
newRepositoryForm :: FilePath -> Form RepositoryPath
newRepositoryForm :: FilePath -> Html -> Form RepositoryPath
newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) ""
(Just $ T.pack $ addTrailingPathSeparator defpath)
@ -142,11 +142,11 @@ postFirstRepositoryR = page "Getting started" (Just Configuration) $ do
let path = "/sdcard/annex"
#else
let androidspecial = False
path <- liftIO . defaultRepositoryPath =<< lift inFirstRun
path <- liftIO . defaultRepositoryPath =<< handlerToWidget inFirstRun
#endif
((res, form), enctype) <- lift $ runFormPost $ newRepositoryForm path
((res, form), enctype) <- handlerToWidget $ runFormPost $ newRepositoryForm path
case res of
FormSuccess (RepositoryPath p) -> lift $
FormSuccess (RepositoryPath p) -> handlerToWidget $
startFullAssistant (T.unpack p) ClientGroup
_ -> $(widgetFile "configurators/newrepository/first")
@ -160,13 +160,13 @@ getNewRepositoryR = postNewRepositoryR
postNewRepositoryR :: Handler RepHtml
postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
home <- liftIO myHomeDir
((res, form), enctype) <- lift $ runFormPost $ newRepositoryForm home
((res, form), enctype) <- handlerToWidget $ runFormPost $ newRepositoryForm home
case res of
FormSuccess (RepositoryPath p) -> do
let path = T.unpack p
isnew <- liftIO $ makeRepo path False
u <- liftIO $ initRepo isnew True path Nothing
lift $ liftAnnexOr () $ setStandardGroup u ClientGroup
handlerToWidget $ liftAnnexOr () $ setStandardGroup u ClientGroup
liftIO $ addAutoStartFile path
liftIO $ startAssistant path
askcombine u path
@ -174,7 +174,7 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
where
askcombine newrepouuid newrepopath = do
newrepo <- liftIO $ relHome newrepopath
mainrepo <- fromJust . relDir <$> lift getYesod
mainrepo <- fromJust . relDir <$> handlerToWidget getYesod
$(widgetFile "configurators/newrepository/combine")
getCombineRepositoryR :: FilePathAndUUID -> Handler RepHtml
@ -185,7 +185,7 @@ getCombineRepositoryR (FilePathAndUUID newrepopath newrepouuid) = do
where
remotename = takeFileName newrepopath
selectDriveForm :: [RemovableDrive] -> Form RemovableDrive
selectDriveForm :: [RemovableDrive] -> Html -> Form RemovableDrive
selectDriveForm drives = renderBootstrap $ RemovableDrive
<$> pure Nothing
<*> areq (selectFieldList pairs) "Select drive:" Nothing
@ -215,10 +215,10 @@ postAddDriveR = page "Add a removable drive" (Just Configuration) $ do
removabledrives <- liftIO $ driveList
writabledrives <- liftIO $
filterM (canWrite . T.unpack . mountPoint) removabledrives
((res, form), enctype) <- lift $ runFormPost $
((res, form), enctype) <- handlerToWidget $ runFormPost $
selectDriveForm (sort writabledrives)
case res of
FormSuccess drive -> lift $ redirect $ ConfirmAddDriveR drive
FormSuccess drive -> handlerToWidget $ redirect $ ConfirmAddDriveR drive
_ -> $(widgetFile "configurators/adddrive")
{- The repo may already exist, when adding removable media

10
Assistant/WebApp/Configurators/Pairing.hs
View file

@ -146,7 +146,7 @@ getFinishLocalPairR = postFinishLocalPairR
postFinishLocalPairR :: PairMsg -> Handler RepHtml
#ifdef WITH_PAIRING
postFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do
repodir <- lift $ repoPath <$> liftAnnex gitRepo
repodir <- handlerToWidget $ repoPath <$> liftAnnex gitRepo
liftIO $ setup repodir
startLocalPairing PairAck (cleanup repodir) alert uuid "" secret
where
@ -216,8 +216,8 @@ getRunningLocalPairR _ = noLocalPairing
-}
startLocalPairing :: PairStage -> IO () -> (AlertButton -> Alert) -> Maybe UUID -> Text -> Secret -> Widget
startLocalPairing stage oncancel alert muuid displaysecret secret = do
urlrender <- lift getUrlRender
reldir <- fromJust . relDir <$> lift getYesod
urlrender <- handlerToWidget getUrlRender
reldir <- fromJust . relDir <$> handlerToWidget getYesod
sendrequests <- liftAssistant $ asIO2 $ mksendrequests urlrender
{- Generating a ssh key pair can take a while, so do it in the
@ -235,7 +235,7 @@ startLocalPairing stage oncancel alert muuid displaysecret secret = do
startSending pip stage $ sendrequests sender
void $ liftIO $ forkIO thread
lift $ redirect $ RunningLocalPairR $ toSecretReminder displaysecret
handlerToWidget $ redirect $ RunningLocalPairR $ toSecretReminder displaysecret
where
{- Sends pairing messages until the thread is killed,
- and shows an activity alert while doing it.
@ -264,7 +264,7 @@ data InputSecret = InputSecret { secretText :: Maybe Text }
- that can validate it. -}
promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler RepHtml
promptSecret msg cont = pairPage $ do
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $
InputSecret <$> aopt textField "Secret phrase" Nothing
case result of

6
Assistant/WebApp/Configurators/Preferences.hs
View file

@ -29,7 +29,7 @@ data PrefsForm = PrefsForm
, debugEnabled :: Bool
}
prefsAForm :: PrefsForm -> AForm WebApp WebApp PrefsForm
prefsAForm :: PrefsForm -> AForm Handler PrefsForm
prefsAForm def = PrefsForm
<$> areq (storageField `withNote` diskreservenote)
"Disk reserve" (Just $ diskReserve def)
@ -86,11 +86,11 @@ getPreferencesR :: Handler RepHtml
getPreferencesR = postPreferencesR
postPreferencesR :: Handler RepHtml
postPreferencesR = page "Preferences" (Just Configuration) $ do
((result, form), enctype) <- lift $ do
((result, form), enctype) <- handlerToWidget $ do
current <- liftAnnex getPrefs
runFormPost $ renderBootstrap $ prefsAForm current
case result of
FormSuccess new -> lift $ do
FormSuccess new -> handlerToWidget $ do
liftAnnex $ storePrefs new
redirect ConfigurationR
_ -> $(widgetFile "configurators/preferences")

12
Assistant/WebApp/Configurators/Ssh.hs
View file

@ -58,7 +58,7 @@ mkSshInput s = SshInput
, inputPort = sshPort s
}
sshInputAForm :: (Field WebApp WebApp Text) -> SshInput -> AForm WebApp WebApp SshInput
sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
sshInputAForm hostnamefield def = SshInput
<$> aopt check_hostname "Host name" (Just $ inputHostname def)
<*> aopt check_username "User name" (Just $ inputUsername def)
@ -107,7 +107,7 @@ getAddSshR = postAddSshR
postAddSshR :: Handler RepHtml
postAddSshR = sshConfigurator $ do
u <- liftIO $ T.pack <$> myUserName
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ sshInputAForm textField $
SshInput Nothing (Just u) Nothing 22
case result of
@ -115,7 +115,7 @@ postAddSshR = sshConfigurator $ do
s <- liftIO $ testServer sshinput
case s of
Left status -> showform form enctype status
Right sshdata -> lift $ redirect $ ConfirmSshR sshdata
Right sshdata -> handlerToWidget $ redirect $ ConfirmSshR sshdata
_ -> showform form enctype UntestedServer
where
showform form enctype status = $(widgetFile "configurators/ssh/add")
@ -138,12 +138,12 @@ postEnableRsyncR u = do
m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
case (parseSshRsyncUrl =<< M.lookup "rsyncurl" m, M.lookup "name" m) of
(Just sshinput, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ sshInputAForm textField sshinput
case result of
FormSuccess sshinput'
| isRsyncNet (inputHostname sshinput') ->
void $ lift $ makeRsyncNet sshinput' reponame (const noop)
void $ handlerToWidget $ makeRsyncNet sshinput' reponame (const noop)
| otherwise -> do
s <- liftIO $ testServer sshinput'
case s of
@ -156,7 +156,7 @@ postEnableRsyncR u = do
showform form enctype status = do
description <- liftAnnex $ T.pack <$> prettyUUID u
$(widgetFile "configurators/ssh/enable")
enable sshdata = lift $ redirect $ ConfirmSshR $
enable sshdata = handlerToWidget $ redirect $ ConfirmSshR $
sshdata { rsyncOnly = True }
{- Converts a rsyncurl value to a SshInput. But only if it's a ssh rsync

14
Assistant/WebApp/Configurators/WebDAV.hs
View file

@ -43,7 +43,7 @@ data WebDAVInput = WebDAVInput
toCredPair :: WebDAVInput -> CredPair
toCredPair input = (T.unpack $ user input, T.unpack $ password input)
boxComAForm :: Maybe CredPair -> AForm WebApp WebApp WebDAVInput
boxComAForm :: Maybe CredPair -> AForm Handler WebDAVInput
boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds)
@ -51,7 +51,7 @@ boxComAForm defcreds = WebDAVInput
<*> areq textField "Directory" (Just "annex")
<*> enableEncryptionField
webDAVCredsAForm :: Maybe CredPair -> AForm WebApp WebApp WebDAVInput
webDAVCredsAForm :: Maybe CredPair -> AForm Handler WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds)
@ -65,10 +65,10 @@ postAddBoxComR :: Handler RepHtml
#ifdef WITH_WEBDAV
postAddBoxComR = boxConfigurator $ do
defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ boxComAForm defcreds
case result of
FormSuccess input -> lift $
FormSuccess input -> handlerToWidget $
makeWebDavRemote "box.com" (toCredPair input) setgroup $ M.fromList
[ configureEncryption $ enableEncryption input
, ("embedcreds", if embedCreds input then "yes" else "no")
@ -99,7 +99,7 @@ postEnableWebDAVR uuid = do
mcreds <- liftAnnex $
getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid)
case mcreds of
Just creds -> webDAVConfigurator $ lift $
Just creds -> webDAVConfigurator $ handlerToWidget $
makeWebDavRemote name creds (const noop) M.empty
Nothing
| "box.com/" `isInfixOf` url ->
@ -111,10 +111,10 @@ postEnableWebDAVR uuid = do
defcreds <- liftAnnex $
maybe (pure Nothing) previouslyUsedWebDAVCreds $
urlHost url
((result, form), enctype) <- lift $
((result, form), enctype) <- handlerToWidget $
runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds
case result of
FormSuccess input -> lift $
FormSuccess input -> handlerToWidget $
makeWebDavRemote name (toCredPair input) (const noop) M.empty
_ -> do
description <- liftAnnex $

8
Assistant/WebApp/Configurators/XMPP.hs
View file

@ -110,13 +110,13 @@ postXMPPConfigForPairSelfR = xmppform StartXMPPPairSelfR
xmppform :: Route WebApp -> Handler RepHtml
#ifdef WITH_XMPP
xmppform next = xmppPage $ do
((result, form), enctype) <- lift $ do
((result, form), enctype) <- handlerToWidget $ do
oldcreds <- liftAnnex getXMPPCreds
runFormPost $ renderBootstrap $ xmppAForm $
creds2Form <$> oldcreds
let showform problem = $(widgetFile "configurators/xmpp")
case result of
FormSuccess f -> either (showform . Just) (lift . storecreds)
FormSuccess f -> either (showform . Just) (handlerToWidget . storecreds)
=<< liftIO (validateForm f)
_ -> showform Nothing
where
@ -171,12 +171,12 @@ data XMPPForm = XMPPForm
creds2Form :: XMPPCreds -> XMPPForm
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
xmppAForm :: (Maybe XMPPForm) -> AForm WebApp WebApp XMPPForm
xmppAForm :: (Maybe XMPPForm) -> AForm Handler XMPPForm
xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def)
<*> areq passwordField "Password" Nothing
jidField :: Field WebApp WebApp Text
jidField :: Field Handler Text
jidField = checkBool (isJust . parseJID) bad textField
where
bad :: Text