{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- | Separate module for HTTP actions, using a proxy server if one exists.
module Distribution.Client.HttpUtils
  ( DownloadResult (..)
  , configureTransport
  , HttpTransport (..)
  , HttpCode
  , downloadURI
  , transportCheckHttps
  , remoteRepoCheckHttps
  , remoteRepoTryUpgradeToHttps
  , isOldHackageURI
  ) where

import Distribution.Client.Compat.Prelude hiding (Proxy (..))
import Distribution.Utils.Generic
import Prelude ()

import qualified Control.Exception as Exception
import Distribution.Client.Types
  ( RemoteRepo (..)
  , unRepoName
  )
import Distribution.Client.Types.Credentials (Auth)
import Distribution.Client.Utils
  ( withTempFileName
  )
import Distribution.Client.Version
  ( cabalInstallVersion
  )
import Distribution.Simple.Program
  ( ConfiguredProgram
  , Program
  , ProgramInvocation (..)
  , getProgramInvocationOutput
  , programInvocation
  , programPath
  , simpleProgram
  )
import Distribution.Simple.Program.Db
  ( ProgramDb
  , addKnownPrograms
  , configureAllKnownPrograms
  , emptyProgramDb
  , lookupProgram
  , prependProgramSearchPath
  , requireProgram
  )
import Distribution.Simple.Program.Run
  ( getProgramInvocationOutputAndErrors
  )
import Distribution.Simple.Utils
  ( IOData (..)
  , copyFileVerbose
  , debug
  , dieWithException
  , info
  , notice
  , warn
  , withTempFile
  )
import Distribution.System
  ( buildArch
  , buildOS
  )
import Distribution.Utils.String (trim)
import Network.Browser
  ( browse
  , request
  , setAllowBasicAuth
  , setAuthorityGen
  , setErrHandler
  , setOutHandler
  , setProxy
  , setUserAgent
  )
import Network.HTTP
  ( Header (..)
  , HeaderName (..)
  , Request (..)
  , RequestMethod (..)
  , Response (..)
  , lookupHeader
  )
import Network.HTTP.Proxy (Proxy (..), fetchProxy)
import Network.URI
  ( URI (..)
  , URIAuth (..)
  , uriToString
  )
import Numeric (showHex)
import System.Directory
  ( canonicalizePath
  , doesFileExist
  , renameFile
  )
import System.FilePath
  ( takeDirectory
  , takeFileName
  , (<.>)
  )
import qualified System.FilePath.Posix as FilePath.Posix
  ( splitDirectories
  )
import System.IO
  ( IOMode (ReadMode)
  , hClose
  , hGetContents
  , withFile
  )
import System.IO.Error
  ( isDoesNotExistError
  )
import System.Random (randomRIO)

import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Char as Char
import Distribution.Client.Errors
import qualified Distribution.Compat.CharParsing as P

------------------------------------------------------------------------------
-- Downloading a URI, given an HttpTransport
--

data DownloadResult
  = FileAlreadyInCache
  | FileDownloaded FilePath
  deriving (DownloadResult -> DownloadResult -> Bool
(DownloadResult -> DownloadResult -> Bool)
-> (DownloadResult -> DownloadResult -> Bool) -> Eq DownloadResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadResult -> DownloadResult -> Bool
== :: DownloadResult -> DownloadResult -> Bool
$c/= :: DownloadResult -> DownloadResult -> Bool
/= :: DownloadResult -> DownloadResult -> Bool
Eq)

data DownloadCheck
  = -- | already downloaded and sha256 matches
    Downloaded
  | -- | already downloaded and we have etag
    CheckETag String
  | -- | needs download with optional hash check
    NeedsDownload (Maybe BS.ByteString)
  deriving (DownloadCheck -> DownloadCheck -> Bool
(DownloadCheck -> DownloadCheck -> Bool)
-> (DownloadCheck -> DownloadCheck -> Bool) -> Eq DownloadCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadCheck -> DownloadCheck -> Bool
== :: DownloadCheck -> DownloadCheck -> Bool
$c/= :: DownloadCheck -> DownloadCheck -> Bool
/= :: DownloadCheck -> DownloadCheck -> Bool
Eq)

downloadURI
  :: HttpTransport
  -> Verbosity
  -> URI
  -- ^ What to download
  -> FilePath
  -- ^ Where to put it
  -> IO DownloadResult
downloadURI :: HttpTransport -> Verbosity -> URI -> [Char] -> IO DownloadResult
downloadURI HttpTransport
_transport Verbosity
verbosity URI
uri [Char]
path | URI -> [Char]
uriScheme URI
uri [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"file:" = do
  Verbosity -> [Char] -> [Char] -> IO ()
copyFileVerbose Verbosity
verbosity (URI -> [Char]
uriPath URI
uri) [Char]
path
  DownloadResult -> IO DownloadResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DownloadResult
FileDownloaded [Char]
path)
-- Can we store the hash of the file so we can safely return path when the
-- hash matches to avoid unnecessary computation?

downloadURI HttpTransport
transport Verbosity
verbosity URI
uri [Char]
path = do
  Bool
targetExists <- [Char] -> IO Bool
doesFileExist [Char]
path

  DownloadCheck
downloadCheck <-
    -- if we have uriFrag, then we expect there to be #sha256=...
    if Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
uriFrag)
      then case Either [Char] ByteString
sha256parsed of
        -- we know the hash, and target exists
        Right ByteString
expected | Bool
targetExists -> do
          ByteString
contents <- [Char] -> IO ByteString
LBS.readFile [Char]
path
          let actual :: ByteString
actual = ByteString -> ByteString
SHA256.hashlazy ByteString
contents
          if ByteString
expected ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
actual
            then DownloadCheck -> IO DownloadCheck
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DownloadCheck
Downloaded
            else DownloadCheck -> IO DownloadCheck
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> DownloadCheck
NeedsDownload (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
expected))

        -- we known the hash, target doesn't exist
        Right ByteString
expected -> DownloadCheck -> IO DownloadCheck
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> DownloadCheck
NeedsDownload (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
expected))
        -- we failed to parse uriFragment
        Left [Char]
err ->
          Verbosity -> CabalInstallException -> IO DownloadCheck
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO DownloadCheck)
-> CabalInstallException -> IO DownloadCheck
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CabalInstallException
CannotParseURIFragment [Char]
uriFrag [Char]
err
      else -- if there are no uri fragment, use ETag
      do
        Bool
etagPathExists <- [Char] -> IO Bool
doesFileExist [Char]
etagPath
        -- In rare cases the target file doesn't exist, but the etag does.
        if Bool
targetExists Bool -> Bool -> Bool
&& Bool
etagPathExists
          then DownloadCheck -> IO DownloadCheck
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DownloadCheck
CheckETag [Char]
etagPath)
          else DownloadCheck -> IO DownloadCheck
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> DownloadCheck
NeedsDownload Maybe ByteString
forall a. Maybe a
Nothing)

  -- Only use the external http transports if we actually have to
  -- (or have been told to do so)
  let transport' :: HttpTransport
transport'
        | URI -> Bool
isHttpURI URI
uri
        , Bool -> Bool
not (HttpTransport -> Bool
transportManuallySelected HttpTransport
transport) =
            HttpTransport
plainHttpTransport
        | Bool
otherwise =
            HttpTransport
transport

  case DownloadCheck
downloadCheck of
    DownloadCheck
Downloaded -> DownloadResult -> IO DownloadResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DownloadResult
FileAlreadyInCache
    CheckETag [Char]
etag -> HttpTransport
-> Maybe ByteString -> Maybe [Char] -> IO DownloadResult
makeDownload HttpTransport
transport' Maybe ByteString
forall a. Maybe a
Nothing ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
etag)
    NeedsDownload Maybe ByteString
hash -> HttpTransport
-> Maybe ByteString -> Maybe [Char] -> IO DownloadResult
makeDownload HttpTransport
transport' Maybe ByteString
hash Maybe [Char]
forall a. Maybe a
Nothing
  where
    makeDownload :: HttpTransport -> Maybe BS8.ByteString -> Maybe String -> IO DownloadResult
    makeDownload :: HttpTransport
-> Maybe ByteString -> Maybe [Char] -> IO DownloadResult
makeDownload HttpTransport
transport' Maybe ByteString
sha256 Maybe [Char]
etag = [Char]
-> [Char] -> ([Char] -> IO DownloadResult) -> IO DownloadResult
forall a. [Char] -> [Char] -> ([Char] -> IO a) -> IO a
withTempFileName ([Char] -> [Char]
takeDirectory [Char]
path) ([Char] -> [Char]
takeFileName [Char]
path) (([Char] -> IO DownloadResult) -> IO DownloadResult)
-> ([Char] -> IO DownloadResult) -> IO DownloadResult
forall a b. (a -> b) -> a -> b
$ \[Char]
tmpFile -> do
      (HttpCode, Maybe [Char])
result <- HttpTransport
-> Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
getHttp HttpTransport
transport' Verbosity
verbosity URI
uri Maybe [Char]
etag [Char]
tmpFile []

      -- Only write the etag if we get a 200 response code.
      -- A 304 still sends us an etag header.
      case (HttpCode, Maybe [Char])
result of
        -- if we have hash, we don't care about etag.
        (HttpCode
200, Maybe [Char]
_) | Just ByteString
expected <- Maybe ByteString
sha256 -> do
          ByteString
contents <- [Char] -> IO ByteString
LBS.readFile [Char]
tmpFile
          let actual :: ByteString
actual = ByteString -> ByteString
SHA256.hashlazy ByteString
contents
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
actual ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
              URI -> ByteString -> ByteString -> CabalInstallException
MakeDownload URI
uri ByteString
expected ByteString
actual
        (HttpCode
200, Just [Char]
newEtag) -> [Char] -> [Char] -> IO ()
writeFile [Char]
etagPath [Char]
newEtag
        (HttpCode, Maybe [Char])
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      case (HttpCode, Maybe [Char]) -> HttpCode
forall a b. (a, b) -> a
fst (HttpCode, Maybe [Char])
result of
        HttpCode
200 -> do
          Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char]
"Downloaded to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path)
          [Char] -> [Char] -> IO ()
renameFile [Char]
tmpFile [Char]
path
          DownloadResult -> IO DownloadResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DownloadResult
FileDownloaded [Char]
path)
        HttpCode
