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

-- Copyright (c) 2014 Sebastian Wiesner <swiesner@lunaryorn.com>

-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:

-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.

{-# LANGUAGE OverloadedStrings #-}

import Paths_marmalade_upload (version)
import Web.Marmalade

import qualified Data.Aeson as JSON
import Control.Exception (handle,handleJust)
import Data.Version (showVersion)
import System.IO.Error (isDoesNotExistError,ioeGetFileName)

import Test.Tasty
import Test.Tasty.HUnit

testUserAgent :: String
testUserAgent = "marmalade-upload-tests/" ++ showVersion version

testAuth :: Auth
testAuth = TokenAuth (Username "marmalade-upload-test-user") (Token "test-token")

runMarmaladeTest :: Marmalade a -> IO a
runMarmaladeTest = runMarmalade testUserAgent testAuth

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) <- runMarmaladeTest login
  username @?= "marmalade-upload-test-user"
  token @?= "test-token"

invalidUsernameAndPassword :: TestTree
invalidUsernameAndPassword =
  testCase "Invalid username and password" $
  handleJust badRequest assertMessage $ do
    _ <- runMarmalade testUserAgent auth login
    assertFailure "Expected MarmaladeBadRequest not thrown"
  where
    auth = BasicAuth (Username "marmalade-upload-test-user") (return "test-password")
    badRequest (MarmaladeBadRequest msg) = Just msg
    badRequest _ = Nothing
    assertMessage msg = msg @?= "bad authentication"

uploadNonExistingPackage :: TestTree
uploadNonExistingPackage =
  testCase "Package file does not exist" $
  handle assertDoesNotExistError $ do
    _ <- runMarmaladeTest (uploadPackage fileName)
    assertFailure "Expected IOError not thrown"
  where
    fileName = "/this-file-does-not-exist"
    assertDoesNotExistError err = do
      isDoesNotExistError err @? ("Unexpected error type: " ++ show err)
      ioeGetFileName err @?= Just fileName

tests :: TestTree
tests = testGroup "Marmalade API"
        [
          testGroup "JSON decoding" [ decodeToken
                                    , decodeMessage
                                    , decodeUpload ]
        , testGroup "login" [ loginWithToken
                            , invalidUsernameAndPassword ]
        , testGroup "upload" [ uploadNonExistingPackage ]
        ]

main :: IO ()
main = defaultMain tests