diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,12 @@ +0.6 (Apr 21, 2014) +================== + +- Update to http-client 0.3 +- Replace failure with exceptions +- Build against libmagic for mimetype detection +- Replace cmdArgs with optparse-applicative +- Add unit tests + 0.5.2 (Apr 12, 2014) ==================== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ marmalade-upload ================ -[![travis][badge-travis]][travis] -[![hackage][badge-hackage]][hackage] -[![license][badge-license]][license] +[![Available on Hackage][badge-hackage]][hackage] +[![License MIT][badge-license]][license] +[![Build Status][badge-travis]][travis] Haskell tool to upload packages to the Emacs package archive [Marmalade][], published in the hopes @@ -23,6 +23,14 @@ ```console $ cabal install marmalade-upload +``` + +**OS X**: If this command fails on OS X, either install libmagic with `brew +install libmagic` or use: + + +```console +$ cabal install -f '-libmagic' marmalade-upload ``` Don't forget to add `~/.cabal/bin` to `$PATH`. diff --git a/System/IO/Magic.hs b/System/IO/Magic.hs deleted file mode 100644 --- a/System/IO/Magic.hs +++ /dev/null @@ -1,45 +0,0 @@ --- 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 DeriveDataTypeable #-} - --- |Guess the file type of files. -module System.IO.Magic where - -import Control.Exception (Exception,throwIO) -import Data.Typeable (Typeable) -import System.Exit(ExitCode(..)) -import System.Process (readProcessWithExitCode) - -newtype MagicException = MagicException String - deriving Typeable - -instance Show MagicException where - show (MagicException message) = message - -instance Exception MagicException - -guessMimeType :: FilePath -> IO String -guessMimeType fileName = do - (status, stdout, stderr) <- readProcessWithExitCode "file" args [] - case status of - ExitFailure _ -> throwIO (MagicException (stdout ++ stderr)) - ExitSuccess -> return (head (lines stdout)) - where args = ["--brief", "--mime-type", fileName] diff --git a/Web/Marmalade.hs b/Web/Marmalade.hs deleted file mode 100644 --- a/Web/Marmalade.hs +++ /dev/null @@ -1,268 +0,0 @@ --- 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 FlexibleContexts #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE MultiParamTypeClasses #-} - --- |Access to the API of Marmalade -module Web.Marmalade - ( - -- * The Marmalade Monad - Marmalade, runMarmalade,runMarmaladeWithManager - -- * Error handling - , MarmaladeError(..) - -- * Authentication - , Username(..), Token(..), Auth(..), login - -- * Package uploads - , verifyPackage,uploadPackage,Upload(..) - ) - where - -import qualified System.IO.Magic as Magic - -import qualified Data.Aeson as JSON -import qualified Data.ByteString.UTF8 as UTF8 -import qualified Network as N -import qualified Network.HTTP.Client as C - -import Control.Applicative (Applicative,(<$>)) -import Control.Exception (Exception,throwIO) -import Control.Failure (Failure(..)) -import Control.Monad (liftM,mzero,unless) -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,HttpException,Request,Response) -import Network.HTTP.Client.MultipartFormData -import Network.HTTP.Types.Header (hUserAgent) -import Network.HTTP.Types.Status (Status(statusCode,statusMessage)) -import Text.Printf (printf) - --- |The Marmalade monad. --- --- This monad provides access to the Marmalade API. -newtype Marmalade a = - Marmalade { runM :: StateT MarmaladeState IO a } - deriving (Monad,Applicative,MonadIO,Functor - ,MonadState MarmaladeState) - -instance Failure HttpException Marmalade where - failure = throwMarmalade - --- |@'runMarmalade' userAgent auth actions@ runs @actions@. --- --- @userAgent@ is sent as @User-Agent@ header to Marmalade, and @auth@ is the --- authentication information. --- --- 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 - -> 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 - where doIt manager = runMarmaladeWithManager userAgent auth manager action - --- |@'runMarmaladeWithManager userAgent auth manager actions'@ runs @actions@ --- with the given connection @manager@. --- --- Like @'runMarmalade'@, except that it lets you use your own connection --- manager. -runMarmaladeWithManager :: String -- ^The user agent sent to Marmalade - -> Auth -- ^The authentication information - -> Manager -- ^The connection manager - -> Marmalade a -- ^The actions to run - -> IO a - -- ^The result of the actions, or any error thrown in - -- the course of running the actions. -runMarmaladeWithManager userAgent auth manager action = - evalStateT (runM action) state - where state = MarmaladeState { marmaladeAuth = auth - , marmaladeUserAgent = userAgent - , marmaladeManager = manager} - --- |The internal state of the @'Marmalade'@ monad. -data MarmaladeState = MarmaladeState - { marmaladeAuth :: Auth - , marmaladeUserAgent :: String - , marmaladeManager :: Manager } - --- |Errors thrown by Marmalade. -data MarmaladeError = MarmaladeInvalidResponseStatus Status (Maybe String) - -- ^An invalid response from Marmalade, with a status and - -- probably an error message from Marmalade. - | MarmaladeInvalidResponseBody ByteString - -- ^Invalid response body - | MarmaladeBadRequest (Maybe String) - -- ^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 - -- ^An invalid package file, with a corresponding error - -- message. - deriving Typeable - -instance Show MarmaladeError where - show (MarmaladeInvalidResponseStatus status (Just message)) = - printf "Marmalade error: Invalid response status: %s (%s)" msgString message - where msgString = UTF8.toString (statusMessage status) - show (MarmaladeInvalidResponseStatus status Nothing) = - printf "Marmalade error: Invalid response status: %s" msgString - where msgString = UTF8.toString (statusMessage status) - show (MarmaladeInvalidResponseBody s) = - "Marmalade error: Invalid response body: " ++ show s - show (MarmaladeBadRequest (Just message)) = - "Marmalade error: Bad Request: " ++ message - show (MarmaladeBadRequest Nothing) = "Marmalade error: Bad Request" - show (MarmaladeInvalidPackage f m) = - printf "Marmalade error: %s: invalid package: %s" f m - -instance Exception MarmaladeError - -throwMarmalade :: Exception e => e -> Marmalade a -throwMarmalade = liftIO.throwIO - --- |The name of a user -newtype Username = Username String deriving (Show, Eq) --- |An authentication token. -newtype Token = Token String 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) - -- ^Authentication with a username and an action that returns a - -- password to use - | TokenAuth Username Token - -- ^Authentication with a username and a login token - --- |@'login'@ logs in to Marmalade to obtain the client's access token. --- --- If the monad already uses token authentication this function is a no-op and --- merely returns the stored token. Otherwise it sends a login request to --- Marmalade to obtain the token and stores the token in the monad. -login :: Marmalade (Username, Token) -login = do - state <- get - case marmaladeAuth state of - BasicAuth username getPassword -> do - token <- doLogin username getPassword - put state { marmaladeAuth = TokenAuth username token } - return (username, token) - TokenAuth username token -> return (username, token) - 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 - parseResponse response - -newtype Message = Message { messageContents :: String } - -instance FromJSON Message where - parseJSON (Object o) = Message <$> (o .: "message") - parseJSON _ = mzero - --- |The result of an upload. -newtype Upload = Upload - { uploadMessage :: String -- ^The message from Marmalade - } - -instance FromJSON Upload where - parseJSON (Object o) = Upload <$> (o .: "message") - parseJSON _ = mzero - --- |The base URL of Marmalade. -marmaladeURL :: String -marmaladeURL = "http://marmalade-repo.org" - --- |@'makeRequest' endpoint@ creates a request to @endpoint@. --- --- Responses to requests created by this function do not throw 'HTTPException' --- for non-200 responses. Use @'parseResponse'@ to turn such response into --- @'MarmaladeError'@s. -makeRequest :: String -> Marmalade Request -makeRequest endpoint = do - initReq <- C.parseUrl (marmaladeURL ++ endpoint) - userAgent <- gets marmaladeUserAgent - return initReq { C.requestHeaders = [(hUserAgent, UTF8.fromString userAgent)] - -- We keep every bad status, because we handle these later - , C.checkStatus = \_ _ _ -> Nothing - } - --- |@'parseResponse' response@ parses the JSON body of @response@, or throws an --- error for unexpected responses or invalid JSON bodies. -parseResponse :: FromJSON c => Response ByteString -> Marmalade c -parseResponse response = - case statusCode status of - 200 -> case JSON.decode body of - Just o -> return o - Nothing -> throwMarmalade (MarmaladeInvalidResponseBody body) - 400 -> throwMarmalade (MarmaladeBadRequest message) - _ -> throwMarmalade (MarmaladeInvalidResponseStatus status message) - where body = C.responseBody response - status = C.responseStatus response - message = fmap messageContents (JSON.decode body) - --- |Permitted package mimetypes. -packageMimeTypes :: [String] -packageMimeTypes = ["application/x-tar", "text/x-lisp"] - --- |@'verifyPackage' package@ checks whether @package@ is a valid package --- object. --- --- Throw an error if @package@ does not exist, or is not a valid package. -verifyPackage :: String -> Marmalade () -verifyPackage packageFile = do - -- Force early failure if the package doesn't exist - mimeType <- liftIO (Magic.guessMimeType packageFile) - unless (mimeType `elem` packageMimeTypes) - (throwMarmalade (MarmaladeInvalidPackage packageFile - (printf "invalid mimetype %s" mimeType))) - --- |@'uploadPackage' package@ uploads a @package@ file to Marmalade. --- --- Return the result of the upload, or throw an error if @package@ is not a --- valid package, or if Marmalade refused to accept the upload. -uploadPackage :: FilePath -> Marmalade Upload -uploadPackage packageFile = do - verifyPackage packageFile - (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] - response <- liftIO (C.httpLbs request manager) - parseResponse response diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -18,23 +18,22 @@ -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -- THE SOFTWARE. -{-# LANGUAGE DeriveDataTypeable #-} - module Main where import qualified System.Keyring as K import Web.Marmalade -import qualified System.Environment as Env import qualified System.IO as IO -import qualified System.Console.CmdArgs as Args import Control.Exception (SomeException,bracket,handle) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Data.Version (showVersion) -import System.Console.CmdArgs (Data,Typeable,(&=),cmdArgs) -import System.Exit (ExitCode(ExitFailure),exitWith) +import Options.Applicative (Parser,execParser, + info,fullDesc,progDesc, + helper,argument,flag',long,short,str,metavar,help, + (<|>),(<$>),(<>),(<*>)) +import System.Exit (ExitCode(ExitFailure),exitWith,exitSuccess) import System.IO (hPutStrLn,stderr) import Text.Printf (printf) @@ -113,31 +112,40 @@ exitException :: SomeException -> IO () exitException = exitFailure.show -data Arguments = Arguments { argUsername :: String - , argPackageFile :: String} - deriving (Show, Data, Typeable) +data UploadArguments = UploadArguments { argUsername :: String + , argPackageFile :: String } -arguments :: IO Arguments -arguments = do - programName <- Env.getProgName - return $ Arguments { argUsername = Args.def &= Args.argPos 0 - &= Args.typ "USERNAME" - , argPackageFile = Args.def &= Args.argPos 1 - &= Args.typ "PACKAGE" } - &= Args.summary (printf "%s %s" programName appVersion) - &= Args.help "Upload a PACKAGE to Marmalade." - &= Args.details ["Copyright (C) 2014 Sebastian Wiesner" - ,"Distributed under the terms of the MIT/X11 license."] - &= Args.program programName +data Arguments = ShowVersion | + UploadPackage UploadArguments +arguments :: Parser Arguments +arguments = flag' ShowVersion (long "version" <> + short 'V' <> + help "Show version number and exit") <|> + (UploadPackage <$> uploadArguments) + where + uploadArguments = UploadArguments <$> + argument str (metavar "USERNAME" <> help "Marmalade username") <*> + argument str (metavar "PACKAGE" <> help "Package file") + main :: IO () main = do - args <- arguments >>= cmdArgs - (shallSaveToken, auth) <- getAuth (argUsername args) - handle exitException $ runMarmalade appUserAgent auth $ do - (Username username, Token token) <- login - -- Save the token now - when shallSaveToken $ - liftIO (K.setPassword (K.Service appService) (K.Username username) (K.Password token)) - upload <- uploadPackage (argPackageFile args) - liftIO (putStrLn (uploadMessage upload)) + args <- execParser (info (helper <*> arguments) + (fullDesc <> progDesc "Upload a package to Marmalade")) + processArguments args + where + processArguments ShowVersion = putVersion >> exitSuccess + processArguments (UploadPackage uploadArgs) = do + (shallSaveToken, auth) <- getAuth (argUsername uploadArgs) + handle exitException $ runMarmalade appUserAgent auth $ do + (Username username, Token token) <- login + -- Save the token now + when shallSaveToken $ + liftIO (K.setPassword (K.Service appService) (K.Username username) (K.Password token)) + upload <- uploadPackage (argPackageFile uploadArgs) + liftIO (putStrLn (uploadMessage upload)) + putVersion = do + putStrLn (appName ++ " " ++ appVersion) + putStrLn "Copyright (C) 2014 Sebastian Wiesner." + putStrLn "You may redistribute marmalade-upload" + putStrLn "under the terms of the MIT/X11 license." 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.5.2 +version: 0.6 synopsis: Upload packages to Marmalade description: Upload Emacs packages to the ELPA @@ -8,7 +8,9 @@ license: MIT license-file: LICENSE extra-source-files: README.md, - CHANGES.md + CHANGES.md, + test/resources/foo.el, + test/resources/foo.tar author: Sebastian Wiesner maintainer: lunaryorn@gmail.com copyright: (C) 2014 Sebastian Wiesner @@ -25,25 +27,70 @@ source-repository this type: git location: https://github.com/lunaryorn/marmalade-upload.git - tag: 0.5.2 + tag: 0.6 -executable marmalade-upload - main-is: main.hs - other-modules: Web.Marmalade - System.IO.Magic +flag LibMagic + description: Use libmagic to determine the mimetypes of packages + default: True + +library + hs-source-dirs: src/ + exposed-modules: Web.Marmalade + Web.Marmalade.Magic ghc-options: -Wall build-depends: base >=4.6 && <4.8, mtl >=2.1 && <2.2, transformers >=0.3 && <0.4, - failure >=0.2 && <0.3, + exceptions >=0.5 && <0.6, bytestring >=0.10 && <1.11, utf8-string >=0.3 && <0.4, - process >=1.1 && <1.3, - cmdargs >=0.10 && <0.11, aeson >=0.7 && <0.8, network >=2.4 && <2.5, http-types >=0.8 && <0.9, - http-client >=0.2 && <0.3, - http-client-multipart >=0.2 && <0.3, - keyring >=0.1 && <0.2 + http-client >=0.3 && <0.4 default-language: Haskell2010 + + if flag(LibMagic) + build-tools: hsc2hs + build-depends: unix >=2.6 && <2.8 + extra-libraries: magic + cpp-options: -DWITH_LIBMAGIC + other-modules: Web.Marmalade.Magic.Native + else + build-depends: process >=1.1 && <1.3, + deepseq >=1.3 && <1.4 + +executable marmalade-upload + main-is: main.hs + ghc-options: -Wall + build-depends: base >=4.6 && <4.8, + transformers >=0.3 && <0.4, + optparse-applicative >=0.8 && <0.9, + keyring >=0.1 && <0.2, + marmalade-upload + default-language: Haskell2010 + +test-suite magic + type: exitcode-stdio-1.0 + main-is: magic-tests.hs + hs-source-dirs: test/ + build-depends: base >=4.6 && <4.8, + tasty >=0.8 && <0.9, + tasty-hunit >= 0.8 && <0.9, + marmalade-upload + default-language: Haskell2010 + ghc-options: -Wall + +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 && <0.4, + exceptions >=0.5 && <0.6, + aeson >=0.7 && <0.8, + tasty >=0.8 && <0.9, + tasty-hunit >=0.8 && <0.9, + marmalade-upload + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Web/Marmalade.hs b/src/Web/Marmalade.hs new file mode 100644 --- /dev/null +++ b/src/Web/Marmalade.hs @@ -0,0 +1,266 @@ +-- 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 FlexibleContexts #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +-- |Access to the API of Marmalade +module Web.Marmalade + ( + -- * The Marmalade Monad + Marmalade, runMarmalade,runMarmaladeWithManager + -- * Error handling + , MarmaladeError(..) + -- * Authentication + , Username(..), Token(..), Auth(..), login + -- * Generic types + , Message(..) + -- * Package uploads + , verifyPackage,uploadPackage,Upload(..) + ) + where + +import qualified Web.Marmalade.Magic as Magic + +import qualified Data.Aeson as JSON +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Network as N +import qualified Network.HTTP.Client as C + +import Control.Applicative (Applicative,(<$>)) +import Control.Exception (Exception) +import Control.Monad (liftM,mzero,unless) +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) +import Network.HTTP.Types.Status (Status(statusCode,statusMessage)) +import Text.Printf (printf) + +-- |The Marmalade monad. +-- +-- This monad provides access to the Marmalade API. +newtype Marmalade a = + Marmalade { runM :: StateT MarmaladeState IO a } + deriving (Applicative,Functor,Monad + ,MonadIO + ,MonadThrow,MonadCatch + ,MonadState MarmaladeState) + +-- |@'runMarmalade' userAgent auth actions@ runs @actions@. +-- +-- @userAgent@ is sent as @User-Agent@ header to Marmalade, and @auth@ is the +-- authentication information. +-- +-- 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 + -> 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 + where doIt manager = runMarmaladeWithManager userAgent auth manager action + +-- |@'runMarmaladeWithManager userAgent auth manager actions'@ runs @actions@ +-- with the given connection @manager@. +-- +-- Like @'runMarmalade'@, except that it lets you use your own connection +-- manager. +runMarmaladeWithManager :: String -- ^The user agent sent to Marmalade + -> Auth -- ^The authentication information + -> Manager -- ^The connection manager + -> Marmalade a -- ^The actions to run + -> IO a + -- ^The result of the actions, or any error thrown in + -- the course of running the actions. +runMarmaladeWithManager userAgent auth manager action = + evalStateT (runM action) state + where state = MarmaladeState { marmaladeAuth = auth + , marmaladeUserAgent = userAgent + , marmaladeManager = manager} + +-- |The internal state of the @'Marmalade'@ monad. +data MarmaladeState = MarmaladeState + { marmaladeAuth :: Auth + , marmaladeUserAgent :: String + , marmaladeManager :: Manager } + +-- |Errors thrown by Marmalade. +data MarmaladeError = MarmaladeInvalidResponseStatus Status (Maybe String) + -- ^An invalid response from Marmalade, with a status and + -- probably an error message from Marmalade. + | MarmaladeInvalidResponseBody ByteString + -- ^Invalid response body + | MarmaladeBadRequest (Maybe String) + -- ^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 + -- ^An invalid package file, with a corresponding error + -- message. + deriving Typeable + +instance Show MarmaladeError where + show (MarmaladeInvalidResponseStatus status (Just message)) = + printf "Marmalade error: Invalid response status: %s (%s)" msgString message + where msgString = UTF8.toString (statusMessage status) + show (MarmaladeInvalidResponseStatus status Nothing) = + printf "Marmalade error: Invalid response status: %s" msgString + where msgString = UTF8.toString (statusMessage status) + show (MarmaladeInvalidResponseBody s) = + "Marmalade error: Invalid response body: " ++ show s + show (MarmaladeBadRequest (Just message)) = + "Marmalade error: Bad Request: " ++ message + show (MarmaladeBadRequest Nothing) = "Marmalade error: Bad Request" + show (MarmaladeInvalidPackage f m) = + printf "Marmalade error: %s: invalid package: %s" f m + +instance Exception MarmaladeError + +-- |The name of a user +newtype Username = Username String deriving (Show, Eq) +-- |An authentication token. +newtype Token = Token String 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) + -- ^Authentication with a username and an action that returns a + -- password to use + | TokenAuth Username Token + -- ^Authentication with a username and a login token + +-- |@'login'@ logs in to Marmalade to obtain the client's access token. +-- +-- If the monad already uses token authentication this function is a no-op and +-- merely returns the stored token. Otherwise it sends a login request to +-- Marmalade to obtain the token and stores the token in the monad. +login :: Marmalade (Username, Token) +login = do + state <- get + case marmaladeAuth state of + BasicAuth username getPassword -> do + token <- doLogin username getPassword + put state { marmaladeAuth = TokenAuth username token } + return (username, token) + TokenAuth username token -> return (username, token) + 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 + parseResponse response + +newtype Message = Message { messageContents :: String } + +instance FromJSON Message where + parseJSON (Object o) = Message <$> (o .: "message") + parseJSON _ = mzero + +-- |The result of an upload. +newtype Upload = Upload + { uploadMessage :: String -- ^The message from Marmalade + } + +instance FromJSON Upload where + parseJSON (Object o) = Upload <$> (o .: "message") + parseJSON _ = mzero + +-- |The base URL of Marmalade. +marmaladeURL :: String +marmaladeURL = "http://marmalade-repo.org" + +-- |@'makeRequest' endpoint@ creates a request to @endpoint@. +-- +-- Responses to requests created by this function do not throw 'HTTPException' +-- for non-200 responses. Use @'parseResponse'@ to turn such response into +-- @'MarmaladeError'@s. +makeRequest :: String -> Marmalade Request +makeRequest endpoint = do + initReq <- C.parseUrl (marmaladeURL ++ endpoint) + userAgent <- gets marmaladeUserAgent + return initReq { C.requestHeaders = [(hUserAgent, UTF8.fromString userAgent)] + -- We keep every bad status, because we handle these later + , C.checkStatus = \_ _ _ -> Nothing + } + +-- |@'parseResponse' response@ parses the JSON body of @response@, or throws an +-- error for unexpected responses or invalid JSON bodies. +parseResponse :: FromJSON c => Response ByteString -> Marmalade c +parseResponse response = + case statusCode status of + 200 -> case JSON.decode' body of + Just o -> return o + Nothing -> throwM (MarmaladeInvalidResponseBody body) + 400 -> throwM (MarmaladeBadRequest message) + _ -> throwM (MarmaladeInvalidResponseStatus status message) + where body = C.responseBody response + status = C.responseStatus response + message = fmap messageContents (JSON.decode' body) + +-- |Permitted package mimetypes. +packageMimeTypes :: [String] +packageMimeTypes = ["application/x-tar", "text/x-lisp"] + +-- |@'verifyPackage' package@ checks whether @package@ is a valid package +-- object. +-- +-- Throw an error if @package@ does not exist, or is not a valid package. +verifyPackage :: String -> Marmalade () +verifyPackage packageFile = do + -- Force early failure if the package doesn't exist + mimeType <- liftIO (Magic.guessMimeType packageFile) + unless (mimeType `elem` packageMimeTypes) + (throwM (MarmaladeInvalidPackage packageFile + (printf "invalid mimetype %s" mimeType))) + +-- |@'uploadPackage' package@ uploads a @package@ file to Marmalade. +-- +-- Return the result of the upload, or throw an error if @package@ is not a +-- valid package, or if Marmalade refused to accept the upload. +uploadPackage :: FilePath -> Marmalade Upload +uploadPackage packageFile = do + verifyPackage packageFile + (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] + response <- liftIO (C.httpLbs request manager) + parseResponse response diff --git a/src/Web/Marmalade/Magic.hs b/src/Web/Marmalade/Magic.hs new file mode 100644 --- /dev/null +++ b/src/Web/Marmalade/Magic.hs @@ -0,0 +1,121 @@ +-- 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 CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Web.Marmalade.Magic + ( MagicException + , guessMimeType) + where + +import Control.Exception (Exception,throwIO,bracket) +import Data.Typeable (Typeable) + +#ifdef WITH_LIBMAGIC +import qualified Web.Marmalade.Magic.Native as N +import Control.Monad (when) +import Data.Bits ((.|.)) +import Foreign.C (CInt,peekCString) +import Foreign.ForeignPtr (ForeignPtr,newForeignPtr,withForeignPtr) +import Foreign.Ptr (nullPtr) +import System.IO.Error (catchIOError) +import System.Posix.IO (OpenMode(ReadOnly),openFd,closeFd,defaultFileFlags) +import System.Posix.Types (Fd(Fd)) +#else +import Control.DeepSeq (rnf) +import Control.Exception (finally,evaluate) +import System.Exit(ExitCode(..)) +import System.IO (IOMode(ReadMode),Handle,withBinaryFile,hGetContents,hClose) +import System.Process (CreateProcess(std_out,std_err,std_in), + StdStream(CreatePipe,UseHandle), + proc,createProcess,waitForProcess) +#endif + +newtype MagicException = MagicException String + deriving Typeable + +instance Show MagicException where + show (MagicException message) = message + +instance Exception MagicException + +#ifdef WITH_LIBMAGIC + +type Magic = ForeignPtr () + +magicOpen :: CInt -> IO Magic +magicOpen flags = do + raw <- N.magic_open flags + when (raw == nullPtr) (throwIO (MagicException "Failed to allocate cookie")) + newForeignPtr N.magic_close raw + +throwCurrentMagicError :: Magic -> IO a +throwCurrentMagicError magic = do + message <- withForeignPtr magic N.magic_error + if message == nullPtr + then throwIO (MagicException "Unknown error") + else peekCString message >>= throwIO.MagicException + +magicDescription :: Magic -> Fd -> IO String +magicDescription magic (Fd fd) = do + buffer <- withForeignPtr magic $ \ptr -> N.magic_descriptor ptr fd + when (buffer == nullPtr) (throwCurrentMagicError magic) + peekCString buffer + +withBinaryFileFd :: FilePath -> OpenMode -> (Fd -> IO a) -> IO a +withBinaryFileFd fileName mode = + bracket (openFd fileName mode Nothing defaultFileFlags) closeFdSafe + where + closeFdSafe fd = catchIOError (closeFd fd) (const $ return ()) + +guessMimeType :: FilePath -> IO String +guessMimeType fileName = do + cookie <- magicOpen (N.magicSymlink .|. N.magicMimeType .|. N.magicError) + withForeignPtr cookie ((flip N.magic_load) nullPtr) + withBinaryFileFd fileName ReadOnly (magicDescription cookie) + +#else + +hGuessMimeType :: Handle -> IO String +hGuessMimeType handle = + bracket (createProcess process) closeHandles $ \(_, Just oh, Just eh, proch) -> do + stdout <- hGetContents oh + stderr <- hGetContents eh + -- Force reading of the process handles + evaluate $ rnf stdout + evaluate $ rnf stderr + exitStatus <- waitForProcess proch + case exitStatus of + ExitSuccess -> return (head (lines stdout)) + ExitFailure _ -> throwIO (MagicException (stdout ++ stderr)) + where closeHandles (_, Just outh, Just errh, _) = + finally (hClose outh) (hClose errh) + closeHandles _ = return () + process = + (proc "file" ["--brief", "--mime-type", "-"]) { + std_out = CreatePipe, + std_err = CreatePipe, + std_in = UseHandle handle } + +guessMimeType :: FilePath -> IO String +guessMimeType fileName = withBinaryFile fileName ReadMode hGuessMimeType + +#endif diff --git a/src/Web/Marmalade/Magic/Native.hsc b/src/Web/Marmalade/Magic/Native.hsc new file mode 100644 --- /dev/null +++ b/src/Web/Marmalade/Magic/Native.hsc @@ -0,0 +1,50 @@ +-- 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 ForeignFunctionInterface #-} + +module Web.Marmalade.Magic.Native where + +#include + +import Foreign.C (CInt(..),CString) +import Foreign.Ptr (Ptr,FunPtr) + +#{enum CInt, , + magicSymlink = MAGIC_SYMLINK, + magicMimeType = MAGIC_MIME_TYPE, + magicError = MAGIC_ERROR} + +type Magic = Ptr () + +foreign import ccall unsafe "magic.h magic_open" + magic_open :: CInt -> IO Magic + +foreign import ccall unsafe "magic.h magic_load" + magic_load :: Magic -> CString -> IO () + +foreign import ccall unsafe "magic.h &magic_close" + magic_close :: FunPtr (Magic -> IO ()) + +foreign import ccall unsafe "magic.h magic_error" + magic_error :: Magic -> IO CString + +foreign import ccall unsafe "magic.h magic_descriptor" + magic_descriptor :: Magic -> CInt -> IO CString diff --git a/test/magic-tests.hs b/test/magic-tests.hs new file mode 100644 --- /dev/null +++ b/test/magic-tests.hs @@ -0,0 +1,60 @@ +-- 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. + +import Web.Marmalade.Magic (guessMimeType) + +import Control.Exception (handleJust) +import Control.Monad (guard) +import System.IO.Error (isDoesNotExistError) +import Test.Tasty +import Test.Tasty.HUnit + +mimeTypeOfEmacsLispFile :: TestTree +mimeTypeOfEmacsLispFile = testCase "Emacs Lisp file" $ do + mimeType <- guessMimeType "test/resources/foo.el" + mimeType @?= "text/x-lisp" + +mimeTypeOfTarFile :: TestTree +mimeTypeOfTarFile = testCase "TAR file" $ do + mimeType <- guessMimeType "test/resources/foo.tar" + mimeType @?= "application/x-tar" + +mimeTypeOfTextFile :: TestTree +mimeTypeOfTextFile = testCase "Text file" $ do + mimeType <- guessMimeType "README.md" + mimeType @?= "text/plain" + +fileDoesNotExist :: TestTree +fileDoesNotExist = testCase "File does not exist" $ + handleJust (guard.isDoesNotExistError) (const $ return ()) $ do + _ <- guessMimeType "thisFileDoesNotExist" + assertFailure "Expected IO error not thrown" + +tests :: TestTree +tests = testGroup "Mimetype guessing" + [ + mimeTypeOfEmacsLispFile + , mimeTypeOfTarFile + , mimeTypeOfTextFile + , fileDoesNotExist + ] + +main :: IO () +main = defaultMain tests diff --git a/test/marmalade-tests.hs b/test/marmalade-tests.hs new file mode 100644 --- /dev/null +++ b/test/marmalade-tests.hs @@ -0,0 +1,123 @@ +-- 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 #-} + +import Paths_marmalade_upload (version) +import Web.Marmalade + +import qualified Data.Aeson as JSON +import Control.Exception (handleJust) +import Control.Monad (guard) +import Data.Version (showVersion) +import System.IO.Error (isDoesNotExistError) + +import Test.Tasty +import Test.Tasty.HUnit + +testUserAgent :: String +testUserAgent = "marmalade-upload-tests/" ++ showVersion version + +testAuth :: Auth +testAuth = BasicAuth (Username "marmalade-upload-test-user") (return "invalid password") + +runMarmaladeTest :: Marmalade a -> IO a +runMarmaladeTest = runMarmalade testUserAgent testAuth + +verifyEmacsLispPackage :: TestTree +verifyEmacsLispPackage = testCase "Emacs Lisp package" $ runMarmaladeTest $ + verifyPackage "test/resources/foo.el" + +verifyTarPackage :: TestTree +verifyTarPackage = testCase "Tar package" $ runMarmaladeTest $ + verifyPackage "test/resources/foo.tar" + +verifyNonExistingPackage :: TestTree +verifyNonExistingPackage = + testCase "Package file does not exist" $ + handleJust (guard.isDoesNotExistError) (const $ return ()) $ do + runMarmaladeTest (verifyPackage "thisFileDoesNotExist") + assertFailure "Expected IO error not thrown" + +verifyInvalidPackage :: TestTree +verifyInvalidPackage = + testCase "Invalid package file" $ + handleJust invalidPackageMessage assertInvalidPackageMessage $ do + runMarmaladeTest (verifyPackage "README.md") + assertFailure "Expected MarmaladeError not thrown" + where + invalidPackageMessage (MarmaladeInvalidPackage _ msg) = Just msg + invalidPackageMessage _ = Nothing + assertInvalidPackageMessage msg = msg @?= "invalid mimetype text/plain" + +decodeToken :: TestTree +decodeToken = testCase "Decode Token JSON" $ + case JSON.decode' "{\"token\": \"fooBar\"}" of + Nothing -> assertFailure "Failed to parse Token JSON" + Just (Token t) -> t @?= "fooBar" + +decodeMessage :: TestTree +decodeMessage = testCase "Decode Message JSON" $ + case JSON.decode' "{\"message\": \"Hello world\"}" of + Nothing -> assertFailure "Failed to parse message JSON" + Just m -> messageContents m @?= "Hello world" + +decodeUpload :: TestTree +decodeUpload = testCase "Decode Upload JSON" $ + case JSON.decode' "{\"message\": \"Upload successful\"}" of + Nothing -> assertFailure "Failed to parse message JSON" + Just m -> uploadMessage m @?= "Upload successful" + +loginWithToken :: TestTree +loginWithToken = testCase "Login with token" $ do + (Username username, Token token) <- getLogin + username @?= "marmalade-upload-test-user" + token @?= "test-token" + where + auth = TokenAuth (Username "marmalade-upload-test-user") (Token "test-token") + getLogin = runMarmalade testUserAgent auth login + +invalidUsernameAndPassword :: TestTree +invalidUsernameAndPassword = + testCase "Invalid username and password" $ + handleJust badRequestWithMessage assertMessage $ do + _ <- runMarmaladeTest login + assertFailure "Expected MarmaladeBadRequest not thrown" + where + badRequestWithMessage (MarmaladeBadRequest msg) = msg + badRequestWithMessage _ = Nothing + assertMessage msg = msg @?= "Username or password invalid" + +tests :: TestTree +tests = testGroup "Marmalade API" + [ + testGroup "verifyPackage" [ verifyEmacsLispPackage + , verifyTarPackage + , verifyNonExistingPackage + , verifyInvalidPackage ] + , testGroup "JSON decoding" [ decodeToken + , decodeMessage + , decodeUpload ] + , testGroup "login" [ loginWithToken + , invalidUsernameAndPassword ] + ] + +main :: IO () +main = defaultMain tests diff --git a/test/resources/foo.el b/test/resources/foo.el new file mode 100644 --- /dev/null +++ b/test/resources/foo.el @@ -0,0 +1,50 @@ +;;; foo.el --- marmalade-upload test dummy -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sebastian Wiesner + +;; Author: Sebastian Wiesner +;; Package-Version: 0.1 + +;; This file is not part of GNU Emacs. + +;; 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. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(defun foo () + (message "FOO")) + +(provide 'foo) + +;;; foo.el ends here diff --git a/test/resources/foo.tar b/test/resources/foo.tar new file mode 100644 Binary files /dev/null and b/test/resources/foo.tar differ