304 -> do
          Verbosity -> [Char] -> IO ()
notice Verbosity
verbosity [Char]
"Skipping download: local and remote files match."
          DownloadResult -> IO DownloadResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DownloadResult
FileAlreadyInCache
        HttpCode
errCode ->
          Verbosity -> CabalInstallException -> IO DownloadResult
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO DownloadResult)
-> CabalInstallException -> IO DownloadResult
forall a b. (a -> b) -> a -> b
$ URI -> [Char] -> CabalInstallException
FailedToDownloadURI URI
uri (HttpCode -> [Char]
forall a. Show a => a -> [Char]
show HttpCode
errCode)

    etagPath :: [Char]
etagPath = [Char]
path [Char] -> [Char] -> [Char]
<.> [Char]
"etag"
    uriFrag :: [Char]
uriFrag = URI -> [Char]
uriFragment URI
uri

    sha256parsed :: Either String BS.ByteString
    sha256parsed :: Either [Char] ByteString
sha256parsed = ParsecParser ByteString -> [Char] -> Either [Char] ByteString
forall a. ParsecParser a -> [Char] -> Either [Char] a
explicitEitherParsec ParsecParser ByteString
fragmentParser [Char]
uriFrag

    fragmentParser :: ParsecParser ByteString
fragmentParser = do
      [Char]
_ <- [Char] -> ParsecParser [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
P.string [Char]
"#sha256="
      [Char]
str <- ParsecParser Char -> ParsecParser [Char]
forall a. ParsecParser a -> ParsecParser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecParser Char
forall (m :: * -> *). CharParsing m => m Char
P.hexDigit
      let bs :: Either [Char] ByteString
bs = ByteString -> Either [Char] ByteString
Base16.decode ([Char] -> ByteString
BS8.pack [Char]
str)
#if MIN_VERSION_base16_bytestring(1,0,0)
      ([Char] -> ParsecParser ByteString)
-> (ByteString -> ParsecParser ByteString)
-> Either [Char] ByteString
-> ParsecParser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> ParsecParser ByteString
forall a. [Char] -> ParsecParser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ByteString -> ParsecParser ByteString
forall a. a -> ParsecParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] ByteString
bs
#else
      return (fst bs)
#endif

------------------------------------------------------------------------------
-- Utilities for repo url management
--

-- | If the remote repo is accessed over HTTPS, ensure that the transport
-- supports HTTPS.
remoteRepoCheckHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO ()
remoteRepoCheckHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO ()
remoteRepoCheckHttps Verbosity
verbosity HttpTransport
transport RemoteRepo
repo =
  Verbosity -> HttpTransport -> URI -> CabalInstallException -> IO ()
