module Distribution.Client.Upload (upload, uploadDoc, report) where

import Distribution.Client.Compat.Prelude
import qualified Prelude as Unsafe (tail, head, read)

import Distribution.Client.Types.Credentials ( Username(..), Password(..) )
import Distribution.Client.Types.Repo (Repo, RemoteRepo(..), maybeRepoRemote)
import Distribution.Client.Types.RepoName (unRepoName)
import Distribution.Client.HttpUtils
         ( HttpTransport(..), remoteRepoTryUpgradeToHttps )
import Distribution.Client.Setup
         ( IsCandidate(..), RepoContext(..) )

import Distribution.Simple.Utils (notice, warn, info, die', toUTF8BS)
import Distribution.Utils.String (trim)
import Distribution.Client.Config

import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
import Distribution.Client.BuildReports.Anonymous (parseBuildReport)
import qualified Distribution.Client.BuildReports.Upload as BuildReport

import Network.URI (URI(uriPath, uriAuthority), URIAuth(uriRegName))
import Network.HTTP (Header(..), HeaderName(..))

import System.IO        (hFlush, stdout)
import System.IO.Echo   (withoutInputEcho)
import System.FilePath  ((</>), takeExtension, takeFileName, dropExtension)
import qualified System.FilePath.Posix as FilePath.Posix ((</>))
import System.Directory

type Auth = Maybe (String, String)

-- > stripExtensions ["tar", "gz"] "foo.tar.gz"
-- Just "foo"
-- > stripExtensions ["tar", "gz"] "foo.gz.tar"
-- Nothing
stripExtensions :: [String] -> FilePath -> Maybe String
stripExtensions :: [String] -> String -> Maybe String
stripExtensions [String]
exts String
path = (String -> String -> Maybe String)
-> String -> [String] -> Maybe String
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM String -> String -> Maybe String
f String
path ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
exts)
 where
  f :: String -> String -> Maybe String
f String
p String
e
    | String -> String
takeExtension String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
e = String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
dropExtension String
p)
    | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

upload :: Verbosity -> RepoContext
       -> Maybe Username -> Maybe Password -> IsCandidate -> [FilePath]
       -> IO ()
upload :: Verbosity
-> RepoContext
-> Maybe Username
-> Maybe Password
-> IsCandidate
-> [String]
-> IO ()
upload Verbosity
verbosity RepoContext
repoCtxt Maybe Username
mUsername Maybe Password
mPassword IsCandidate
isCandidate [String]
paths = do
    let repos :: [Repo]
        repos :: [Repo]
repos = RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt
    HttpTransport
transport  <- RepoContext -> IO HttpTransport
repoContextGetTransport RepoContext
repoCtxt
    RemoteRepo
targetRepo <-
      case [ RemoteRepo
remoteRepo | Just RemoteRepo
remoteRepo <- (Repo -> Maybe RemoteRepo) -> [Repo] -> [Maybe RemoteRepo]
forall a b. (a -> b) -> [a] -> [b]
map Repo -> Maybe RemoteRepo
maybeRepoRemote [Repo]
repos ] of
        [] -> Verbosity -> String -> IO RemoteRepo
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Cannot upload. No remote repositories are configured."
        (RemoteRepo
r:[RemoteRepo]
rs) -> Verbosity -> HttpTransport -> RemoteRepo -> IO RemoteRepo
remoteRepoTryUpgradeToHttps Verbosity
verbosity HttpTransport
transport (NonEmpty RemoteRepo -> RemoteRepo
forall a. NonEmpty a -> a
last (RemoteRepo
rRemoteRepo -> [RemoteRepo] -> NonEmpty RemoteRepo
forall a. a -> [a] -> NonEmpty a
:|[RemoteRepo]
rs))
    let targetRepoURI :: URI
        targetRepoURI :: URI
targetRepoURI = RemoteRepo -> URI
remoteRepoURI RemoteRepo
targetRepo
        domain :: String
        domain :: String
domain = String -> (URIAuth -> String) -> Maybe URIAuth -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Hackage" URIAuth -> String
uriRegName (Maybe URIAuth -> String) -> Maybe URIAuth -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
uriAuthority URI
targetRepoURI
        rootIfEmpty :: String -> String
rootIfEmpty String
x = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x then String
"/" else String
x
        uploadURI :: URI
        uploadURI :: URI
uploadURI = URI
targetRepoURI {
            uriPath :: String
uriPath = String -> String
rootIfEmpty (URI -> String
uriPath URI
targetRepoURI) String -> String -> String
FilePath.Posix.</>
              case IsCandidate
isCandidate of
                IsCandidate
IsCandidate -> String
"packages/candidates"
                IsCandidate
IsPublished -> String
"upload"
        }
        packageURI :: String -> URI
