{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Stack.Upload
(
upload
, uploadBytes
, uploadRevision
, HackageCreds
, loadCreds
, writeFilePrivate
) where
import Stack.Prelude
import Data.Aeson (FromJSON (..),
ToJSON (..),
decode', toEncoding, fromEncoding,
object, withObject,
(.:), (.=))
import Data.ByteString.Builder (lazyByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Conduit.Binary as CB
import qualified Data.Text as T
import Network.HTTP.StackClient (Request, RequestBody(RequestBodyLBS), Response, withResponse, httpNoBody, getGlobalManager, getResponseStatusCode,
getResponseBody,
setRequestHeader,
parseRequest,
formDataBody, partFileRequestBody,
partBS, partLBS,
applyDigestAuth,
displayDigestAuthException)
import Stack.Types.Config
import System.Directory (createDirectoryIfMissing,
removeFile, renameFile)
import System.Environment (lookupEnv)
import System.FilePath ((</>), takeFileName, takeDirectory)
import System.IO (putStrLn, putStr, print)
import System.PosixCompat.Files (setFileMode)
data HackageCreds = HackageCreds
{ HackageCreds -> Text
hcUsername :: !Text
, HackageCreds -> Text
hcPassword :: !Text
, HackageCreds -> FilePath
hcCredsFile :: !FilePath
}
deriving Int -> HackageCreds -> ShowS
[HackageCreds] -> ShowS
HackageCreds -> FilePath
(Int -> HackageCreds -> ShowS)
-> (HackageCreds -> FilePath)
-> ([HackageCreds] -> ShowS)
-> Show HackageCreds
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HackageCreds] -> ShowS
$cshowList :: [HackageCreds] -> ShowS
show :: HackageCreds -> FilePath
$cshow :: HackageCreds -> FilePath
showsPrec :: Int -> HackageCreds -> ShowS
$cshowsPrec :: Int -> HackageCreds -> ShowS
Show
instance ToJSON HackageCreds where
toJSON :: HackageCreds -> Value
toJSON (HackageCreds u :: Text
u p :: Text
p _) = [Pair] -> Value
object
[ "username" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
u
, "password" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
p
]
instance FromJSON (FilePath -> HackageCreds) where
parseJSON :: Value -> Parser (FilePath -> HackageCreds)
parseJSON = FilePath
-> (Object -> Parser (FilePath -> HackageCreds))
-> Value
-> Parser (FilePath -> HackageCreds)
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject "HackageCreds" ((Object -> Parser (FilePath -> HackageCreds))
-> Value -> Parser (FilePath -> HackageCreds))
-> (Object -> Parser (FilePath -> HackageCreds))
-> Value
-> Parser (FilePath -> HackageCreds)
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Text -> Text -> FilePath -> HackageCreds
HackageCreds
(Text -> Text -> FilePath -> HackageCreds)
-> Parser Text -> Parser (Text -> FilePath -> HackageCreds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "username"
Parser (Text -> FilePath -> HackageCreds)
-> Parser Text -> Parser (FilePath -> HackageCreds)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "password"
withEnvVariable :: Text -> IO Text -> IO Text
withEnvVariable :: Text -> IO Text -> IO Text
withEnvVariable varName :: Text
varName fromPrompt :: IO Text
fromPrompt = FilePath -> IO (Maybe FilePath)
lookupEnv (Text -> FilePath
T.unpack Text
varName) IO (Maybe FilePath) -> (Maybe FilePath -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Text -> (FilePath -> IO Text) -> Maybe FilePath -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Text
fromPrompt (Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (FilePath -> Text) -> FilePath -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack)
loadCreds :: Config -> IO HackageCreds
loadCreds :: Config -> IO HackageCreds
loadCreds config :: Config
config = do
FilePath
fp <- Config -> IO FilePath
credsFile Config
config
Either IOException ByteString
elbs <- IO ByteString -> IO (Either IOException ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
L.readFile FilePath
fp
case (IOException -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either IOException ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> IOException -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just Either IOException ByteString
elbs Maybe ByteString
-> (ByteString -> Maybe (ByteString, FilePath -> HackageCreds))
-> Maybe (ByteString, FilePath -> HackageCreds)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \lbs :: ByteString
lbs -> (ByteString
lbs, ) ((FilePath -> HackageCreds)
-> (ByteString, FilePath -> HackageCreds))
-> Maybe (FilePath -> HackageCreds)
-> Maybe (ByteString, FilePath -> HackageCreds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (FilePath -> HackageCreds)
forall a. FromJSON a => ByteString -> Maybe a
decode' ByteString
lbs of
Nothing -> FilePath -> IO HackageCreds
fromPrompt FilePath
fp
Just (lbs :: ByteString
lbs, mkCreds :: FilePath -> HackageCreds
mkCreds) -> do
FilePath -> Builder -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Builder -> m ()
writeFilePrivate FilePath
fp (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
lazyByteString ByteString
lbs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Config -> Bool
configSaveHackageCreds Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
putStrLn "WARNING: You've set save-hackage-creds to false"
FilePath -> IO ()
putStrLn "However, credentials were found at:"
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ " " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
fp
HackageCreds -> IO HackageCreds
forall (m :: * -> *) a. Monad m => a -> m a
return (HackageCreds -> IO HackageCreds)
-> HackageCreds -> IO HackageCreds
forall a b. (a -> b) -> a -> b
$ FilePath -> HackageCreds
mkCreds FilePath
fp
where
fromPrompt :: FilePath -> IO HackageCreds
fromPrompt fp :: FilePath
fp = do
Text
username <- Text -> IO Text -> IO Text
withEnvVariable "HACKAGE_USERNAME" (Text -> IO Text
forall (m :: * -> *). MonadIO m => Text -> m Text
prompt "Hackage username: ")
Text
password <- Text -> IO Text -> IO Text
withEnvVariable "HACKAGE_PASSWORD" (Text -> IO Text
forall (m :: * -> *). MonadIO m => Text -> m Text
promptPassword "Hackage password: ")
let hc :: HackageCreds
hc = $WHackageCreds :: Text -> Text -> FilePath -> HackageCreds
HackageCreds
{ hcUsername :: Text
hcUsername = Text
username
, hcPassword :: Text
hcPassword = Text
password
, hcCredsFile :: FilePath
hcCredsFile = FilePath
fp
}
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configSaveHackageCreds Config
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
shouldSave <- Text -> IO Bool
forall (m :: * -> *). MonadIO m => Text -> m Bool
promptBool (Text -> IO Bool) -> Text -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
"Save hackage credentials to file at " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
fp FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " [y/n]? "
FilePath -> IO ()
putStrLn "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldSave (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> Builder -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Builder -> m ()
writeFilePrivate FilePath
fp (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding (Encoding -> Builder) -> Encoding -> Builder
forall a b. (a -> b) -> a -> b
$ HackageCreds -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding HackageCreds
hc
FilePath -> IO ()
putStrLn "Saved!"
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
HackageCreds -> IO HackageCreds
forall (m :: * -> *) a. Monad m => a -> m a
return HackageCreds
hc
writeFilePrivate :: MonadIO m => FilePath -> Builder -> m ()
writeFilePrivate :: FilePath -> Builder -> m ()
writeFilePrivate fp :: FilePath
fp builder :: Builder
builder = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> (FilePath -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile (ShowS
takeDirectory FilePath
fp) (ShowS
takeFileName FilePath
fp) ((FilePath -> Handle -> IO ()) -> IO ())
-> (FilePath -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fpTmp :: FilePath
fpTmp h :: Handle
h -> do
Handle -> Builder -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Builder -> m ()
hPutBuilder Handle
h Builder
builder
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
h
IO (Either IOException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either IOException ()) -> IO ())
-> IO (Either IOException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> FileMode -> IO ()
setFileMode FilePath
fp 0o600
FilePath -> FilePath -> IO ()
renameFile FilePath
fpTmp FilePath
fp
credsFile :: Config -> IO FilePath
credsFile :: Config -> IO FilePath
credsFile config :: Config
config = do
let dir :: FilePath
dir = Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Getting (Path Abs Dir) Config (Path Abs Dir)
-> Config -> Path Abs Dir
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) Config (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL Config
config) FilePath -> ShowS
</> "upload"
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> "credentials.json"
applyCreds :: HackageCreds -> Request -> IO Request
applyCreds :: HackageCreds -> Request -> IO Request
applyCreds creds :: HackageCreds
creds req0 :: Request
req0 = do
Manager
manager <- IO Manager
getGlobalManager
Either SomeException Request
ereq <- ByteString
-> ByteString
-> Request
-> Manager
-> IO (Either SomeException Request)
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadThrow n) =>
ByteString -> ByteString -> Request -> Manager -> m (n Request)
applyDigestAuth
(Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ HackageCreds -> Text
hcUsername HackageCreds
creds)
(Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ HackageCreds -> Text
hcPassword HackageCreds
creds)
Request
req0
Manager
manager
case Either SomeException Request
ereq of
Left e :: SomeException
e -> do
FilePath -> IO ()
putStrLn "WARNING: No HTTP digest prompt found, this will probably fail"
case SomeException -> Maybe DigestAuthException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just e' :: DigestAuthException
e' -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DigestAuthException -> FilePath
displayDigestAuthException DigestAuthException
e'
Nothing -> SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
e
Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
req0
Right req :: Request
req -> Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
req
uploadBytes :: String
-> HackageCreds
-> String
-> L.ByteString
-> IO ()
uploadBytes :: FilePath -> HackageCreds -> FilePath -> ByteString -> IO ()
uploadBytes baseUrl :: FilePath
baseUrl creds :: HackageCreds
creds tarName :: FilePath
tarName bytes :: ByteString
bytes = do
let req1 :: Request
req1 = HeaderName -> [ByteString] -> Request -> Request
setRequestHeader "Accept" ["text/plain"]
(FilePath -> Request
forall a. IsString a => FilePath -> a
fromString (FilePath -> Request) -> FilePath -> Request
forall a b. (a -> b) -> a -> b
$ FilePath
baseUrl FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> "packages/")
formData :: [PartM IO]
formData = [Text -> FilePath -> RequestBody -> PartM IO
forall (m :: * -> *).
Applicative m =>
Text -> FilePath -> RequestBody -> PartM m
partFileRequestBody "package" FilePath
tarName (ByteString -> RequestBody
RequestBodyLBS ByteString
bytes)]
Request
req2 <- [PartM IO] -> Request -> IO Request
forall (m :: * -> *).
MonadIO m =>
[PartM IO] -> Request -> m Request
formDataBody [PartM IO]
formData Request
req1
Request
req3 <- HackageCreds -> Request -> IO Request
applyCreds HackageCreds
creds Request
req2
FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Uploading " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
tarName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "... "
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Request
-> (Response (ConduitM () ByteString IO ()) -> IO ()) -> IO ()
forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a
withResponse Request
req3 ((Response (ConduitM () ByteString IO ()) -> IO ()) -> IO ())
-> (Response (ConduitM () ByteString IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \res :: Response (ConduitM () ByteString IO ())
res ->
case Response (ConduitM () ByteString IO ()) -> Int
forall a. Response a -> Int
getResponseStatusCode Response (ConduitM () ByteString IO ())
res of
200 -> FilePath -> IO ()
putStrLn "done!"
401 -> do
FilePath -> IO ()
putStrLn "authentication failure"
(IOException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO (IO () -> IOException -> IO ()
forall a b. a -> b -> a
const (IO () -> IOException -> IO ()) -> IO () -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> IO ()
removeFile (HackageCreds -> FilePath
hcCredsFile HackageCreds
creds))
FilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
FilePath -> m a
throwString "Authentication failure uploading to server"
403 -> do
FilePath -> IO ()
putStrLn "forbidden upload"
FilePath -> IO ()
putStrLn "Usually means: you've already uploaded this package/version combination"
FilePath -> IO ()
putStrLn "Ignoring error and continuing, full message from Hackage below:\n"
Response (ConduitM () ByteString IO ()) -> IO ()
printBody Response (ConduitM () ByteString IO ())
res
503 -> do
FilePath -> IO ()
putStrLn "service unavailable"
FilePath -> IO ()
putStrLn "This error some times gets sent even though the upload succeeded"
FilePath -> IO ()
putStrLn "Check on Hackage to see if your pacakge is present"
Response (ConduitM () ByteString IO ()) -> IO ()
printBody Response (ConduitM () ByteString IO ())
res
code :: Int
code -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "unhandled status code: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
code
Response (ConduitM () ByteString IO ()) -> IO ()
printBody Response (ConduitM () ByteString IO ())
res
FilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
FilePath -> m a
throwString (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Upload failed on " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
tarName
printBody :: Response (ConduitM () S.ByteString IO ()) -> IO ()
printBody :: Response (ConduitM () ByteString IO ()) -> IO ()
printBody res :: Response (ConduitM () ByteString IO ())
res = ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () ByteString IO ())
-> ConduitM () ByteString IO ()
forall a. Response a -> a
getResponseBody Response (ConduitM () ByteString IO ())
res ConduitM () ByteString IO ()
-> ConduitM ByteString Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Handle -> ConduitM ByteString Void IO ()
forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
CB.sinkHandle Handle
stdout
upload :: String
-> HackageCreds
-> FilePath
-> IO ()
upload :: FilePath -> HackageCreds -> FilePath -> IO ()
upload baseUrl :: FilePath
baseUrl creds :: HackageCreds
creds fp :: FilePath
fp = FilePath -> HackageCreds -> FilePath -> ByteString -> IO ()
uploadBytes FilePath
baseUrl HackageCreds
creds (ShowS
takeFileName FilePath
fp) (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteString
L.readFile FilePath
fp
uploadRevision :: String
-> HackageCreds
-> PackageIdentifier
-> L.ByteString
-> IO ()
uploadRevision :: FilePath
-> HackageCreds -> PackageIdentifier -> ByteString -> IO ()
uploadRevision baseUrl :: FilePath
baseUrl creds :: HackageCreds
creds ident :: PackageIdentifier
ident@(PackageIdentifier name :: PackageName
name _) cabalFile :: ByteString
cabalFile = do
Request
req0 <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest (FilePath -> IO Request) -> FilePath -> IO Request
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ FilePath
baseUrl
, "package/"
, PackageIdentifier -> FilePath
packageIdentifierString PackageIdentifier
ident
, "/"
, PackageName -> FilePath
packageNameString PackageName
name
, ".cabal/edit"
]
Request
req1 <- [PartM IO] -> Request -> IO Request
forall (m :: * -> *).
MonadIO m =>
[PartM IO] -> Request -> m Request
formDataBody
[ Text -> ByteString -> PartM IO
forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS "cabalfile" ByteString
cabalFile
, Text -> ByteString -> PartM IO
forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partBS "publish" "on"
]
Request
req0
Request
req2 <- HackageCreds -> Request -> IO Request
applyCreds HackageCreds
creds Request
req1
IO (Response ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Response ()) -> IO ()) -> IO (Response ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Request -> IO (Response ())
forall (m :: * -> *). MonadIO m => Request -> m (Response ())
httpNoBody Request
req2