Git-annex remote can be specified with --submit option
This commit is contained in:
parent
a36f46a241
commit
6f1344e73e
@ -253,7 +253,8 @@ data GEvalSpecification = GEvalSpecification
|
||||
gesPrecision :: Maybe Int,
|
||||
gesTokenizer :: Maybe Tokenizer,
|
||||
gesGonitoHost :: Maybe String,
|
||||
gesToken :: Maybe String }
|
||||
gesToken :: Maybe String,
|
||||
gesGonitoGitAnnexRemote :: Maybe String }
|
||||
|
||||
gesMainMetric :: GEvalSpecification -> Metric
|
||||
gesMainMetric spec = case gesMetrics spec of
|
||||
@ -334,7 +335,8 @@ defaultGEvalSpecification = GEvalSpecification {
|
||||
gesPrecision = Nothing,
|
||||
gesTokenizer = Nothing,
|
||||
gesGonitoHost = Nothing,
|
||||
gesToken = Nothing }
|
||||
gesToken = Nothing,
|
||||
gesGonitoGitAnnexRemote = Nothing }
|
||||
|
||||
isEmptyFile :: FilePath -> IO (Bool)
|
||||
isEmptyFile path = do
|
||||
|
@ -155,6 +155,12 @@ specParser = GEvalSpecification
|
||||
<> help "Submit ONLY: Token for authorization with Gonito instance."
|
||||
)
|
||||
)
|
||||
<*> ( optional . strOption $
|
||||
( long "gonito-git-annex-remote"
|
||||
<> metavar "GIT-ANNEX-REMOTE"
|
||||
<> help "Submit ONLY: Specification of a git-annex remote."
|
||||
)
|
||||
)
|
||||
|
||||
singletonMaybe :: Maybe a -> Maybe [a]
|
||||
singletonMaybe (Just x) = Just [x]
|
||||
@ -250,7 +256,7 @@ runGEval''' (Just JustTokenize) _ spec = do
|
||||
justTokenize (gesTokenizer spec)
|
||||
return Nothing
|
||||
runGEval''' (Just Submit) _ spec = do
|
||||
submit (gesGonitoHost spec) (gesToken spec)
|
||||
submit (gesGonitoHost spec) (gesToken spec) (gesGonitoGitAnnexRemote spec)
|
||||
return Nothing
|
||||
|
||||
initChallenge :: GEvalSpecification -> IO ()
|
||||
|
@ -34,9 +34,9 @@ import qualified Data.ByteString.Char8 as BS
|
||||
tokenFileName :: String
|
||||
tokenFileName = ".token"
|
||||
|
||||
submit :: Maybe String -> Maybe String -> IO ()
|
||||
submit Nothing _ = failWith "Please provide a Gonito host with --gonito-host option"
|
||||
submit (Just host) tok = do
|
||||
submit :: Maybe String -> Maybe String -> Maybe String -> IO ()
|
||||
submit Nothing _ _ = failWith "Please provide a Gonito host with --gonito-host option"
|
||||
submit (Just host) tok mGitAnnexRemote = do
|
||||
branch <- getCurrentBranch
|
||||
challengeId <- getChallengeId
|
||||
repoUrl <- getRemoteUrl "origin"
|
||||
@ -46,18 +46,20 @@ submit (Just host) tok = do
|
||||
checkEverythingCommitted
|
||||
checkRemoteSynced
|
||||
token <- getToken tok
|
||||
trigger host token branch challengeId repoUrl
|
||||
trigger host token branch challengeId repoUrl mGitAnnexRemote
|
||||
|
||||
trigger :: String -> String -> String -> String -> String -> IO ()
|
||||
trigger host token branch challengeId repoUrl = do
|
||||
trigger :: String -> String -> String -> String -> String -> Maybe String -> IO ()
|
||||
trigger host token branch challengeId repoUrl mGitAnnexRemote = do
|
||||
putStrLn $ "Triggering: " ++ url
|
||||
putStrLn "Please wait, it may take some time"
|
||||
req <- parseRequest url
|
||||
let params = map (\(pname, pval) -> (BS.pack $ pname, BS.pack $ pval)) [
|
||||
let params = map (\(pname, pval) -> (BS.pack $ pname, BS.pack $ pval)) ([
|
||||
("challenge", challengeId),
|
||||
("branch", branch),
|
||||
("token", token),
|
||||
("url", repoUrl)]
|
||||
("url", repoUrl)] ++ case mGitAnnexRemote of
|
||||
Just gitAnnexRemote -> [("git-annex-remote", gitAnnexRemote)]
|
||||
Nothing -> [])
|
||||
let req' = setRequestBodyURLEncoded params req
|
||||
httpBS req' >>= BS.putStrLn . getResponseBody
|
||||
where url = "POST " ++ hostWithProtocol ++ "/trigger-remotely"
|
||||
|
Loading…
Reference in New Issue
Block a user