transportCheckHttpsWithError Verbosity
verbosity HttpTransport
transport (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo) (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> [Char] -> CabalInstallException
RemoteRepoCheckHttps (RepoName -> [Char]
unRepoName (RemoteRepo -> RepoName
remoteRepoName RemoteRepo
repo)) [Char]
requiresHttpsErrorMessage

-- | If the URI scheme is HTTPS, ensure the transport supports HTTPS.
transportCheckHttps :: Verbosity -> HttpTransport -> URI -> IO ()
transportCheckHttps :: Verbosity -> HttpTransport -> URI -> IO ()
transportCheckHttps Verbosity
verbosity HttpTransport
transport URI
uri =
  Verbosity -> HttpTransport -> URI -> CabalInstallException -> IO ()
transportCheckHttpsWithError Verbosity
verbosity HttpTransport
transport URI
uri (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
    URI -> [Char] -> CabalInstallException
TransportCheckHttps URI
uri [Char]
requiresHttpsErrorMessage

-- | If the URI scheme is HTTPS, ensure the transport supports HTTPS.
-- If not, fail with the given error.
transportCheckHttpsWithError
  :: Verbosity -> HttpTransport -> URI -> CabalInstallException -> IO ()
transportCheckHttpsWithError :: Verbosity -> HttpTransport -> URI -> CabalInstallException -> IO ()
transportCheckHttpsWithError Verbosity
verbosity HttpTransport
transport URI
uri CabalInstallException
err
  | URI -> Bool
isHttpsURI URI
uri
  , Bool -> Bool
not (HttpTransport -> Bool
transportSupportsHttps HttpTransport
transport) =
      Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
err
  | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isHttpsURI :: URI -> Bool
isHttpsURI :: URI -> Bool
isHttpsURI URI
uri = URI -> [Char]
uriScheme URI
uri [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"https:"

isHttpURI :: URI -> Bool
isHttpURI :: URI -> Bool
isHttpURI URI
uri = URI -> [Char]
uriScheme URI
uri [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"http:"

requiresHttpsErrorMessage :: String
requiresHttpsErrorMessage :: [Char]
requiresHttpsErrorMessage =
  [Char]
"requires HTTPS however the built-in HTTP implementation "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"does not support HTTPS. The transport implementations with HTTPS "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"support are "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
      [Char]
", "
      [[Char]
name | ([Char]
name, Maybe Program
_, Bool
True, ProgramDb -> Maybe HttpTransport
_) <- [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports]
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". One of these will be selected automatically if the corresponding "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"external program is available, or one can be selected specifically "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"with the global flag --http-transport="

remoteRepoTryUpgradeToHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO RemoteRepo
remoteRepoTryUpgradeToHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO RemoteRepo
remoteRepoTryUpgradeToHttps Verbosity
verbosity HttpTransport
transport RemoteRepo
repo
  | RemoteRepo -> Bool
remoteRepoShouldTryHttps RemoteRepo
repo
  , URI -> Bool
isHttpURI (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo)
  , Bool -> Bool
not (HttpTransport -> Bool
transportSupportsHttps HttpTransport
transport)
  , Bool -> Bool
not (HttpTransport -> Bool
transportManuallySelected HttpTransport
transport) =
      Verbosity -> CabalInstallException -> IO RemoteRepo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO RemoteRepo)
-> CabalInstallException -> IO RemoteRepo
forall a b. (a -> b) -> a -> b
$ [[Char]] -> CabalInstallException
TryUpgradeToHttps [[Char]
name | ([Char]
name, Maybe Program
_, Bool
True, ProgramDb -> Maybe HttpTransport
_) <- [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports]
  | RemoteRepo -> Bool
remoteRepoShouldTryHttps RemoteRepo
repo
  , URI -> Bool
isHttpURI (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repo)
  , HttpTransport -> Bool
transportSupportsHttps HttpTransport
transport =
      RemoteRepo -> IO RemoteRepo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        RemoteRepo
repo
          { remoteRepoURI = (remoteRepoURI repo){uriScheme = "https:"}
          }
  | Bool
otherwise =
      RemoteRepo -> IO RemoteRepo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteRepo
repo

-- | Utility function for legacy support.
isOldHackageURI :: URI -> Bool
isOldHackageURI :: URI -> Bool
isOldHackageURI URI
uri =
  case URI -> Maybe URIAuth
uriAuthority URI
uri of
    Just (URIAuth{uriRegName :: URIAuth -> [Char]
uriRegName = [Char]
"hackage.haskell.org"}) ->
      [Char] -> [[Char]]
FilePath.Posix.splitDirectories (URI -> [Char]
uriPath URI
uri)
        [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]
"/", [Char]
"packages", [Char]
"archive"]
    Maybe URIAuth
_ -> Bool
False

------------------------------------------------------------------------------
-- Setting up a HttpTransport
--

data HttpTransport = HttpTransport
  { HttpTransport
-> Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
getHttp
      :: Verbosity
      -> URI
      -> Maybe ETag
      -> FilePath
      -> [Header]
      -> IO (HttpCode, Maybe ETag)
  -- ^ GET a URI, with an optional ETag (to do a conditional fetch),
  -- write the resource to the given file and return the HTTP status code,
  -- and optional ETag.
  , HttpTransport
-> Verbosity
-> URI
-> [Char]
-> Maybe Auth
-> IO (HttpCode, [Char])
postHttp
      :: Verbosity
      -> URI
      -> String
      -> Maybe Auth
      -> IO (HttpCode, String)
  -- ^ POST a resource to a URI, with optional 'Auth'
  -- and return the HTTP status code and any redirect URL.
  , HttpTransport
-> Verbosity
-> URI
-> [Char]
-> Maybe Auth
-> IO (HttpCode, [Char])
postHttpFile
      :: Verbosity
      -> URI
      -> FilePath
      -> Maybe Auth
      -> IO (HttpCode, String)
  -- ^ POST a file resource to a URI using multipart\/form-data encoding,
  -- with optional 'Auth' and return the HTTP status
  -- code and any error string.
  , HttpTransport
-> Verbosity
-> URI
-> [Char]
-> Maybe Auth
-> [Header]
-> IO (HttpCode, [Char])
putHttpFile
      :: Verbosity
      -> URI
      -> FilePath
      -> Maybe Auth
      -> [Header]
      -> IO (HttpCode, String)
  -- ^ PUT a file resource to a URI, with optional 'Auth',
  -- extra headers and return the HTTP status code
  -- and any error string.
  , HttpTransport -> Bool
transportSupportsHttps :: Bool
  -- ^ Whether this transport supports https or just http.
  , HttpTransport -> Bool
transportManuallySelected :: Bool
  -- ^ Whether this transport implementation was specifically chosen by
  -- the user via configuration, or whether it was automatically selected.
  -- Strictly speaking this is not a property of the transport itself but
  -- about how it was chosen. Nevertheless it's convenient to keep here.
  }

-- TODO: why does postHttp return a redirect, but postHttpFile return errors?

type HttpCode = Int
type ETag = String

noPostYet
  :: Verbosity
  -> URI
  -> String
  -> Maybe Auth
  -> IO (Int, String)
noPostYet :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
noPostYet Verbosity
verbosity URI
_ [Char]
_ Maybe Auth
_ = Verbosity -> CabalInstallException -> IO (HttpCode, [Char])
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
NoPostYet

supportedTransports
  :: [ ( String
       , Maybe Program
       , Bool
       , ProgramDb -> Maybe HttpTransport
       )
     ]
supportedTransports :: [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports =
  [ let prog :: Program
prog = [Char] -> Program
simpleProgram [Char]
"curl"
     in ( [Char]
"curl"
        , Program -> Maybe Program
forall a. a -> Maybe a
Just Program
prog
        , Bool
True
        , \ProgramDb
db -> ConfiguredProgram -> HttpTransport
curlTransport (ConfiguredProgram -> HttpTransport)
-> Maybe ConfiguredProgram -> Maybe HttpTransport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
db
        )
  , let prog :: Program
prog = [Char] -> Program
simpleProgram [Char]
"wget"
     in ( [Char]
"wget"
        , Program -> Maybe Program
forall a. a -> Maybe a
Just Program
prog
        , Bool
True
        , \ProgramDb
db -> ConfiguredProgram -> HttpTransport
wgetTransport (ConfiguredProgram -> HttpTransport)
-> Maybe ConfiguredProgram -> Maybe HttpTransport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
db
        )
  , let prog :: Program
prog = [Char] -> Program
simpleProgram [Char]
"powershell"
     in ( [Char]
"powershell"
        , Program -> Maybe Program
forall a. a -> Maybe a
Just Program
prog
        , Bool
True
        , \ProgramDb
db -> ConfiguredProgram -> HttpTransport
powershellTransport (ConfiguredProgram -> HttpTransport)
-> Maybe ConfiguredProgram -> Maybe HttpTransport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
prog ProgramDb
db
        )
  ,
    ( [Char]
"plain-http"
    , Maybe Program
forall a. Maybe a
Nothing
    , Bool
False
    , \ProgramDb
_ -> HttpTransport -> Maybe HttpTransport
forall a. a -> Maybe a
Just HttpTransport
plainHttpTransport
    )
  ]

configureTransport :: Verbosity -> [FilePath] -> Maybe String -> IO HttpTransport
configureTransport :: Verbosity -> [[Char]] -> Maybe [Char] -> IO HttpTransport
configureTransport Verbosity
verbosity [[Char]]
extraPath (Just [Char]
name) =
  -- the user specifically selected a transport by name so we'll try and
  -- configure that one

  case (([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)
 -> Bool)
-> [([Char], Maybe Program, Bool,
     ProgramDb -> Maybe HttpTransport)]
-> Maybe
     ([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([Char]
name', Maybe Program
_, Bool
_, ProgramDb -> Maybe HttpTransport
_) -> [Char]
name' [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
name) [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports of
    Just ([Char]
_, Maybe Program
mprog, Bool
_tls, ProgramDb -> Maybe HttpTransport
mkTrans) -> do
      ProgramDb
baseProgDb <- Verbosity
-> [[Char]]
-> [([Char], Maybe [Char])]
-> ProgramDb
-> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity [[Char]]
extraPath [] ProgramDb
emptyProgramDb
      ProgramDb
progdb <- case Maybe Program
mprog of
        Maybe Program
Nothing -> ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
emptyProgramDb
        Just Program
prog -> (ConfiguredProgram, ProgramDb) -> ProgramDb
forall a b. (a, b) -> b
snd ((ConfiguredProgram, ProgramDb) -> ProgramDb)
-> IO (ConfiguredProgram, ProgramDb) -> IO ProgramDb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
baseProgDb
      --      ^^ if it fails, it'll fail here

      let transport :: HttpTransport
transport = HttpTransport -> Maybe HttpTransport -> HttpTransport
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> HttpTransport
forall a. HasCallStack => [Char] -> a
error [Char]
"configureTransport: failed to make transport") (Maybe HttpTransport -> HttpTransport)
-> Maybe HttpTransport -> HttpTransport
forall a b. (a -> b) -> a -> b
$ ProgramDb -> Maybe HttpTransport
mkTrans ProgramDb
progdb
      HttpTransport -> IO HttpTransport
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HttpTransport
transport{transportManuallySelected = True}
    Maybe
  ([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)
Nothing ->
      Verbosity -> CabalInstallException -> IO HttpTransport
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO HttpTransport)
-> CabalInstallException -> IO HttpTransport
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> CabalInstallException
UnknownHttpTransportSpecified [Char]
name [[Char]
name' | ([Char]
name', Maybe Program
_, Bool
_, ProgramDb -> Maybe HttpTransport
_) <- [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports]
configureTransport Verbosity
verbosity [[Char]]
extraPath Maybe [Char]
Nothing = do
  -- the user hasn't selected a transport, so we'll pick the first one we
  -- can configure successfully, provided that it supports tls

  -- for all the transports except plain-http we need to try and find
  -- their external executable
  ProgramDb
baseProgDb <- Verbosity
-> [[Char]]
-> [([Char], Maybe [Char])]
-> ProgramDb
-> IO ProgramDb
prependProgramSearchPath Verbosity
verbosity [[Char]]
extraPath [] ProgramDb
emptyProgramDb
  ProgramDb
progdb <-
    Verbosity -> ProgramDb -> IO ProgramDb
configureAllKnownPrograms Verbosity
verbosity (ProgramDb -> IO ProgramDb) -> ProgramDb -> IO ProgramDb
forall a b. (a -> b) -> a -> b
$
      [Program] -> ProgramDb -> ProgramDb
addKnownPrograms
        [Program
prog | ([Char]
_, Just Program
prog, Bool
_, ProgramDb -> Maybe HttpTransport
_) <- [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports]
        ProgramDb
baseProgDb

  let availableTransports :: [([Char], HttpTransport)]
availableTransports =
        [ ([Char]
name, HttpTransport
transport)
        | ([Char]
name, Maybe Program
_, Bool
_, ProgramDb -> Maybe HttpTransport
mkTrans) <- [([Char], Maybe Program, Bool, ProgramDb -> Maybe HttpTransport)]
supportedTransports
        , HttpTransport
transport <- Maybe HttpTransport -> [HttpTransport]
forall a. Maybe a -> [a]
maybeToList (ProgramDb -> Maybe HttpTransport
mkTrans ProgramDb
progdb)
        ]
  let ([Char]
name, HttpTransport
transport) =
        ([Char], HttpTransport)
-> Maybe ([Char], HttpTransport) -> ([Char], HttpTransport)
forall a. a -> Maybe a -> a
fromMaybe ([Char]
"plain-http", HttpTransport
plainHttpTransport) ([([Char], HttpTransport)] -> Maybe ([Char], HttpTransport)
forall a. [a] -> Maybe a
safeHead [([Char], HttpTransport)]
availableTransports)
  Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Selected http transport implementation: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name

  HttpTransport -> IO HttpTransport
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HttpTransport
transport{transportManuallySelected = False}

------------------------------------------------------------------------------
-- The HttpTransports based on external programs
--

curlTransport :: ConfiguredProgram -> HttpTransport
curlTransport :: ConfiguredProgram -> HttpTransport
curlTransport ConfiguredProgram
prog =
  (Verbosity
 -> URI
 -> Maybe [Char]
 -> [Char]
 -> [Header]
 -> IO (HttpCode, Maybe [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI
    -> [Char]
    -> Maybe Auth
    -> [Header]
    -> IO (HttpCode, [Char]))
-> Bool
-> Bool
-> HttpTransport
HttpTransport Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
gethttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttpfile Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (HttpCode, [Char])
puthttpfile Bool
True Bool
False
  where
    gethttp :: Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
gethttp Verbosity
verbosity URI
uri Maybe [Char]
etag [Char]
destPath [Header]
reqHeaders = do
      [Char]
-> [Char]
-> ([Char] -> Handle -> IO (HttpCode, Maybe [Char]))
-> IO (HttpCode, Maybe [Char])
forall a. [Char] -> [Char] -> ([Char] -> Handle -> IO a) -> IO a
withTempFile
        ([Char] -> [Char]
takeDirectory [Char]
destPath)
        [Char]
"curl-headers.txt"
        (([Char] -> Handle -> IO (HttpCode, Maybe [Char]))
 -> IO (HttpCode, Maybe [Char]))
-> ([Char] -> Handle -> IO (HttpCode, Maybe [Char]))
-> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
tmpFile Handle
tmpHandle -> do
          Handle -> IO ()
hClose Handle
tmpHandle
          let args :: [[Char]]
args =
                [ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri
                , [Char]
"--output"
                , [Char]
destPath
                , [Char]
"--location"
                , [Char]
"--write-out"
                , [Char]
"%{http_code}"
                , [Char]
"--user-agent"
                , [Char]
userAgent
                , [Char]
"--silent"
                , [Char]
"--show-error"
                , [Char]
"--dump-header"
                , [Char]
tmpFile
                ]
                  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [[Char]
"--header", [Char]
"If-None-Match: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t]
                    | [Char]
t <- Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList Maybe [Char]
etag
                    ]
                  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [[Char]
"--header", HeaderName -> [Char]
forall a. Show a => a -> [Char]
show HeaderName
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value]
                    | Header HeaderName
name [Char]
value <- [Header]
reqHeaders
                    ]

          [Char]
resp <-
            Verbosity -> ProgramInvocation -> IO [Char]
getProgramInvocationOutput Verbosity
verbosity (ProgramInvocation -> IO [Char]) -> ProgramInvocation -> IO [Char]
forall a b. (a -> b) -> a -> b
$
              Maybe Auth -> URI -> ProgramInvocation -> ProgramInvocation
addAuthConfig
                Maybe Auth
forall a. Maybe a
Nothing
                URI
uri
                (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [[Char]]
args)

          [Char]
-> IOMode
-> (Handle -> IO (HttpCode, Maybe [Char]))
-> IO (HttpCode, Maybe [Char])
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
tmpFile IOMode
ReadMode ((Handle -> IO (HttpCode, Maybe [Char]))
 -> IO (HttpCode, Maybe [Char]))
-> (Handle -> IO (HttpCode, Maybe [Char]))
-> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
            [Char]
headers <- Handle -> IO [Char]
hGetContents Handle
hnd
            (HttpCode
code, [Char]
_err, Maybe [Char]
etag') <- Verbosity
-> URI -> [Char] -> [Char] -> IO (HttpCode, [Char], Maybe [Char])
parseResponse Verbosity
verbosity URI
uri [Char]
resp [Char]
headers
            (HttpCode, Maybe [Char]) -> IO (HttpCode, Maybe [Char])
forall a. a -> IO a
evaluate ((HttpCode, Maybe [Char]) -> IO (HttpCode, Maybe [Char]))
-> (HttpCode, Maybe [Char]) -> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> a -> b
$ (HttpCode, Maybe [Char]) -> (HttpCode, Maybe [Char])
forall a. NFData a => a -> a
force (HttpCode
code, Maybe [Char]
etag')

    posthttp :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp = Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
noPostYet

    addAuthConfig :: Maybe Auth -> URI -> ProgramInvocation -> ProgramInvocation
addAuthConfig Maybe Auth
explicitAuth URI
uri ProgramInvocation
progInvocation = do
      -- attempt to derive a u/p pair from the uri authority if one exists
      -- all `uriUserInfo` values have '@' as a suffix. drop it.
      let uriDerivedAuth :: Maybe [Char]
uriDerivedAuth = case URI -> Maybe URIAuth
uriAuthority URI
uri of
            (Just (URIAuth [Char]
u [Char]
_ [Char]
_)) | Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
u) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@') [Char]
u
            Maybe URIAuth
_ -> Maybe [Char]
forall a. Maybe a
Nothing
      -- prefer passed in auth to auth derived from uri. If neither exist, then no auth
      let mbAuthStringToken :: Maybe (Either [Char] [Char])
mbAuthStringToken = case (Maybe Auth
explicitAuth, Maybe [Char]
uriDerivedAuth) of
            (Just (Right [Char]
token), Maybe [Char]
_) -> Either [Char] [Char] -> Maybe (Either [Char] [Char])
forall a. a -> Maybe a
Just (Either [Char] [Char] -> Maybe (Either [Char] [Char]))
-> Either [Char] [Char] -> Maybe (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
token
            (Just (Left ([Char]
uname, [Char]
passwd)), Maybe [Char]
_) -> Either [Char] [Char] -> Maybe (Either [Char] [Char])
forall a. a -> Maybe a
Just (Either [Char] [Char] -> Maybe (Either [Char] [Char]))
-> Either [Char] [Char] -> Maybe (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char]
uname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
passwd)
            (Maybe Auth
Nothing, Just [Char]
a) -> Either [Char] [Char] -> Maybe (Either [Char] [Char])
forall a. a -> Maybe a
Just (Either [Char] [Char] -> Maybe (Either [Char] [Char]))
-> Either [Char] [Char] -> Maybe (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left [Char]
a
            (Maybe Auth
Nothing, Maybe [Char]
Nothing) -> Maybe (Either [Char] [Char])
forall a. Maybe a
Nothing
      let authnSchemeArg :: [Char]
authnSchemeArg
            -- When using TLS, we can accept Basic authentication.  Let curl
            -- decide based on the scheme(s) offered by the server.
            | URI -> Bool
isHttpsURI URI
uri = [Char]
"--anyauth"
            -- When not using TLS, force Digest scheme
            | Bool
otherwise = [Char]
"--digest"
      case Maybe (Either [Char] [Char])
mbAuthStringToken of
        Just (Left [Char]
up) ->
          ProgramInvocation
progInvocation
            { progInvokeInput =
                Just . IODataText . unlines $
                  [ authnSchemeArg
                  , "--user " ++ up
                  ]
            , progInvokeArgs = ["--config", "-"] ++ progInvokeArgs progInvocation
            }
        Just (Right [Char]
token) ->
          ProgramInvocation
progInvocation
            { progInvokeArgs =
                ["--header", "Authorization: X-ApiKey " ++ token]
                  ++ progInvokeArgs progInvocation
            }
        Maybe (Either [Char] [Char])
Nothing -> ProgramInvocation
progInvocation

    posthttpfile :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth = do
      let args :: [[Char]]
args =
            [ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri
            , [Char]
"--form"
            , [Char]
"package=@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path
            , [Char]
"--write-out"
            , [Char]
"\n%{http_code}"
            , [Char]
"--user-agent"
            , [Char]
userAgent
            , [Char]
"--silent"
            , [Char]
"--show-error"
            , [Char]
"--header"
            , [Char]
"Accept: text/plain"
            , [Char]
"--location"
            ]
      [Char]
resp <-
        Verbosity -> ProgramInvocation -> IO [Char]
getProgramInvocationOutput Verbosity
verbosity (ProgramInvocation -> IO [Char]) -> ProgramInvocation -> IO [Char]
forall a b. (a -> b) -> a -> b
$
          Maybe Auth -> URI -> ProgramInvocation -> ProgramInvocation
addAuthConfig
            Maybe Auth
auth
            URI
uri
            (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [[Char]]
args)
      (HttpCode
code, [Char]
err, Maybe [Char]
_etag) <- Verbosity
-> URI -> [Char] -> [Char] -> IO (HttpCode, [Char], Maybe [Char])
parseResponse Verbosity
verbosity URI
uri [Char]
resp [Char]
""
      (HttpCode, [Char]) -> IO (HttpCode, [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpCode
code, [Char]
err)

    puthttpfile :: Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (HttpCode, [Char])
puthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth [Header]
headers = do
      let args :: [[Char]]
args =
            [ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri
            , [Char]
"--request"
            , [Char]
"PUT"
            , [Char]
"--data-binary"
            , [Char]
"@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path
            , [Char]
"--write-out"
            , [Char]
"\n%{http_code}"
            , [Char]
"--user-agent"
            , [Char]
userAgent
            , [Char]
"--silent"
            , [Char]
"--show-error"
            , [Char]
"--location"
            , [Char]
"--header"
            , [Char]
"Accept: text/plain"
            ]
              [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [[Char]
"--header", HeaderName -> [Char]
forall a. Show a => a -> [Char]
show HeaderName
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value]
                | Header HeaderName
name [Char]
value <- [Header]
headers
                ]
      [Char]
resp <-
        Verbosity -> ProgramInvocation -> IO [Char]
getProgramInvocationOutput Verbosity
verbosity (ProgramInvocation -> IO [Char]) -> ProgramInvocation -> IO [Char]
forall a b. (a -> b) -> a -> b
$
          Maybe Auth -> URI -> ProgramInvocation -> ProgramInvocation
addAuthConfig
            Maybe Auth
auth
            URI
uri
            (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [[Char]]
args)
      (HttpCode
code, [Char]
err, Maybe [Char]
_etag) <- Verbosity
-> URI -> [Char] -> [Char] -> IO (HttpCode, [Char], Maybe [Char])
parseResponse Verbosity
verbosity URI
uri [Char]
resp [Char]
""
      (HttpCode, [Char]) -> IO (HttpCode, [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpCode
code, [Char]
err)

    -- on success these curl invocations produces an output like "200"
    -- and on failure it has the server error response first
    parseResponse :: Verbosity -> URI -> String -> String -> IO (Int, String, Maybe ETag)
    parseResponse :: Verbosity
-> URI -> [Char] -> [Char] -> IO (HttpCode, [Char], Maybe [Char])
parseResponse Verbosity
verbosity URI
uri [Char]
resp [Char]
headers =
      let codeerr :: Maybe (HttpCode, [Char])
codeerr =
            case [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([Char] -> [[Char]]
lines [Char]
resp) of
              ([Char]
codeLine : [[Char]]
rerrLines) ->
                case [Char] -> Maybe HttpCode
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> [Char]
trim [Char]
codeLine) of
                  Just HttpCode
i ->
                    let errstr :: [Char]
errstr = [[Char]] -> [Char]
mkErrstr [[Char]]
rerrLines
                     in (HttpCode, [Char]) -> Maybe (HttpCode, [Char])
forall a. a -> Maybe a
Just (HttpCode
i, [Char]
errstr)
                  Maybe HttpCode
Nothing -> Maybe (HttpCode, [Char])
forall a. Maybe a
Nothing
              [] -> Maybe (HttpCode, [Char])
forall a. Maybe a
Nothing

          mkErrstr :: [[Char]] -> [Char]
mkErrstr = [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace)

          mb_etag :: Maybe ETag
          mb_etag :: Maybe [Char]
mb_etag =
            [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ([[Char]] -> Maybe [Char]) -> [[Char]] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$
              [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse
                [ [Char]
etag
                | [[Char]
name, [Char]
etag] <- ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
words ([Char] -> [[Char]]
lines [Char]
headers)
                , [Char] -> Bool
isETag [Char]
name
                ]
       in case Maybe (HttpCode, [Char])
codeerr of
            Just (HttpCode
i, [Char]
err) -> (HttpCode, [Char], Maybe [Char])
-> IO (HttpCode, [Char], Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpCode
i, [Char]
err, Maybe [Char]
mb_etag)
            Maybe (HttpCode, [Char])
_ -> Verbosity -> URI -> [Char] -> IO (HttpCode, [Char], Maybe [Char])
forall a. Verbosity -> URI -> [Char] -> IO a
statusParseFail Verbosity
verbosity URI
uri [Char]
resp

wgetTransport :: ConfiguredProgram -> HttpTransport
wgetTransport :: ConfiguredProgram -> HttpTransport
wgetTransport ConfiguredProgram
prog =
  (Verbosity
 -> URI
 -> Maybe [Char]
 -> [Char]
 -> [Header]
 -> IO (HttpCode, Maybe [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI
    -> [Char]
    -> Maybe Auth
    -> [Header]
    -> IO (HttpCode, [Char]))
-> Bool
-> Bool
-> HttpTransport
HttpTransport Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
forall {a}.
Read a =>
Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (a, Maybe [Char])
gethttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
forall {a}.
(Read a, NFData a) =>
Verbosity -> URI -> [Char] -> Maybe Auth -> IO (a, [Char])
posthttpfile Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (HttpCode, [Char])
forall {a}.
(Read a, NFData a) =>
Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (a, [Char])
puthttpfile Bool
True Bool
False
  where
    gethttp :: Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (a, Maybe [Char])
gethttp Verbosity
verbosity URI
uri Maybe [Char]
etag [Char]
destPath [Header]
reqHeaders = do
      [Char]
resp <- Verbosity -> URI -> [[Char]] -> IO [Char]
runWGet Verbosity
verbosity URI
uri [[Char]]
args

      -- wget doesn't support range requests.
      -- so, we not only ignore range request headers,
      -- but we also display a warning message when we see them.
      let hasRangeHeader :: Bool
hasRangeHeader = (Header -> Bool) -> [Header] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Header -> Bool
isRangeHeader [Header]
reqHeaders
          warningMsg :: [Char]
warningMsg =
            [Char]
"the 'wget' transport currently doesn't support"
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" range requests, which wastes network bandwidth."
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" To fix this, set 'http-transport' to 'curl' or"
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" 'plain-http' in '~/.config/cabal/config'."
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Note that the 'plain-http' transport doesn't"
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" support HTTPS.\n"

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasRangeHeader) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity [Char]
warningMsg
      (a
code, Maybe [Char]
etag') <- Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
forall {a}.
Read a =>
Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
parseOutput Verbosity
verbosity URI
uri [Char]
resp
      (a, Maybe [Char]) -> IO (a, Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
code, Maybe [Char]
etag')
      where
        args :: [[Char]]
args =
          [ [Char]
"--output-document=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
destPath
          , [Char]
"--user-agent=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
userAgent
          , [Char]
"--tries=5"
          , [Char]
"--timeout=15"
          , [Char]
"--server-response"
          ]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [[Char]
"--header", [Char]
"If-None-Match: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t]
              | [Char]
t <- Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList Maybe [Char]
etag
              ]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--header=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HeaderName -> [Char]
forall a. Show a => a -> [Char]
show HeaderName
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value
               | hdr :: Header
hdr@(Header HeaderName
name [Char]
value) <- [Header]
reqHeaders
               , (Bool -> Bool
not (Header -> Bool
isRangeHeader Header
hdr))
               ]

        -- wget doesn't support range requests.
        -- so, we ignore range request headers, lest we get errors.
        isRangeHeader :: Header -> Bool
        isRangeHeader :: Header -> Bool
isRangeHeader (Header HeaderName
HdrRange [Char]
_) = Bool
True
        isRangeHeader Header
_ = Bool
False

    posthttp :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp = Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
noPostYet

    posthttpfile :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (a, [Char])
posthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth =
      [Char]
-> [Char] -> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a. [Char] -> [Char] -> ([Char] -> Handle -> IO a) -> IO a
withTempFile
        ([Char] -> [Char]
takeDirectory [Char]
path)
        ([Char] -> [Char]
takeFileName [Char]
path)
        (([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char]))
-> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
tmpFile Handle
tmpHandle ->
          [Char]
-> [Char] -> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a. [Char] -> [Char] -> ([Char] -> Handle -> IO a) -> IO a
withTempFile ([Char] -> [Char]
takeDirectory [Char]
path) [Char]
"response" (([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char]))
-> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$
            \[Char]
responseFile Handle
responseHandle -> do
              Handle -> IO ()
hClose Handle
responseHandle
              (ByteString
body, [Char]
boundary) <- [Char] -> IO (ByteString, [Char])
generateMultipartBody [Char]
path
              Handle -> ByteString -> IO ()
LBS.hPut Handle
tmpHandle ByteString
body
              Handle -> IO ()
hClose Handle
tmpHandle
              let args :: [[Char]]
args =
                    [ [Char]
"--post-file=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tmpFile
                    , [Char]
"--user-agent=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
userAgent
                    , [Char]
"--server-response"
                    , [Char]
"--output-document=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
responseFile
                    , [Char]
"--header=Accept: text/plain"
                    , [Char]
"--header=Content-type: multipart/form-data; "
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"boundary="
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
boundary
                    ]
                      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe Auth -> Maybe [Char]
forall {a}. Maybe (Either a [Char]) -> Maybe [Char]
authTokenHeader Maybe Auth
auth)
              [Char]
out <- Verbosity -> URI -> [[Char]] -> IO [Char]
runWGet Verbosity
verbosity (Maybe Auth -> URI -> URI
forall {b}. Maybe (Either ([Char], [Char]) b) -> URI -> URI
addUriAuth Maybe Auth
auth URI
uri) [[Char]]
args
              (a
code, Maybe [Char]
_etag) <- Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
forall {a}.
Read a =>
Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
parseOutput Verbosity
verbosity URI
uri [Char]
out
              [Char] -> IOMode -> (Handle -> IO (a, [Char])) -> IO (a, [Char])
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
responseFile IOMode
ReadMode ((Handle -> IO (a, [Char])) -> IO (a, [Char]))
-> (Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
                [Char]
resp <- Handle -> IO [Char]
hGetContents Handle
hnd
                (a, [Char]) -> IO (a, [Char])
forall a. a -> IO a
evaluate ((a, [Char]) -> IO (a, [Char])) -> (a, [Char]) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$ (a, [Char]) -> (a, [Char])
forall a. NFData a => a -> a
force (a
code, [Char]
resp)

    puthttpfile :: Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (a, [Char])
puthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth [Header]
headers =
      [Char]
-> [Char] -> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a. [Char] -> [Char] -> ([Char] -> Handle -> IO a) -> IO a
withTempFile ([Char] -> [Char]
takeDirectory [Char]
path) [Char]
"response" (([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char]))
-> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$
        \[Char]
responseFile Handle
responseHandle -> do
          Handle -> IO ()
hClose Handle
responseHandle
          let args :: [[Char]]
args =
                [ [Char]
"--method=PUT"
                , [Char]
"--body-file=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
path
                , [Char]
"--user-agent=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
userAgent
                , [Char]
"--server-response"
                , [Char]
"--output-document=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
responseFile
                , [Char]
"--header=Accept: text/plain"
                ]
                  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--header=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HeaderName -> [Char]
forall a. Show a => a -> [Char]
show HeaderName
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value
                     | Header HeaderName
name [Char]
value <- [Header]
headers
                     ]
                  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe Auth -> Maybe [Char]
forall {a}. Maybe (Either a [Char]) -> Maybe [Char]
authTokenHeader Maybe Auth
auth)

          [Char]
out <- Verbosity -> URI -> [[Char]] -> IO [Char]
runWGet Verbosity
verbosity (Maybe Auth -> URI -> URI
forall {b}. Maybe (Either ([Char], [Char]) b) -> URI -> URI
addUriAuth Maybe Auth
auth URI
uri) [[Char]]
args
          (a
code, Maybe [Char]
_etag) <- Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
forall {a}.
Read a =>
Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
parseOutput Verbosity
verbosity URI
uri [Char]
out
          [Char] -> IOMode -> (Handle -> IO (a, [Char])) -> IO (a, [Char])
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
responseFile IOMode
ReadMode ((Handle -> IO (a, [Char])) -> IO (a, [Char]))
-> (Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
            [Char]
resp <- Handle -> IO [Char]
hGetContents Handle
hnd
            (a, [Char]) -> IO (a, [Char])
forall a. a -> IO a
evaluate ((a, [Char]) -> IO (a, [Char])) -> (a, [Char]) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$ (a, [Char]) -> (a, [Char])
forall a. NFData a => a -> a
force (a
code, [Char]
resp)

    authTokenHeader :: Maybe (Either a [Char]) -> Maybe [Char]
authTokenHeader (Just (Right [Char]
token)) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"--header=Authorization: X-ApiKey " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
token
    authTokenHeader Maybe (Either a [Char])
_ = Maybe [Char]
forall a. Maybe a
Nothing

    addUriAuth :: Maybe (Either ([Char], [Char]) b) -> URI -> URI
addUriAuth (Just (Left ([Char]
user, [Char]
pass))) URI
uri =
      URI
uri
        { uriAuthority = Just a{uriUserInfo = user ++ ":" ++ pass ++ "@"}
        }
      where
        a :: URIAuth
a = URIAuth -> Maybe URIAuth -> URIAuth
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> [Char] -> [Char] -> URIAuth
URIAuth [Char]
"" [Char]
"" [Char]
"") (URI -> Maybe URIAuth
uriAuthority URI
uri)
    addUriAuth Maybe (Either ([Char], [Char]) b)
_ URI
uri = URI
uri

    runWGet :: Verbosity -> URI -> [[Char]] -> IO [Char]
runWGet Verbosity
verbosity URI
uri [[Char]]
args = do
      -- We pass the URI via STDIN because it contains the users' credentials
      -- and sensitive data should not be passed via command line arguments.
      let
        invocation :: ProgramInvocation
invocation =
          (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation ConfiguredProgram
prog ([Char]
"--input-file=-" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
args))
            { progInvokeInput = Just $ IODataText $ uriToString id uri ""
            }

      -- wget returns its output on stderr rather than stdout
      ([Char]
_, [Char]
resp, ExitCode
exitCode) <-
        Verbosity -> ProgramInvocation -> IO ([Char], [Char], ExitCode)
getProgramInvocationOutputAndErrors
          Verbosity
verbosity
          ProgramInvocation
invocation
      -- wget returns exit code 8 for server "errors" like "304 not modified"
      if ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
|| ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== HttpCode -> ExitCode
ExitFailure HttpCode
8
        then [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
resp
        else Verbosity -> CabalInstallException -> IO [Char]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO [Char])
-> CabalInstallException -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CabalInstallException
WGetServerError (ConfiguredProgram -> [Char]
programPath ConfiguredProgram
prog) [Char]
resp

    -- With the --server-response flag, wget produces output with the full
    -- http server response with all headers, we want to find a line like
    -- "HTTP/1.1 200 OK", but only the last one, since we can have multiple
    -- requests due to redirects.
    parseOutput :: Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
parseOutput Verbosity
verbosity URI
uri [Char]
resp =
      let parsedCode :: Maybe a
parsedCode =
            [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe
              [ a
code
              | ([Char]
protocol : [Char]
codestr : [[Char]]
_err) <- ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
words ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([Char] -> [[Char]]
lines [Char]
resp))
              , [Char]
"HTTP/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
protocol
              , a
code <- Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList ([Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
codestr)
              ]
          mb_etag :: Maybe ETag
          mb_etag :: Maybe [Char]
mb_etag =
            [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe
              [ [Char]
etag
              | [[Char]
name, [Char]
etag] <- ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
words ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([Char] -> [[Char]]
lines [Char]
resp))
              , [Char] -> Bool
isETag [Char]
name
              ]
       in case Maybe a
parsedCode of
            Just a
i -> (a, Maybe [Char]) -> IO (a, Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
i, Maybe [Char]
mb_etag)
            Maybe a
_ -> Verbosity -> URI -> [Char] -> IO (a, Maybe [Char])
forall a. Verbosity -> URI -> [Char] -> IO a
statusParseFail Verbosity
verbosity URI
uri [Char]
resp

powershellTransport :: ConfiguredProgram -> HttpTransport
powershellTransport :: ConfiguredProgram -> HttpTransport
powershellTransport ConfiguredProgram
prog =
  (Verbosity
 -> URI
 -> Maybe [Char]
 -> [Char]
 -> [Header]
 -> IO (HttpCode, Maybe [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI
    -> [Char]
    -> Maybe Auth
    -> [Header]
    -> IO (HttpCode, [Char]))
-> Bool
-> Bool
-> HttpTransport
HttpTransport Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
gethttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
forall {a}.
Read a =>
Verbosity -> URI -> [Char] -> Maybe Auth -> IO (a, [Char])
posthttpfile Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (HttpCode, [Char])
forall {a}.
Read a =>
Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (a, [Char])
puthttpfile Bool
True Bool
False
  where
    gethttp :: Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
gethttp Verbosity
verbosity URI
uri Maybe [Char]
etag [Char]
destPath [Header]
reqHeaders = do
      [Char]
resp <-
        Verbosity -> [Char] -> IO [Char]
runPowershellScript Verbosity
verbosity ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$
          [Char] -> [[Char]] -> [[Char]] -> [[Char]] -> [Char]
webclientScript
            ([Char] -> [Char]
escape (URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri))
            ( ([Char]
"$targetStream = New-Object -TypeName System.IO.FileStream -ArgumentList " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
escape [Char]
destPath) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", Create")
                [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Header] -> [[Char]]
setupHeaders ((Header
useragentHeader Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
etagHeader) [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
reqHeaders))
            )
            [ [Char]
"$response = $request.GetResponse()"
            , [Char]
"$responseStream = $response.GetResponseStream()"
            , [Char]
"$buffer = new-object byte[] 10KB"
            , [Char]
"$count = $responseStream.Read($buffer, 0, $buffer.length)"
            , [Char]
"while ($count -gt 0)"
            , [Char]
"{"
            , [Char]
"    $targetStream.Write($buffer, 0, $count)"
            , [Char]
"    $count = $responseStream.Read($buffer, 0, $buffer.length)"
            , [Char]
"}"
            , [Char]
"Write-Host ($response.StatusCode -as [int]);"
            , [Char]
"Write-Host $response.GetResponseHeader(\"ETag\").Trim('\"')"
            ]
            [ [Char]
"$targetStream.Flush()"
            , [Char]
"$targetStream.Close()"
            , [Char]
"$targetStream.Dispose()"
            , [Char]
"$responseStream.Dispose()"
            ]
      [Char] -> IO (HttpCode, Maybe [Char])
parseResponse [Char]
resp
      where
        parseResponse :: String -> IO (HttpCode, Maybe ETag)
        parseResponse :: [Char] -> IO (HttpCode, Maybe [Char])
parseResponse [Char]
x =
          case [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
trim [Char]
x of
            ([Char]
code : [Char]
etagv : [[Char]]
_) -> (HttpCode -> (HttpCode, Maybe [Char]))
-> IO HttpCode -> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HttpCode
c -> (HttpCode
c, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
etagv)) (IO HttpCode -> IO (HttpCode, Maybe [Char]))
-> IO HttpCode -> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO HttpCode
parseCode [Char]
code [Char]
x
            ([Char]
code : [[Char]]
_) -> (HttpCode -> (HttpCode, Maybe [Char]))
-> IO HttpCode -> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HttpCode
c -> (HttpCode
c, Maybe [Char]
forall a. Maybe a
Nothing)) (IO HttpCode -> IO (HttpCode, Maybe [Char]))
-> IO HttpCode -> IO (HttpCode, Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO HttpCode
parseCode [Char]
code [Char]
x
            [[Char]]
_ -> Verbosity -> URI -> [Char] -> IO (HttpCode, Maybe [Char])
forall a. Verbosity -> URI -> [Char] -> IO a
statusParseFail Verbosity
verbosity URI
uri [Char]
x
        parseCode :: String -> String -> IO HttpCode
        parseCode :: [Char] -> [Char] -> IO HttpCode
parseCode [Char]
code [Char]
x = case [Char] -> Maybe HttpCode
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
code of
          Just HttpCode
i -> HttpCode -> IO HttpCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HttpCode
i
          Maybe HttpCode
Nothing -> Verbosity -> URI -> [Char] -> IO HttpCode
forall a. Verbosity -> URI -> [Char] -> IO a
statusParseFail Verbosity
verbosity URI
uri [Char]
x
        etagHeader :: [Header]
etagHeader = [HeaderName -> [Char] -> Header
Header HeaderName
HdrIfNoneMatch [Char]
t | [Char]
t <- Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList Maybe [Char]
etag]

    posthttp :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp = Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
noPostYet

    posthttpfile :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (a, [Char])
posthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth =
      [Char]
-> [Char] -> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a. [Char] -> [Char] -> ([Char] -> Handle -> IO a) -> IO a
withTempFile
        ([Char] -> [Char]
takeDirectory [Char]
path)
        ([Char] -> [Char]
takeFileName [Char]
path)
        (([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char]))
-> ([Char] -> Handle -> IO (a, [Char])) -> IO (a, [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
tmpFile Handle
tmpHandle -> do
          (ByteString
body, [Char]
boundary) <- [Char] -> IO (ByteString, [Char])
generateMultipartBody [Char]
path
          Handle -> ByteString -> IO ()
LBS.hPut Handle
tmpHandle ByteString
body
          Handle -> IO ()
hClose Handle
tmpHandle
          [Char]
fullPath <- [Char] -> IO [Char]
canonicalizePath [Char]
tmpFile

          let contentHeader :: Header
contentHeader =
                HeaderName -> [Char] -> Header
Header
                  HeaderName
HdrContentType
                  ([Char]
"multipart/form-data; boundary=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
boundary)
          [Char]
resp <-
            Verbosity -> [Char] -> IO [Char]
runPowershellScript Verbosity
verbosity ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$
              [Char] -> [[Char]] -> [[Char]] -> [[Char]] -> [Char]
webclientScript
                ([Char] -> [Char]
escape (URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri))
                ([Header] -> [[Char]]
setupHeaders (Header
contentHeader Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
extraHeaders) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Maybe Auth -> [[Char]]
setupAuth Maybe Auth
auth)
                ([Char] -> URI -> [Char] -> [[Char]]
forall {a} {p}. Show a => a -> p -> [Char] -> [[Char]]
uploadFileAction [Char]
"POST" URI
uri [Char]
fullPath)
                [[Char]]
uploadFileCleanup
          Verbosity -> URI -> [Char] -> IO (a, [Char])
forall {a}. Read a => Verbosity -> URI -> [Char] -> IO (a, [Char])
parseUploadResponse Verbosity
verbosity URI
uri [Char]
resp

    puthttpfile :: Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (a, [Char])
puthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth [Header]
headers = do
      [Char]
fullPath <- [Char] -> IO [Char]
canonicalizePath [Char]
path
      [Char]
resp <-
        Verbosity -> [Char] -> IO [Char]
runPowershellScript Verbosity
verbosity ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$
          [Char] -> [[Char]] -> [[Char]] -> [[Char]] -> [Char]
webclientScript
            ([Char] -> [Char]
escape (URI -> [Char]
forall a. Show a => a -> [Char]
show URI
uri))
            ([Header] -> [[Char]]
setupHeaders ([Header]
extraHeaders [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
headers) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Maybe Auth -> [[Char]]
setupAuth Maybe Auth
auth)
            ([Char] -> URI -> [Char] -> [[Char]]
forall {a} {p}. Show a => a -> p -> [Char] -> [[Char]]
uploadFileAction [Char]
"PUT" URI
uri [Char]
fullPath)
            [[Char]]
uploadFileCleanup
      Verbosity -> URI -> [Char] -> IO (a, [Char])
forall {a}. Read a => Verbosity -> URI -> [Char] -> IO (a, [Char])
parseUploadResponse Verbosity
verbosity URI
uri [Char]
resp

    runPowershellScript :: Verbosity -> [Char] -> IO [Char]
runPowershellScript Verbosity
verbosity [Char]
script = do
      let args :: [[Char]]
args =
            [ [Char]
"-InputFormat"
            , [Char]
"None"
            , -- the default execution policy doesn't allow running
              -- unsigned scripts, so we need to tell powershell to bypass it
              [Char]
"-ExecutionPolicy"
            , [Char]
"bypass"
            , [Char]
"-NoProfile"
            , [Char]
"-NonInteractive"
            , [Char]
"-Command"
            , [Char]
"-"
            ]
      Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity [Char]
script
      Verbosity -> ProgramInvocation -> IO [Char]
getProgramInvocationOutput
        Verbosity
verbosity
        (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation ConfiguredProgram
prog [[Char]]
args)
          { progInvokeInput = Just $ IODataText $ script ++ "\nExit(0);"
          }

    escape :: [Char] -> [Char]
escape = [Char] -> [Char]
forall a. Show a => a -> [Char]
show

    useragentHeader :: Header
useragentHeader = HeaderName -> [Char] -> Header
Header HeaderName
HdrUserAgent [Char]
userAgent
    extraHeaders :: [Header]
extraHeaders = [HeaderName -> [Char] -> Header
Header HeaderName
HdrAccept [Char]
"text/plain", Header
useragentHeader]

    setupHeaders :: [Header] -> [[Char]]
setupHeaders [Header]
headers =
      [ [Char]
"$request." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HeaderName -> [Char] -> [Char]
addHeader HeaderName
name [Char]
value
      | Header HeaderName
name [Char]
value <- [Header]
headers
      ]
      where
        addHeader :: HeaderName -> [Char] -> [Char]
addHeader HeaderName
header [Char]
value =
          case HeaderName
header of
            HeaderName
HdrAccept -> [Char]
"Accept = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrUserAgent -> [Char]
"UserAgent = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrConnection -> [Char]
"Connection = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrContentLength -> [Char]
"ContentLength = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrContentType -> [Char]
"ContentType = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrDate -> [Char]
"Date = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrExpect -> [Char]
"Expect = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrHost -> [Char]
"Host = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrIfModifiedSince -> [Char]
"IfModifiedSince = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrReferer -> [Char]
"Referer = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrTransferEncoding -> [Char]
"TransferEncoding = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value
            HeaderName
HdrRange ->
              let ([Char]
start, [Char]
end) =
                    if [Char]
"bytes=" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
value
                      then case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') [Char]
value' of
                        ([Char]
start', Char
'-' : [Char]
end') -> ([Char]
start', [Char]
end')
                        ([Char], [Char])
_ -> [Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not decode range: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value
                      else [Char] -> ([Char], [Char])
forall a. HasCallStack => [Char] -> a
error ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not decode range: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
value
                  value' :: [Char]
value' = HttpCode -> [Char] -> [Char]
forall a. HttpCode -> [a] -> [a]
drop HttpCode
6 [Char]
value
               in [Char]
"AddRange(\"bytes\", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
start [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
end [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
            HeaderName
name -> [Char]
"Headers.Add(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape (HeaderName -> [Char]
forall a. Show a => a -> [Char]
show HeaderName
name) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
value [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"

    setupAuth :: Maybe Auth -> [[Char]]
setupAuth (Just (Left ([Char]
uname, [Char]
passwd))) =
      [ [Char]
"$request.Credentials = new-object System.Net.NetworkCredential("
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
uname
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
","
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
passwd
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
",\"\");"
      ]
    setupAuth (Just (Right [Char]
token)) =
      [[Char]
"$request.Headers[\"Authorization\"] = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape ([Char]
"X-ApiKey " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
token)]
    setupAuth Maybe Auth
Nothing = []

    uploadFileAction :: a -> p -> [Char] -> [[Char]]
uploadFileAction a
method p
_uri [Char]
fullPath =
      [ [Char]
"$request.Method = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
method
      , [Char]
"$requestStream = $request.GetRequestStream()"
      , [Char]
"$fileStream = [System.IO.File]::OpenRead(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escape [Char]
fullPath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
      , [Char]
"$bufSize=10000"
      , [Char]
"$chunk = New-Object byte[] $bufSize"
      , [Char]
"while( $bytesRead = $fileStream.Read($chunk,0,$bufsize) )"
      , [Char]
"{"
      , [Char]
"  $requestStream.write($chunk, 0, $bytesRead)"
      , [Char]
"  $requestStream.Flush()"
      , [Char]
"}"
      , [Char]
""
      , [Char]
"$responseStream = $request.getresponse()"
      , [Char]
"$responseReader = new-object System.IO.StreamReader $responseStream.GetResponseStream()"
      , [Char]
"$code = $response.StatusCode -as [int]"
      , [Char]
"if ($code -eq 0) {"
      , [Char]
"  $code = 200;"
      , [Char]
"}"
      , [Char]
"Write-Host $code"
      , [Char]
"Write-Host $responseReader.ReadToEnd()"
      ]

    uploadFileCleanup :: [[Char]]
uploadFileCleanup =
      [ [Char]
"$fileStream.Close()"
      , [Char]
"$requestStream.Close()"
      , [Char]
"$responseStream.Close()"
      ]

    parseUploadResponse :: Verbosity -> URI -> [Char] -> IO (a, [Char])
parseUploadResponse Verbosity
verbosity URI
uri [Char]
resp = case [Char] -> [[Char]]
lines ([Char] -> [Char]
trim [Char]
resp) of
      ([Char]
codeStr : [[Char]]
message)
        | Just a
code <- [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
codeStr -> (a, [Char]) -> IO (a, [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
code, [[Char]] -> [Char]
unlines [[Char]]
message)
      [[Char]]
_ -> Verbosity -> URI -> [Char] -> IO (a, [Char])
forall a. Verbosity -> URI -> [Char] -> IO a
statusParseFail Verbosity
verbosity URI
uri [Char]
resp

    webclientScript :: [Char] -> [[Char]] -> [[Char]] -> [[Char]] -> [Char]
webclientScript [Char]
uri [[Char]]
setup [[Char]]
action [[Char]]
cleanup =
      [[Char]] -> [Char]
unlines
        [ [Char]
"[Net.ServicePointManager]::SecurityProtocol = \"tls12, tls11, tls\""
        , [Char]
"$uri = New-Object \"System.Uri\" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
uri
        , [Char]
"$request = [System.Net.HttpWebRequest]::Create($uri)"
        , [[Char]] -> [Char]
unlines [[Char]]
setup
        , [Char]
"Try {"
        , [[Char]] -> [Char]
unlines (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
action)
        , [Char]
"} Catch [System.Net.WebException] {"
        , [Char]
"  $exception = $_.Exception;"
        , [Char]
"  If ($exception.Status -eq "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[System.Net.WebExceptionStatus]::ProtocolError) {"
        , [Char]
"    $response = $exception.Response -as [System.Net.HttpWebResponse];"
        , [Char]
"    $reader = new-object "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"System.IO.StreamReader($response.GetResponseStream());"
        , [Char]
"    Write-Host ($response.StatusCode -as [int]);"
        , [Char]
"    Write-Host $reader.ReadToEnd();"
        , [Char]
"  } Else {"
        , [Char]
"    Write-Host $exception.Message;"
        , [Char]
"  }"
        , [Char]
"} Catch {"
        , [Char]
"  Write-Host $_.Exception.Message;"
        , [Char]
"} finally {"
        , [[Char]] -> [Char]
unlines (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
cleanup)
        , [Char]
"}"
        ]

------------------------------------------------------------------------------
-- The builtin plain HttpTransport
--

plainHttpTransport :: HttpTransport
plainHttpTransport :: HttpTransport
plainHttpTransport =
  (Verbosity
 -> URI
 -> Maybe [Char]
 -> [Char]
 -> [Header]
 -> IO (HttpCode, Maybe [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char]))
-> (Verbosity
    -> URI
    -> [Char]
    -> Maybe Auth
    -> [Header]
    -> IO (HttpCode, [Char]))
-> Bool
-> Bool
-> HttpTransport
HttpTransport Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
gethttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttpfile Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (HttpCode, [Char])
puthttpfile Bool
False Bool
False
  where
    gethttp :: Verbosity
-> URI
-> Maybe [Char]
-> [Char]
-> [Header]
-> IO (HttpCode, Maybe [Char])
gethttp Verbosity
verbosity URI
uri Maybe [Char]
etag [Char]
destPath [Header]
reqHeaders = do
      let req :: Request ByteString
req =
            Request
              { rqURI :: URI
rqURI = URI
uri
              , rqMethod :: RequestMethod
rqMethod = RequestMethod
GET
              , rqHeaders :: [Header]
rqHeaders =
                  [ HeaderName -> [Char] -> Header
Header HeaderName
HdrIfNoneMatch [Char]
t
                  | [Char]
t <- Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList Maybe [Char]
etag
                  ]
                    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
reqHeaders
              , rqBody :: ByteString
rqBody = ByteString
LBS.empty
              }
      (URI
_, Response ByteString
resp) <- Verbosity
-> Maybe (Either ([Char], [Char]) Any)
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
-> IO (URI, Response ByteString)
forall {b} {conn} {b}.
Verbosity
-> Maybe (Either ([Char], [Char]) b)
-> BrowserAction conn b
-> IO b
cabalBrowse Verbosity
verbosity Maybe (Either ([Char], [Char]) Any)
forall a. Maybe a
Nothing (Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall ty.
HStream ty =>
Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
request Request ByteString
req)
      let code :: HttpCode
code = (HttpCode, HttpCode, HttpCode) -> HttpCode
forall {a}. Num a => (a, a, a) -> a
convertRspCode (Response ByteString -> (HttpCode, HttpCode, HttpCode)
forall a. Response a -> (HttpCode, HttpCode, HttpCode)
rspCode Response ByteString
resp)
          etag' :: Maybe [Char]
etag' = HeaderName -> [Header] -> Maybe [Char]
lookupHeader HeaderName
HdrETag (Response ByteString -> [Header]
forall a. Response a -> [Header]
rspHeaders Response ByteString
resp)
      -- 206 Partial Content is a normal response to a range request; see #3385.
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HttpCode
code HttpCode -> HttpCode -> Bool
forall a. Eq a => a -> a -> Bool
== HttpCode
200 Bool -> Bool -> Bool
|| HttpCode
code HttpCode -> HttpCode -> Bool
forall a. Eq a => a -> a -> Bool
== HttpCode
206) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> ByteString -> IO ()
writeFileAtomic [Char]
destPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
          Response ByteString -> ByteString
forall a. Response a -> a
rspBody Response ByteString
resp
      (HttpCode, Maybe [Char]) -> IO (HttpCode, Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpCode
code, Maybe [Char]
etag')

    posthttp :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttp = Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
noPostYet

    posthttpfile :: Verbosity -> URI -> [Char] -> Maybe Auth -> IO (HttpCode, [Char])
posthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth = do
      (ByteString
body, [Char]
boundary) <- [Char] -> IO (ByteString, [Char])
generateMultipartBody [Char]
path
      let headers :: [Header]
headers =
            [ HeaderName -> [Char] -> Header
Header
                HeaderName
HdrContentType
                ([Char]
"multipart/form-data; boundary=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
boundary)
            , HeaderName -> [Char] -> Header
Header HeaderName
HdrContentLength (Int64 -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int64
LBS8.length ByteString
body))
            , HeaderName -> [Char] -> Header
Header HeaderName
HdrAccept ([Char]
"text/plain")
            ]
              [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ Maybe Header -> [Header]
forall a. Maybe a -> [a]
maybeToList (Maybe Auth -> Maybe Header
forall {a}. Maybe (Either a [Char]) -> Maybe Header
authTokenHeader Maybe Auth
auth)
          req :: Request ByteString
req =
            Request
              { rqURI :: URI
rqURI = URI
uri
              , rqMethod :: RequestMethod
rqMethod = RequestMethod
POST
              , rqHeaders :: [Header]
rqHeaders = [Header]
headers
              , rqBody :: ByteString
rqBody = ByteString
body
              }
      (URI
_, Response ByteString
resp) <- Verbosity
-> Maybe Auth
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
-> IO (URI, Response ByteString)
forall {b} {conn} {b}.
Verbosity
-> Maybe (Either ([Char], [Char]) b)
-> BrowserAction conn b
-> IO b
cabalBrowse Verbosity
verbosity Maybe Auth
auth (Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall ty.
HStream ty =>
Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
request Request ByteString
req)
      (HttpCode, [Char]) -> IO (HttpCode, [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((HttpCode, HttpCode, HttpCode) -> HttpCode
forall {a}. Num a => (a, a, a) -> a
convertRspCode (Response ByteString -> (HttpCode, HttpCode, HttpCode)
forall a. Response a -> (HttpCode, HttpCode, HttpCode)
rspCode Response ByteString
resp), Response ByteString -> [Char]
rspErrorString Response ByteString
resp)

    puthttpfile :: Verbosity
-> URI -> [Char] -> Maybe Auth -> [Header] -> IO (HttpCode, [Char])
puthttpfile Verbosity
verbosity URI
uri [Char]
path Maybe Auth
auth [Header]
headers = do
      ByteString
body <- [Char] -> IO ByteString
LBS8.readFile [Char]
path
      let req :: Request ByteString
req =
            Request
              { rqURI :: URI
rqURI = URI
uri
              , rqMethod :: RequestMethod
rqMethod = RequestMethod
PUT
              , rqHeaders :: [Header]
rqHeaders =
                  HeaderName -> [Char] -> Header
Header HeaderName
HdrContentLength (Int64 -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int64
LBS8.length ByteString
body))
                    Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: HeaderName -> [Char] -> Header
Header HeaderName
HdrAccept [Char]
"text/plain"
                    Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: Maybe Header -> [Header]
forall a. Maybe a -> [a]
maybeToList (Maybe Auth -> Maybe Header
forall {a}. Maybe (Either a [Char]) -> Maybe Header
authTokenHeader Maybe Auth
auth)
                    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
headers
              , rqBody :: ByteString
rqBody = ByteString
body
              }
      (URI
_, Response ByteString
resp) <- Verbosity
-> Maybe Auth
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
-> IO (URI, Response ByteString)
forall {b} {conn} {b}.
Verbosity
-> Maybe (Either ([Char], [Char]) b)
-> BrowserAction conn b
-> IO b
cabalBrowse Verbosity
verbosity Maybe Auth
auth (Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall ty.
HStream ty =>
Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
request Request ByteString
req)
      (HttpCode, [Char]) -> IO (HttpCode, [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((HttpCode, HttpCode, HttpCode) -> HttpCode
forall {a}. Num a => (a, a, a) -> a
convertRspCode (Response ByteString -> (HttpCode, HttpCode, HttpCode)
forall a. Response a -> (HttpCode, HttpCode, HttpCode)
rspCode Response ByteString
resp), Response ByteString -> [Char]
rspErrorString Response ByteString
resp)

    convertRspCode :: (a, a, a) -> a
convertRspCode (a
a, a
b, a
c) = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
100 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
c

    rspErrorString :: Response ByteString -> [Char]
rspErrorString Response ByteString
resp =
      case HeaderName -> [Header] -> Maybe [Char]
lookupHeader HeaderName
HdrContentType (Response ByteString -> [Header]
forall a. Response a -> [Header]
rspHeaders Response ByteString
resp) of
        Just [Char]
contenttype
          | (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') [Char]
contenttype [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"text/plain" ->
              ByteString -> [Char]
LBS8.unpack (Response ByteString -> ByteString
forall a. Response a -> a
rspBody Response ByteString
resp)
        Maybe [Char]
_ -> Response ByteString -> [Char]
forall a. Response a -> [Char]
rspReason Response ByteString
resp

    cabalBrowse :: Verbosity
-> Maybe (Either ([Char], [Char]) b)
-> BrowserAction conn b
-> IO b
cabalBrowse Verbosity
verbosity Maybe (Either ([Char], [Char]) b)
auth BrowserAction conn b
act = do
      Proxy
p <- Proxy -> Proxy
fixupEmptyProxy (Proxy -> Proxy) -> IO Proxy -> IO Proxy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO Proxy
fetchProxy Bool
True
      (IOError -> Maybe ()) -> (() -> IO b) -> IO b -> IO b
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
Exception.handleJust
        (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
        ( IO b -> () -> IO b
forall a b. a -> b -> a
const (IO b -> () -> IO b)
-> (CabalInstallException -> IO b)
-> CabalInstallException
-> ()
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> CabalInstallException -> IO b
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> () -> IO b)
-> CabalInstallException -> () -> IO b
forall a b. (a -> b) -> a -> b
$ CabalInstallException
Couldn'tEstablishHttpConnection
        )
        (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ BrowserAction conn b -> IO b
forall conn a. BrowserAction conn a -> IO a
browse
        (BrowserAction conn b -> IO b) -> BrowserAction conn b -> IO b
forall a b. (a -> b) -> a -> b
$ do
          Proxy -> BrowserAction conn ()
forall t. Proxy -> BrowserAction t ()
setProxy Proxy
p
          ([Char] -> IO ()) -> BrowserAction conn ()
forall t. ([Char] -> IO ()) -> BrowserAction t ()
setErrHandler (Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity ([Char] -> IO ()) -> ([Char] -> [Char]) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"http error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++))
          ([Char] -> IO ()) -> BrowserAction conn ()
forall t. ([Char] -> IO ()) -> BrowserAction t ()
setOutHandler (Verbosity -> [Char] -> IO ()
debug Verbosity
verbosity)
          [Char] -> BrowserAction conn ()
forall t. [Char] -> BrowserAction t ()
setUserAgent [Char]
userAgent
          Bool -> BrowserAction conn ()
forall t. Bool -> BrowserAction t ()
setAllowBasicAuth Bool
False
          case Maybe (Either ([Char], [Char]) b)
auth of
            Just (Left ([Char], [Char])
x) -> (URI -> [Char] -> IO (Maybe ([Char], [Char])))
-> BrowserAction conn ()
forall t.
(URI -> [Char] -> IO (Maybe ([Char], [Char])))
-> BrowserAction t ()
setAuthorityGen (\URI
_ [Char]
_ -> Maybe ([Char], [Char]) -> IO (Maybe ([Char], [Char]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([Char], [Char]) -> IO (Maybe ([Char], [Char])))
-> Maybe ([Char], [Char]) -> IO (Maybe ([Char], [Char]))
forall a b. (a -> b) -> a -> b
$ ([Char], [Char]) -> Maybe ([Char], [Char])
forall a. a -> Maybe a
Just ([Char], [Char])
x)
            Maybe (Either ([Char], [Char]) b)
_ -> (URI -> [Char] -> IO (Maybe ([Char], [Char])))
-> BrowserAction conn ()
forall t.
(URI -> [Char] -> IO (Maybe ([Char], [Char])))
-> BrowserAction t ()
setAuthorityGen (\URI
_ [Char]
_ -> Maybe ([Char], [Char]) -> IO (Maybe ([Char], [Char]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Char], [Char])
forall a. Maybe a
Nothing)
          BrowserAction conn b
act

    authTokenHeader :: Maybe (Either a [Char]) -> Maybe Header
authTokenHeader (Just (Right [Char]
token)) = Header -> Maybe Header
forall a. a -> Maybe a
Just (Header -> Maybe Header) -> Header -> Maybe Header
forall a b. (a -> b) -> a -> b
$ HeaderName -> [Char] -> Header
Header HeaderName
HdrAuthorization ([Char]
"X-ApiKey " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
token)
    authTokenHeader Maybe (Either a [Char])
_ = Maybe Header
forall a. Maybe a
Nothing

    fixupEmptyProxy :: Proxy -> Proxy
fixupEmptyProxy (Proxy [Char]
uri Maybe Authority
_) | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
uri = Proxy
NoProxy
    fixupEmptyProxy Proxy
p = Proxy
p

------------------------------------------------------------------------------
-- Common stuff used by multiple transport impls
--

userAgent :: String
userAgent :: [Char]
userAgent =
  [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
"cabal-install/"
    , Version -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Version
cabalInstallVersion
    , [Char]
" ("
    , OS -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow OS
buildOS
    , [Char]
"; "
    , Arch -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Arch
buildArch
    , [Char]
")"
    ]

statusParseFail :: Verbosity -> URI -> String -> IO a
statusParseFail :: forall a. Verbosity -> URI -> [Char] -> IO a
statusParseFail Verbosity
verbosity URI
uri [Char]
r =
  Verbosity -> CabalInstallException -> IO a
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO a) -> CabalInstallException -> IO a
forall a b. (a -> b) -> a -> b
$ URI -> [Char] -> CabalInstallException
StatusParseFail URI
uri [Char]
r

------------------------------------------------------------------------------
-- Multipart stuff partially taken from cgi package.
--

generateMultipartBody :: FilePath -> IO (LBS.ByteString, String)
generateMultipartBody :: [Char] -> IO (ByteString, [Char])
generateMultipartBody [Char]
path = do
  ByteString
content <- [Char] -> IO ByteString
LBS.readFile [Char]
path
  [Char]
boundary <- IO [Char]
genBoundary
  let !body :: ByteString
body = ByteString -> ByteString -> ByteString
formatBody ByteString
content ([Char] -> ByteString
LBS8.pack [Char]
boundary)
  (ByteString, [Char]) -> IO (ByteString, [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
body, [Char]
boundary)
  where
    formatBody :: ByteString -> ByteString -> ByteString
formatBody ByteString
content ByteString
boundary =
      [ByteString] -> ByteString
LBS8.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
        [ByteString
crlf, ByteString
dd, ByteString
boundary, ByteString
crlf]
          [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ByteString
LBS8.pack (Header -> [Char]
forall a. Show a => a -> [Char]
show Header
header) | Header
header <- [Header]
headers]
          [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ ByteString
crlf
             , ByteString
content
             , ByteString
crlf
             , ByteString
dd
             , ByteString
boundary
             , ByteString
dd
             , ByteString
crlf
             ]

    headers :: [Header]
headers =
      [ HeaderName -> [Char] -> Header
Header
          ([Char] -> HeaderName
HdrCustom [Char]
"Content-disposition")
          ( [Char]
"form-data; name=package; "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"filename=\""
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
takeFileName [Char]
path
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
          )
      , HeaderName -> [Char] -> Header
Header HeaderName
HdrContentType [Char]
"application/x-gzip"
      ]

    crlf :: ByteString
crlf = [Char] -> ByteString
LBS8.pack [Char]
"\r\n"
    dd :: ByteString
dd = [Char] -> ByteString
LBS8.pack [Char]
"--"

genBoundary :: IO String
genBoundary :: IO [Char]
genBoundary = do
  Integer
i <- (Integer, Integer) -> IO Integer
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Integer
0x10000000000000, Integer
0xFFFFFFFFFFFFFF) :: IO Integer
  [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ Integer -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex Integer
i [Char]
""

isETag :: String -> Bool
isETag :: [Char] -> Bool
isETag [Char]
name = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
Char.toLower [Char]
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"etag:"