diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +0.10 (Oct 26, 2014) +=================== + +- Use TLS to connect to Marmalade + 0.9 (Jul 8, 2014) ================= diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 ----- diff --git a/build.hs b/build.hs new file mode 100644 --- /dev/null +++ b/build.hs @@ -0,0 +1,144 @@ +#!/usr/bin/env runhaskell +-- Copyright (c) 2014 Sebastian Wiesner + +-- 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 diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -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) diff --git a/marmalade-upload.cabal b/marmalade-upload.cabal --- a/marmalade-upload.cabal +++ b/marmalade-upload.cabal @@ -1,5 +1,5 @@ name: marmalade-upload -version: 0.9 +version: 0.10 synopsis: Upload packages to Marmalade description: Upload Emacs packages to the 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 diff --git a/src/Web/Marmalade.hs b/src/Web/Marmalade.hs --- a/src/Web/Marmalade.hs +++ b/src/Web/Marmalade.hs @@ -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 diff --git a/test/marmalade-tests.hs b/test/marmalade-tests.hs --- a/test/marmalade-tests.hs +++ b/test/marmalade-tests.hs @@ -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")