marmalade-upload 0.9 → 0.10

raw patch · 7 files changed

+340/−123 lines, 7 filesdep +Cabaldep +http-client-tlsdep +processdep −utf8-stringdep ~http-clientnew-component:exe:buildPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, http-client-tls, process, shake, split, text, zip-archive

Dependencies removed: utf8-string

Dependency ranges changed: http-client

API changes (from Hackage documentation)

Files

• CHANGES.md +5/−0
• README.md +19/−1
• build.hs +144/−0
• main.hs +57/−39
• marmalade-upload.cabal +56/−29
• src/Web/Marmalade.hs +47/−43
• test/marmalade-tests.hs +12/−11

@@ -1,3 +1,8 @@+0.10 (Oct 26, 2014)+===================++- Use TLS to connect to Marmalade+ 0.9 (Jul 8, 2014) ================= 

@@ -34,7 +34,7 @@ The binaries are statically linked and to not require a Haskell installation or any Haskell libraries. -### Building from Source+### Building from Hackage  Install [Haskell Platform][] and type the following command to install marmalade-upload from source:@@ -47,6 +47,24 @@  [download page]: https://github.com/lunaryorn/marmalade-upload/releases/latest [Haskell Platform]: http://www.haskell.org/platform/++### Building from source++Install [Haskell Platform][] and type the following commands:++```console+$ cabal sandbox init+$ cabal install --only-dependencies+$ cabal configure -f development+$ cabal exec ./build.hs -- install+```++This will install the binary to `~/bin/marmalade-upload`.  To choose a different+prefix:++```console+$ cabal exec ./build.sh -- --prefix=/usr/local install+```  Usage -----

@@ -0,0 +1,144 @@+#!/usr/bin/env runhaskell+-- Copyright (c) 2014 Sebastian Wiesner <swiesner@lunaryorn.com>++-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:++-- The above copyright notice and this permission notice shall be included in all+-- copies or substantial portions of the Software.++-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import           Codec.Archive.Zip (Archive,ZipOption(OptLocation),+                                    emptyArchive,fromArchive,+                                    addFilesToArchive)+import           Control.Exception (catch,throwIO)+import           Control.Monad (liftM)+import qualified Data.ByteString.Lazy as LBS+import           Data.Char (isSpace)+import           Data.Default (Default(def))+import           Data.List (intercalate,foldl')+import           Data.List.Split (splitOn)+import           Data.Maybe (fromMaybe)+import           Data.Version (showVersion)+import           Development.Shake+import           Development.Shake.FilePath ((</>))+import           Distribution.Package (PackageName(PackageName),+                                       pkgName,pkgVersion)+import           Distribution.PackageDescription (packageDescription,package)+import           Distribution.PackageDescription.Parse (readPackageDescription)+import           Distribution.Simple.BuildPaths (defaultDistPref)+import           Distribution.System (OS(OSX,Linux),buildOS)+import           Distribution.Verbosity (silent)+import           System.Console.GetOpt (OptDescr(Option),ArgDescr(ReqArg))+import           System.Directory (getHomeDirectory,removeFile)+import           System.Environment (unsetEnv)+import           System.IO.Error (isDoesNotExistError)+import           System.Info (arch)+import           System.Process (readProcess)++getOSXVersion :: IO String+getOSXVersion = liftM (takeWhile (not.isSpace))+                      (readProcess "sw_vers" ["-productVersion"] "")++getPlatformInfo :: IO String+getPlatformInfo = case buildOS of+  Linux -> return ("linux-" ++ arch)+  OSX -> do+    version <- getOSXVersion+    let major = intercalate "." (take 2 (splitOn "." version))+    return ("osx-" ++ major)+  os -> ioError (userError ("Unsupported operating system " ++ show os))++archiveName :: String -> String -> String -> FilePath+archiveName name version platform =+  intercalate "-" [name, version, platform] ++ ".zip"++writeArchive' :: FilePath -> Archive -> Action ()+writeArchive' dest archive = do+  liftIO (LBS.writeFile dest (fromArchive archive))+  trackWrite [dest]++addToArchive' :: FilePath -> String -> Archive -> Action Archive+addToArchive' source name archive = do+  need [source]+  liftIO (addFilesToArchive [OptLocation name False] archive [source])++data Flags = Prefix String deriving (Eq, Show)++confFlags :: [OptDescr (Either String Flags)]+confFlags = [Option [] ["--prefix" ] (ReqArg (Right . Prefix) "PREFIX")+         "Installation prefix (default ~)"]++data BuildConfig = BuildConfig { confPrefix :: Maybe String }++instance Default BuildConfig where+  def = BuildConfig Nothing++addFlags :: BuildConfig -> [Flags] -> BuildConfig+addFlags = foldl' addFlag+  where addFlag conf (Prefix p) = conf{confPrefix = Just p}++handleExists :: IOError -> IO ()+handleExists e | isDoesNotExistError e = return ()+               | otherwise = throwIO e+++main :: IO ()+main = do+  -- We need to get out of cabal exec, because cabal build doesn't like it+  unsetEnv "GHC_PACKAGE_PATH"+  -- Read the package description+  desc <- readPackageDescription silent "marmalade-upload.cabal"+  -- Obtain platform information+  platform <- getPlatformInfo+  homeDir <- getHomeDirectory+  -- Start Shake to process our rules+  let opts = shakeOptions{shakeFiles=defaultDistPref </> "shake"}+  shakeArgsWith opts confFlags $ \flags targets -> return $ Just $ do+    want (if null targets then ["build"] else targets)+    let config = addFlags def flags+    let prefix = fromMaybe homeDir (confPrefix config)++    -- Extract meta information from the package description+    let pkgId = package (packageDescription desc)+    let (PackageName name) = pkgName pkgId+    let bin = defaultDistPref </> "build" </> name </> name++    -- Build the binary.  Use a phony rule because cabal has its own dependency+    -- tracking anyway+    "build" ~> command_ [] "cabal" ["build"]+    bin ~> need ["build"]++    -- Install and uninstall the binary+    let binInstall = prefix </> "bin" </> name+    "install" ~> need [binInstall]+    binInstall *> copyFile' bin++    "uninstall" ~> do+      liftIO (removeFile binInstall `catch` handleExists)+      putLoud ("Removing " ++ binInstall)++    -- Create binary archives for releases+    let binDistFile = defaultDistPref </>+                      archiveName name (showVersion (pkgVersion pkgId)) platform++    "bindist" ~> need [binDistFile]++    binDistFile *> \dest -> do+      archive <- addToArchive' bin name emptyArchive+      writeArchive' dest archive

@@ -22,9 +22,6 @@  module Main (main) where -import           Paths_marmalade_upload (version)-import           Web.Marmalade- import           Control.Exception (SomeException,IOException,bracket,handle) import           Control.Monad (liftM,when,mzero) import           Control.Monad.IO.Class (liftIO)@@ -36,33 +33,39 @@ import           Data.Default (Default(def)) import           Data.Maybe (fromMaybe) import           Data.Monoid ((<>),mempty)+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy.IO as L import           Data.Version (showVersion) import           Options.Applicative (Parser,execParser,                                       info,fullDesc,progDesc,-                                      infoOption,strOption,-                                      helper,argument,long,short,str,+                                      infoOption,option,+                                      helper,argument,long,short,str,auto,                                       metavar,help,value,showDefault,                                       (<$>),(<*>))+import           Paths_marmalade_upload (version) import           System.Directory (getHomeDirectory) import           System.Exit (ExitCode(ExitFailure),exitWith) import           System.FilePath ((</>)) import qualified System.IO as IO import qualified System.Keyring as K import           Text.Printf (printf)+import           Web.Marmalade  -- Program information -appName :: String+appName :: Text appName = "marmalade-upload" -appVersion :: String-appVersion = showVersion version+appVersion :: Text+appVersion = T.pack (showVersion version) -appService :: String-appService = "lunaryorn/" ++ appName+appService :: Text+appService = T.concat ["lunaryorn/", appName] -appUserAgent :: String-appUserAgent = appService ++ "/" ++ appVersion+appUserAgent :: Text+appUserAgent = T.concat [appService, "/", appVersion]  -- CLI tools @@ -81,25 +84,27 @@ -- -- Show @prompt@ on the terminal, disable echo and read a password.  Afterwards -- reset echoing.-askPassword :: String -> IO String+askPassword :: Text -> IO Text askPassword prompt = do-  putStr prompt+  T.putStr prompt   IO.hFlush IO.stdout-  password <- withEcho False getLine+  password <- withEcho False T.getLine   putChar '\n'   return password -askMarmaladeUsername :: IO String+askMarmaladeUsername :: IO Text askMarmaladeUsername = do-  putStr "Marmalade username: "+  T.putStr "Marmalade username: "   IO.hFlush IO.stdout-  getLine+  T.getLine  -- |@'askMarmaladePassword' username@ asks for the Marmalade password of the -- given @username@ on the terminal.-askMarmaladePassword :: String -> Marmalade String-askMarmaladePassword username =-  liftIO (askPassword (printf "Marmalade password for %s (never stored): " username))+askMarmaladePassword :: Text -> Marmalade Text+askMarmaladePassword username = liftIO (askPassword prompt)+  where prompt = T.concat [ "Marmalade password for "+                          , username+                          , " (never stored): " ]  -- |@'getAuth' username@ gets authentication information for the given -- @username@.@@ -109,22 +114,35 @@ -- -- If the authorization token of @username@ is stored in the keyring, use it, -- otherwise fall back to password authentication.-getAuth :: String -> IO (Bool, Auth)+getAuth :: Text -> IO (Bool, Auth) getAuth username = handle ignoreMissingBackend $ do-  result <- K.getPassword (K.Service appService) (K.Username username)+  result <- K.getPassword (K.Service (T.unpack appService))+                          (K.Username (T.unpack username))   return $ case result of-    Just (K.Password token) -> (False, TokenAuth (Username username) (Token token))-    Nothing -> (True, BasicAuth (Username username) (askMarmaladePassword username))+    Just (K.Password token) -> (False, TokenAuth (Username (username))+                                                 (Token (T.pack token)))+    Nothing -> (True, BasicAuth (Username username)+                                (askMarmaladePassword username))   where     ignoreMissingBackend :: K.KeyringMissingBackendError -> IO (Bool, Auth)     ignoreMissingBackend _ = do       IO.hPutStrLn IO.stderr         "Warning: No keyring backend found, token will not be saved"-      return (False, BasicAuth (Username username) (askMarmaladePassword username))+      return (False, BasicAuth (Username username)+                               (askMarmaladePassword username)) +-- |@'setAuth' username token@ stores the authentication token for the given+-- @username@.+--+-- Stores @token@ for @username@ in the system keyring if possible.+storeAuth :: Text -> Text -> IO ()+storeAuth username token = K.setPassword (K.Service (T.unpack appService))+                                         (K.Username (T.unpack username))+                                         (K.Password (T.unpack token))+ -- Configuration handling -data Configuration = Configuration { configUsername :: Maybe String }+data Configuration = Configuration { configUsername :: Maybe Text }                      deriving (Read,Show,Eq)  instance Default Configuration where@@ -163,8 +181,8 @@ exitException :: SomeException -> IO () exitException = exitFailure.show -data Arguments = Arguments { argUsername :: String-                           , argPackageFile :: String }+data Arguments = Arguments { argUsername :: Text+                           , argPackageFile :: FilePath }  parser :: Configuration -> Parser Arguments parser config =@@ -175,14 +193,14 @@                                              help "Show version number and exit")     defUsername = fromMaybe "" (configUsername config)     arguments = Arguments <$>-                strOption (long "username" <>-                           short 'u' <>-                           value defUsername <>-                           if defUsername == "" then mempty else showDefault <>-                           help "Marmalade username" <>-                           metavar "USERNAME") <*>+                option auto (long "username" <>+                             short 'u' <>+                             value defUsername <>+                             if defUsername == "" then mempty else showDefault <>+                             help "Marmalade username" <>+                             metavar "USERNAME") <*>                 argument str (metavar "PACKAGE" <> help "Package file")-    versionMessage = unlines [appName ++ " " ++ appVersion+    versionMessage = unlines [(T.unpack appName) ++ " " ++ (T.unpack appVersion)                              ,"Copyright (C) 2014 Sebastian Wiesner."                              ,"You may redistribute marmalade-upload"                              ,"under the terms of the MIT/X11 license."]@@ -201,8 +219,8 @@         configFile >>= printf "Saved username to %s\n"     -- Save the token now     when shallSaveToken $-      liftIO (K.setPassword (K.Service appService) (K.Username username) (K.Password token))+      liftIO (storeAuth username token)     upload <- uploadPackage (argPackageFile args)-    liftIO (putStrLn (uploadMessage upload))-  where getUsername Arguments{argUsername=[]} = askMarmaladeUsername+    liftIO (L.putStrLn (uploadMessage upload))+  where getUsername args | T.null (argUsername args) = askMarmaladeUsername         getUsername args = return (argUsername args)

@@ -1,5 +1,5 @@ name:                marmalade-upload-version:             0.9+version:             0.10 synopsis:            Upload packages to Marmalade description:   Upload Emacs packages to the <http://marmalade-repo.org/ Marmalade> ELPA@@ -25,49 +25,76 @@ source-repository this   type:              git   location:          https://github.com/lunaryorn/marmalade-upload.git-  tag:               0.9+  tag:               0.10 +flag Development+  description:         Enable Developer mode (additional maintenance tools)+  manual:              True+  default:             False+ library   hs-source-dirs:      src/   exposed-modules:     Web.Marmalade   ghc-options:         -Wall-  build-depends:       base >=4.6 && <4.8,-                       mtl >=2.1,-                       transformers >=0.3,-                       exceptions >=0.5,-                       bytestring >=0.10,-                       utf8-string >=0.3,-                       aeson >=0.7,-                       network >=2.4,-                       http-types >=0.8,-                       http-client >=0.3+  build-depends:       aeson >=0.7+                     , base >=4.6 && <4.8+                     , bytestring >=0.10+                     , exceptions >=0.5+                     , http-client >=0.4+                     , http-client-tls >=0.2+                     , http-types >=0.8+                     , mtl >=2.1+                     , network >=2.4+                     , text >= 1.2+                     , transformers >=0.3   default-language:    Haskell2010  executable marmalade-upload   main-is:             main.hs   ghc-options:         -Wall-  build-depends:       base >=4.6 && <4.8,-                       bytestring >= 0.10,-                       aeson >= 0.7,-                       data-default >= 0.5,-                       filepath >= 1.3,-                       directory >= 1.2,-                       transformers >=0.3,-                       optparse-applicative >=0.8,-                       keyring >=0.1,-                       marmalade-upload+  build-depends:       aeson >= 0.7+                     , base >=4.6 && <4.8+                     , bytestring >= 0.10+                     , data-default >= 0.5+                     , directory >= 1.2+                     , filepath >= 1.3+                     , keyring >=0.1+                     , marmalade-upload+                     , optparse-applicative >=0.8+                     , text >= 1.2+                     , transformers >=0.3   default-language:    Haskell2010 +executable build+  main-is:             build.hs+  ghc-options:         -Wall+  build-depends:       Cabal >= 1.18+                     , base >=4.6 && <4.8+                     , bytestring >= 0.10+                     , data-default >= 0.5+                     , directory >= 1.2+                     , process >= 1.2+                     , shake >= 0.13+                     , split >= 0.2+                     , text >= 1.2+                     , zip-archive >= 0.2+  default-language:    Haskell2010+  if flag(Development)+    buildable:         True+  else+    buildable:         False+ test-suite marmalade   type:                exitcode-stdio-1.0   main-is:             marmalade-tests.hs   hs-source-dirs:      test/-  build-depends:       base >=4.6 && < 4.8,-                       transformers >=0.3,-                       exceptions >=0.5,-                       aeson >=0.7,-                       tasty >=0.8,-                       tasty-hunit >=0.8,-                       marmalade-upload+  build-depends:       aeson >=0.7+                     , base >=4.6 && < 4.8+                     , exceptions >=0.5+                     , marmalade-upload+                     , tasty >=0.8+                     , tasty-hunit >=0.8+                     , text >= 1.2+                     , transformers >=0.3   default-language:    Haskell2010   ghc-options:         -Wall

@@ -40,26 +40,29 @@        )        where +import           Control.Applicative (Applicative,(<$>))+import           Control.Exception (Exception)+import           Control.Monad (liftM,mzero)+import           Control.Monad.Catch (MonadThrow,MonadCatch,throwM)+import           Control.Monad.IO.Class (MonadIO,liftIO)+import           Control.Monad.State (StateT,MonadState,evalStateT,get,gets,put)+import           Data.Aeson (FromJSON,Value(Object),(.:)) import qualified Data.Aeson as JSON-import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.ByteString.Lazy.UTF8 as UTF8L+import           Data.ByteString.Lazy (ByteString)+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Encoding as L+import           Data.Typeable (Typeable) import qualified Network as N+import           Network.HTTP.Client (Manager,Request,Response) import qualified Network.HTTP.Client as C--import Control.Applicative (Applicative,(<$>))-import Control.Exception (Exception)-import Control.Monad (liftM,mzero)-import Control.Monad.Catch (MonadThrow,MonadCatch,throwM)-import Control.Monad.IO.Class (MonadIO,liftIO)-import Control.Monad.State (StateT,MonadState,evalStateT,get,gets,put)-import Data.Aeson (FromJSON,Value(Object),(.:))-import Data.ByteString.Lazy (ByteString)-import Data.Typeable (Typeable)-import Network.HTTP.Client (Manager,Request,Response)-import Network.HTTP.Client.MultipartFormData-import Network.HTTP.Types.Header (hUserAgent,hAccept)-import Network.HTTP.Types.Status (Status(statusCode,statusMessage))-import Text.Printf (printf)+import           Network.HTTP.Client.TLS (tlsManagerSettings)+import           Network.HTTP.Client.MultipartFormData+import           Network.HTTP.Types.Header (hUserAgent,hAccept)+import           Network.HTTP.Types.Status (Status(statusCode,statusMessage))+import           Text.Printf (printf)  -- |The Marmalade monad. --@@ -78,14 +81,14 @@ -- -- Marmalade requires a token to access most of its API, however clients can -- "login" with a username and a password to obtain their token.-runMarmalade :: String          -- ^The user agent sent to Marmalade+runMarmalade :: Text            -- ^The user agent sent to Marmalade              -> Auth            -- ^The authentication information              -> Marmalade a     -- ^The actions to run              -> IO a              -- ^The result of the actions, or any error thrown in the course of              -- running the actions. runMarmalade userAgent auth action =-  N.withSocketsDo $ C.withManager C.defaultManagerSettings doIt+  N.withSocketsDo $ C.withManager tlsManagerSettings doIt   where doIt manager = runMarmaladeWithManager userAgent auth manager action  -- |@'runMarmaladeWithManager userAgent auth manager actions'@ runs @actions@@@ -93,7 +96,7 @@ -- -- Like @'runMarmalade'@, except that it lets you use your own connection -- manager.-runMarmaladeWithManager :: String -- ^The user agent sent to Marmalade+runMarmaladeWithManager :: Text   -- ^The user agent sent to Marmalade                         -> Auth   -- ^The authentication information                         -> Manager     -- ^The connection manager                         -> Marmalade a -- ^The actions to run@@ -109,50 +112,51 @@ -- |The internal state of the @'Marmalade'@ monad. data MarmaladeState = MarmaladeState                       { marmaladeAuth :: Auth-                      , marmaladeUserAgent :: String+                      , marmaladeUserAgent :: Text                       , marmaladeManager :: Manager }  -- |Errors thrown by Marmalade.-data MarmaladeError = MarmaladeInvalidResponseStatus Status String+data MarmaladeError = MarmaladeInvalidResponseStatus Status L.Text                       -- ^An invalid response from Marmalade, with a status and                       -- probably an error message from Marmalade.                     | MarmaladeInvalidResponseBody ByteString                       -- ^Invalid response body-                    | MarmaladeBadRequest String+                    | MarmaladeBadRequest L.Text                       -- ^A bad request error from Marmalade.                       --                       -- Marmalade raises this error for failed logins and for                       -- uploads of invalid packages (e.g. files without a                       -- version header)-                    | MarmaladeInvalidPackage FilePath String+                    | MarmaladeInvalidPackage FilePath L.Text                       -- ^An invalid package file, with a corresponding error                       -- message.                       deriving Typeable  instance Show MarmaladeError where   show (MarmaladeInvalidResponseStatus status message) =-    printf "Marmalade error: Invalid response status: %s (%s)" msgString message-    where msgString = UTF8.toString (statusMessage status)+    printf "Marmalade error: Invalid response status: %s (%s)"+           msgString (L.unpack message)+    where msgString = T.unpack (T.decodeUtf8 (statusMessage status))   show (MarmaladeInvalidResponseBody s) =     "Marmalade error: Invalid response body: " ++ show s   show (MarmaladeBadRequest message) =-    "Marmalade error: Bad Request: " ++ message+    "Marmalade error: Bad Request: " ++ L.unpack message   show (MarmaladeInvalidPackage f m) =-    printf "Marmalade error: %s: invalid package: %s" f m+    printf "Marmalade error: %s: invalid package: %s" f (L.unpack m)  instance Exception MarmaladeError  -- |The name of a user-newtype Username = Username String deriving (Show, Eq)+newtype Username = Username Text deriving (Show, Eq) -- |An authentication token.-newtype Token = Token String deriving (Show, Eq)+newtype Token = Token Text deriving (Show, Eq)  instance FromJSON Token where   parseJSON (Object o) = Token <$> (o .: "token")   parseJSON _          = mzero  -- |Authentication information for Marmalade.-data Auth = BasicAuth Username (Marmalade String)+data Auth = BasicAuth Username (Marmalade Text)             -- ^Authentication with a username and an action that returns a             -- password to use           | TokenAuth Username Token@@ -175,13 +179,13 @@   where doLogin (Username username) getPassword = do           manager <- gets marmaladeManager           password <- getPassword-          request <- liftM (C.urlEncodedBody [("name", UTF8.fromString username)-                                             ,("password", UTF8.fromString password)])-                     (makeRequest "/v1/users/login")-          response <- liftIO $ C.httpLbs request manager+          let body = C.urlEncodedBody [ ("name", T.encodeUtf8 username)+                                      , ("password", T.encodeUtf8 password) ]+          request <- liftM body (makeRequest "/v1/users/login")+          response <- liftIO (C.httpLbs request manager)           parseResponse response -newtype Message = Message { messageContents :: String }+newtype Message = Message { messageContents :: L.Text }  instance FromJSON Message where   parseJSON (Object o) = Message <$> (o .: "message")@@ -189,7 +193,7 @@  -- |The result of an upload. newtype Upload = Upload-                 { uploadMessage :: String -- ^The message from Marmalade+                 { uploadMessage :: L.Text -- ^The message from Marmalade                  }  instance FromJSON Upload where@@ -198,7 +202,7 @@  -- |The base URL of Marmalade. marmaladeURL :: String-marmaladeURL = "http://marmalade-repo.org"+marmaladeURL = "https://marmalade-repo.org"  -- |@'makeRequest' endpoint@ creates a request to @endpoint@. --@@ -209,7 +213,7 @@ makeRequest endpoint = do   initReq <- C.parseUrl (marmaladeURL ++ endpoint)   userAgent <- gets marmaladeUserAgent-  return initReq { C.requestHeaders = [(hUserAgent, UTF8.fromString userAgent)+  return initReq { C.requestHeaders = [(hUserAgent, T.encodeUtf8 userAgent)                                       ,(hAccept, "application/json")]                  -- We keep every bad status, because we handle these later                  , C.checkStatus = \_ _ _ -> Nothing@@ -227,7 +231,7 @@     _ -> throwM (MarmaladeInvalidResponseStatus status message)   where body = C.responseBody response         status = C.responseStatus response-        message = maybe (UTF8L.toString body)+        message = maybe (L.decodeUtf8 body)                         messageContents (JSON.decode' body)  -- |@'uploadPackage' package@ uploads a @package@ file to Marmalade.@@ -239,8 +243,8 @@   (Username username, Token token) <- login   manager <- gets marmaladeManager   request <- makeRequest "/v1/packages" >>=-             formDataBody [partBS "name" (UTF8.fromString username)-                          ,partBS "token" (UTF8.fromString token)-                          ,partFileSource "package" packageFile]+             formDataBody [ partBS "name" (T.encodeUtf8 username)+                          , partBS "token" (T.encodeUtf8 token)+                          , partFileSource "package" packageFile]   response <- liftIO (C.httpLbs request manager)   parseResponse response

@@ -20,19 +20,20 @@  {-# LANGUAGE OverloadedStrings #-} -import Paths_marmalade_upload (version)-import Web.Marmalade-+import           Control.Exception (handle,handleJust) import qualified Data.Aeson as JSON-import Control.Exception (handle,handleJust)-import Data.Version (showVersion)-import System.IO.Error (isDoesNotExistError,ioeGetFileName)--import Test.Tasty-import Test.Tasty.HUnit+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Version (showVersion)+import           Paths_marmalade_upload (version)+import           System.IO.Error (isDoesNotExistError,ioeGetFileName)+import           Test.Tasty+import           Test.Tasty.HUnit+import           Web.Marmalade -testUserAgent :: String-testUserAgent = "marmalade-upload-tests/" ++ showVersion version+testUserAgent :: Text+testUserAgent = T.concat [ "marmalade-upload-tests/"+                         , T.pack (showVersion version) ]  testAuth :: Auth testAuth = TokenAuth (Username "marmalade-upload-test-user") (Token "test-token")