Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
c3d58178
Commit
c3d58178
authored
Aug 07, 2008
by
David Himmelstrup
Browse files
Simple upload support for build reports.
parent
5bf9c473
Changes
1
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/BuildReports/Upload.hs
0 → 100644
View file @
c3d58178
{-# LANGUAGE PatternGuards #-}
-- This is a quick hack for uploading build reports to Hackage.
module
Distribution.Client.BuildReports.Upload
(
BuildLog
,
BuildReportId
,
uploadReports
,
postBuildReport
,
putBuildLog
)
where
import
Distribution.Client.Types
(
Username
(
..
),
Password
(
..
))
import
Distribution.Client.HttpUtils
(
proxy
)
import
Distribution.Simple.Utils
(
debug
,
notice
,
warn
)
import
Distribution.Verbosity
(
Verbosity
)
import
Network.Browser
(
BrowserAction
,
browse
,
request
,
Authority
(
..
),
addAuthority
,
setAuthorityGen
,
setOutHandler
,
setErrHandler
,
setProxy
,
setAllowRedirects
)
import
Network.HTTP
(
Header
(
..
),
HeaderName
(
..
)
,
Request
(
..
),
RequestMethod
(
..
),
Response
(
..
)
)
import
Network.URI
(
URI
,
uriPath
,
parseURI
,
parseRelativeReference
,
relativeTo
)
import
Data.Char
(
intToDigit
)
import
Numeric
(
showHex
)
import
System.IO
(
hFlush
,
stdin
,
stdout
,
hGetEcho
,
hSetEcho
,
openBinaryFile
,
IOMode
(
ReadMode
),
hGetContents
)
import
Control.Exception
(
bracket
)
import
Control.Monad
import
System.Random
(
randomRIO
)
import
System.FilePath.Posix
import
qualified
Distribution.Client.BuildReports.Anonymous
as
BuildReport
import
Distribution.Client.BuildReports.Anonymous
(
BuildReport
)
type
BuildReportId
=
URI
type
BuildLog
=
String
uploadReports
::
URI
->
[(
BuildReport
,
Maybe
BuildLog
)]
->
BrowserAction
()
uploadReports
uri
reports
=
forM_
reports
$
\
(
report
,
mbBuildLog
)
->
do
buildId
<-
postBuildReport
uri
report
case
mbBuildLog
of
Just
buildLog
->
putBuildLog
buildId
buildLog
Nothing
->
return
()
postBuildReport
::
URI
->
BuildReport
->
BrowserAction
BuildReportId
postBuildReport
uri
buildReport
=
do
setAllowRedirects
False
(
_
,
response
)
<-
request
Request
{
rqURI
=
uri
,
rqMethod
=
POST
,
rqHeaders
=
[
Header
HdrContentType
(
"text/plain"
),
Header
HdrContentLength
(
show
(
length
body
)),
Header
HdrAccept
(
"text/plain"
)],
rqBody
=
body
}
case
rspCode
response
of
(
3
,
0
,
3
)
|
[
Just
buildId
]
<-
[
do
rel
<-
parseRelativeReference
location
relativeTo
rel
uri
|
Header
HdrLocation
location
<-
rspHeaders
response
]
->
return
$
buildId
_
->
error
"Unrecognised response from server."
where
body
=
BuildReport
.
show
buildReport
putBuildLog
::
BuildReportId
->
BuildLog
->
BrowserAction
()
putBuildLog
reportId
buildLog
=
do
(
_
,
response
)
<-
request
Request
{
rqURI
=
reportId
{
uriPath
=
uriPath
reportId
</>
"buildlog"
},
rqMethod
=
PUT
,
rqHeaders
=
[
Header
HdrContentType
(
"text/plain"
),
Header
HdrContentLength
(
show
(
length
buildLog
)),
Header
HdrAccept
(
"text/plain"
)],
rqBody
=
buildLog
}
return
()
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment