marmalade-upload-0.6: test/marmalade-tests.hs

-- 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