packageURI String
pkgid = URI
targetRepoURI {
            uriPath :: String
uriPath = String -> String
rootIfEmpty (URI -> String
uriPath URI
targetRepoURI)
                      String -> String -> String
FilePath.Posix.</> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ String
"package/", String
pkgid
              , case IsCandidate
isCandidate of
                  IsCandidate
IsCandidate -> String
"/candidate"
                  IsCandidate
IsPublished -> String
""
              ]
        }
    Username String
username <- IO Username
-> (Username -> IO Username) -> Maybe Username -> IO Username
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO Username
promptUsername String
domain) Username -> IO Username
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Username
mUsername
    Password String
password <- IO Password
-> (Password -> IO Password) -> Maybe Password -> IO Password
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO Password
promptPassword String
domain) Password -> IO Password
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Password
mPassword
    let auth :: Maybe (String, String)
auth = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
username,String
password)
    [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
paths ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
path -> do
      Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Uploading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"... "
      case (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
takeFileName ([String] -> String -> Maybe String
stripExtensions [String
"tar", String
"gz"] String
path) of
        Just String
pkgid -> HttpTransport
-> Verbosity
-> URI
-> URI
-> Maybe (String, String)
-> IsCandidate
-> String
-> IO ()
handlePackage HttpTransport
transport Verbosity
verbosity URI
uploadURI
                                    (String -> URI
packageURI String
pkgid) Maybe (String, String)
auth IsCandidate
isCandidate String
path
        -- This case shouldn't really happen, since we check in Main that we
        -- only pass tar.gz files to upload.
        Maybe String
Nothing -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Not a tar.gz file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path

uploadDoc :: Verbosity -> RepoContext
          -> Maybe Username -> Maybe Password -> IsCandidate -> FilePath
          -> IO ()
uploadDoc :: Verbosity
-> RepoContext
-> Maybe Username
-> Maybe Password
-> IsCandidate
-> String
-> IO ()
uploadDoc Verbosity
verbosity RepoContext
repoCtxt Maybe Username
mUsername Maybe Password
mPassword IsCandidate
isCandidate String
path = do
    let repos :: [Repo]
repos = RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt
    HttpTransport
transport  <- RepoContext -> IO HttpTransport
repoContextGetTransport RepoContext
repoCtxt
    RemoteRepo
targetRepo <-
      case [ RemoteRepo
remoteRepo | Just RemoteRepo
remoteRepo <- (Repo -> Maybe RemoteRepo) -> [Repo] -> [Maybe RemoteRepo]
forall a b. (a -> b) -> [a] -> [b]
map Repo -> Maybe RemoteRepo
maybeRepoRemote [Repo]
repos ] of
        [] -> Verbosity -> String -> IO RemoteRepo
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO RemoteRepo) -> String -> IO RemoteRepo
forall a b. (a -> b) -> a -> b
$ String
"Cannot upload. No remote repositories are configured."
        (RemoteRepo
r:[RemoteRepo]
rs) -> Verbosity -> HttpTransport -> RemoteRepo -> IO RemoteRepo
remoteRepoTryUpgradeToHttps Verbosity
verbosity HttpTransport
transport (NonEmpty RemoteRepo -> RemoteRepo
forall a. NonEmpty a -> a
last (RemoteRepo
rRemoteRepo -> [RemoteRepo] -> NonEmpty RemoteRepo
forall a. a -> [a] -> NonEmpty a
:|[RemoteRepo]
rs))
    let targetRepoURI :: URI
targetRepoURI = RemoteRepo -> URI
remoteRepoURI RemoteRepo
targetRepo
        domain :: String
domain = String -> (URIAuth -> String) -> Maybe URIAuth -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Hackage" URIAuth -> String
uriRegName (Maybe URIAuth -> String) -> Maybe URIAuth -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
uriAuthority URI
targetRepoURI
        rootIfEmpty :: String -> String
rootIfEmpty String
x = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x then String
"/" else String
x
        uploadURI :: URI
uploadURI = URI
targetRepoURI {
            uriPath :: String
uriPath = String -> String
rootIfEmpty (URI -> String
uriPath URI
targetRepoURI)
                      String -> String -> String
FilePath.Posix.</> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ String
"package/", String
pkgid
              , case IsCandidate
isCandidate of
                IsCandidate
IsCandidate -> String
"/candidate"
                IsCandidate
IsPublished -> String
""
              , String
"/docs"
              ]
        }
        packageUri :: URI
packageUri = URI
targetRepoURI {
            uriPath :: String
uriPath = String -> String
rootIfEmpty (URI -> String
uriPath URI
targetRepoURI)
                      String -> String -> String
FilePath.Posix.</> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ String
"package/", String
pkgid
              , case IsCandidate
isCandidate of
                  IsCandidate
IsCandidate -> String
"/candidate"
                  IsCandidate
IsPublished -> String
""
              ]
        }
        (String
reverseSuffix, String
reversePkgid) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
                                        (String -> String
forall a. [a] -> [a]
reverse (String -> String
takeFileName String
path))
        pkgid :: String
pkgid = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
Unsafe.tail String
reversePkgid
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> String
forall a. [a] -> [a]
reverse String
reverseSuffix String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"docs.tar.gz"
          Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
reversePkgid Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
Unsafe.head String
reversePkgid Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Expected a file name matching the pattern <pkgid>-docs.tar.gz"
    Username String
username <- IO Username
-> (Username -> IO Username) -> Maybe Username -> IO Username
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO Username
promptUsername String
domain) Username -> IO Username
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Username
mUsername
    Password String
password <- IO Password
-> (Password -> IO Password) -> Maybe Password -> IO Password
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO Password
promptPassword String
domain) Password -> IO Password
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Password
mPassword

    let auth :: Maybe (String, String)
auth = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
username,String
password)
        headers :: [Header]
headers =
          [ HeaderName -> String -> Header
Header HeaderName
HdrContentType String
"application/x-tar"
          , HeaderName -> String -> Header
Header HeaderName
HdrContentEncoding String
"gzip"
          ]
    Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Uploading documentation " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"... "
    (HttpCode, String)
resp <- HttpTransport
-> Verbosity
-> URI
-> String
-> Maybe (String, String)
-> [Header]
-> IO (HttpCode, String)
putHttpFile HttpTransport
transport Verbosity
verbosity URI
uploadURI String
path Maybe (String, String)
auth [Header]
headers
    case (HttpCode, String)
resp of
      -- Hackage responds with 204 No Content when docs are uploaded
      -- successfully.
      (HttpCode
code,String
_) | HttpCode
code HttpCode -> [HttpCode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [HttpCode
200,HttpCode
204] -> do
        Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
okMessage URI
packageUri
      (HttpCode
code,String
err)  -> do
        Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error uploading documentation "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"http code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HttpCode -> String
forall a. Show a => a -> String
show HttpCode
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        IO ()
forall a. IO a
exitFailure
  where
    okMessage :: a -> String
okMessage a
packageUri = case IsCandidate
isCandidate of
      IsCandidate
IsCandidate ->
        String
"Documentation successfully uploaded for package candidate. "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"You can now preview the result at '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
packageUri
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'. To upload non-candidate documentation, use 'cabal upload --publish'."
      IsCandidate
IsPublished ->
        String
"Package documentation successfully published. You can now view it at '"
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
packageUri String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."


promptUsername :: String -> IO Username
promptUsername :: String -> IO Username
promptUsername String
domain = do
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
domain String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" username: "
  Handle -> IO ()
hFlush Handle
stdout
  (String -> Username) -> IO String -> IO Username
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Username
Username IO String
getLine

promptPassword :: String -> IO Password
promptPassword :: String -> IO Password
promptPassword String
domain = do
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
domain String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" password: "
  Handle -> IO ()
hFlush Handle
stdout
  -- save/restore the terminal echoing status (no echoing for entering the password)
  Password
passwd <- IO Password -> IO Password
forall a. IO a -> IO a
withoutInputEcho (IO Password -> IO Password) -> IO Password -> IO Password
forall a b. (a -> b) -> a -> b
$ (String -> Password) -> IO String -> IO Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Password
Password IO String
getLine
  String -> IO ()
putStrLn String
""
  Password -> IO Password
forall (m :: * -> *) a. Monad m => a -> m a
return Password
passwd

report :: Verbosity -> RepoContext -> Maybe Username -> Maybe Password -> IO ()
report :: Verbosity
-> RepoContext -> Maybe Username -> Maybe Password -> IO ()
report Verbosity
verbosity RepoContext
repoCtxt Maybe Username
mUsername Maybe Password
mPassword = do
  let repos       :: [Repo]
      repos :: [Repo]
repos       = RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt
      remoteRepos :: [RemoteRepo]
      remoteRepos :: [RemoteRepo]
remoteRepos = (Repo -> Maybe RemoteRepo) -> [Repo] -> [RemoteRepo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Repo -> Maybe RemoteRepo
maybeRepoRemote [Repo]
repos
  [RemoteRepo] -> (RemoteRepo -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [RemoteRepo]
remoteRepos ((RemoteRepo -> IO ()) -> IO ()) -> (RemoteRepo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \RemoteRepo
remoteRepo -> do
      let domain :: String
domain = String -> (URIAuth -> String) -> Maybe URIAuth -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Hackage" URIAuth -> String
uriRegName (Maybe URIAuth -> String) -> Maybe URIAuth -> String
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
uriAuthority (RemoteRepo -> URI
remoteRepoURI RemoteRepo
remoteRepo)
      Username String
username <- IO Username
-> (Username -> IO Username) -> Maybe Username -> IO Username
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO Username
promptUsername String
domain) Username -> IO Username
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Username
mUsername
      Password String
password <- IO Password
-> (Password -> IO Password) -> Maybe Password -> IO Password
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO Password
promptPassword String
domain) Password -> IO Password
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Password
mPassword
      let auth        :: (String, String)
          auth :: (String, String)
auth        = (String
username, String
password)

      String
dotCabal <- IO String
getCabalDir
      let srcDir :: FilePath
          srcDir :: String
srcDir = String
dotCabal String -> String -> String
</> String
"reports" String -> String -> String
</> RepoName -> String
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
remoteRepo)
      -- We don't want to bomb out just because we haven't built any packages
      -- from this repo yet.
      Bool
srcExists <- String -> IO Bool
doesDirectoryExist String
srcDir
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
srcExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        [String]
contents <- String -> IO [String]
getDirectoryContents String
srcDir
        [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
c -> String -> String
takeExtension String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
".log") [String]
contents) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
logFile ->
          do String
