marmalade-upload 0.5.2 → 0.6
raw patch · 13 files changed
+788/−359 lines, 13 filesdep +deepseqdep +exceptionsdep +marmalade-uploaddep −cmdargsdep −failuredep −http-client-multipartdep ~http-clientbinary-added
Dependencies added: deepseq, exceptions, marmalade-upload, optparse-applicative, tasty, tasty-hunit, unix
Dependencies removed: cmdargs, failure, http-client-multipart
Dependency ranges changed: http-client
Files
- CHANGES.md +9/−0
- README.md +11/−3
- System/IO/Magic.hs +0/−45
- Web/Marmalade.hs +0/−268
- main.hs +38/−30
- marmalade-upload.cabal +60/−13
- src/Web/Marmalade.hs +266/−0
- src/Web/Marmalade/Magic.hs +121/−0
- src/Web/Marmalade/Magic/Native.hsc +50/−0
- test/magic-tests.hs +60/−0
- test/marmalade-tests.hs +123/−0
- test/resources/foo.el +50/−0
- test/resources/foo.tar binary
CHANGES.md view
@@ -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) ====================
README.md view
@@ -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`.
− System/IO/Magic.hs
@@ -1,45 +0,0 @@--- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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 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]
− Web/Marmalade.hs
@@ -1,268 +0,0 @@--- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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 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
main.hs view
@@ -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."
marmalade-upload.cabal view
@@ -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 <http://marmalade-repo.org/ Marmalade> 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
+ src/Web/Marmalade.hs view
@@ -0,0 +1,266 @@+-- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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 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
+ src/Web/Marmalade/Magic.hs view
@@ -0,0 +1,121 @@+-- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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 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
+ src/Web/Marmalade/Magic/Native.hsc view
@@ -0,0 +1,50 @@+-- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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 ForeignFunctionInterface #-}++module Web.Marmalade.Magic.Native where++#include <magic.h>++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
+ test/magic-tests.hs view
@@ -0,0 +1,60 @@+-- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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.++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
+ test/marmalade-tests.hs view
@@ -0,0 +1,123 @@+-- Copyright (c) 2014 Sebastian Wiesner <lunaryorn@gmail.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 #-}++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
+ test/resources/foo.el view
@@ -0,0 +1,50 @@+;;; foo.el --- marmalade-upload test dummy -*- lexical-binding: t; -*-++;; Copyright (C) 2014 Sebastian Wiesner++;; Author: Sebastian Wiesner <lunaryorn@gmail.com>+;; 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 <http://www.gnu.org/licenses/>.++;;; Commentary:++;;; Code:++(defun foo ()+ (message "FOO"))++(provide 'foo)++;;; foo.el ends here
+ test/resources/foo.tar view
binary file changed (absent → 4096 bytes)