inp <- String -> IO String
readFile (String
srcDir String -> String -> String
</> String
logFile)
             let (String
reportStr, String
buildLog) = String -> (String, String)
forall a. Read a => String -> a
Unsafe.read String
inp :: (String,String) -- TODO: eradicateNoParse
             case ByteString -> Either String BuildReport
parseBuildReport (String -> ByteString
toUTF8BS String
reportStr) of
               Left String
errs -> Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Errors: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errs -- FIXME
               Right BuildReport
report' ->
                 do Verbosity -> String -> IO ()
info Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Uploading report for "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow (BuildReport -> PackageIdentifier
BuildReport.package BuildReport
report')
                    Verbosity
-> RepoContext
-> (String, String)
-> URI
-> [(BuildReport, Maybe String)]
-> IO ()
BuildReport.uploadReports Verbosity
verbosity RepoContext
repoCtxt (String, String)
auth
                      (RemoteRepo -> URI
remoteRepoURI RemoteRepo
remoteRepo) [(BuildReport
report', String -> Maybe String
forall a. a -> Maybe a
Just String
buildLog)]
                    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handlePackage :: HttpTransport -> Verbosity -> URI -> URI -> Auth
              -> IsCandidate -> FilePath -> IO ()
handlePackage :: HttpTransport
-> Verbosity
-> URI
-> URI
-> Maybe (String, String)
-> IsCandidate
-> String
-> IO ()
handlePackage HttpTransport
transport Verbosity
verbosity URI
uri URI
packageUri Maybe (String, String)
auth IsCandidate
isCandidate String
path =
  do (HttpCode, String)
resp <- HttpTransport
-> Verbosity
-> URI
-> String
-> Maybe (String, String)
-> IO (HttpCode, String)
postHttpFile HttpTransport
transport Verbosity
verbosity URI
uri String
path Maybe (String, String)
auth
     case (HttpCode, String)
resp of
       (HttpCode
code,String
warnings) | HttpCode
code HttpCode -> [HttpCode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [HttpCode
200, HttpCode
204] ->
          Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ IsCandidate -> String
okMessage IsCandidate
isCandidate String -> String -> String
forall a. [a] -> [a] -> [a]
++
            if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
warnings then String
"" else String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
formatWarnings (String -> String
trim String
warnings)
       (HttpCode
code,String
err)  -> do
          Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error uploading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"http code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HttpCode -> String
forall a. Show a => a -> String
show HttpCode
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
          IO ()
forall a. IO a
exitFailure
 where
  okMessage :: IsCandidate -> String
  okMessage :: IsCandidate -> String
okMessage IsCandidate
IsCandidate =
    String
"Package successfully uploaded as candidate. "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"You can now preview the result at '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
packageUri
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'. To publish the candidate, use 'cabal upload --publish'."
  okMessage IsCandidate
IsPublished =
    String
"Package successfully published. You can now view it at '"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String
forall a. Show a => a -> String
show URI
packageUri String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."

formatWarnings :: String -> String
formatWarnings :: String -> String
formatWarnings String
x = String
"Warnings:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) String
x