Pay back some test-debt

This commit is contained in:
Julian K. Arni 2015-04-06 16:43:36 +02:00
parent 622c77251e
commit fed014e120

View File

@ -17,7 +17,8 @@ import Data.String (fromString)
import Data.String.Conversions (cs)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.HTTP.Types (hContentType, methodDelete,
import Network.HTTP.Types (hAccept, hContentType,
methodDelete, methodGet,
methodPatch, methodPost, methodPut,
ok200, parseQuery, status409)
import Network.Wai (Application, Request, pathInfo,
@ -43,7 +44,7 @@ import Servant.Server.Internal (RouteMismatch (..))
data Person = Person {
name :: String,
age :: Integer
age :: Integer
}
deriving (Eq, Show, Generic)
@ -54,7 +55,7 @@ alice :: Person
alice = Person "Alice" 42
data Animal = Animal {
species :: String,
species :: String,
numberOfLegs :: Integer
}
deriving (Eq, Show, Generic)
@ -99,10 +100,13 @@ captureSpec :: Spec
captureSpec = do
describe "Servant.API.Capture" $ do
with (return (serve captureApi captureServer)) $ do
it "can capture parts of the 'pathInfo'" $ do
response <- get "/2"
liftIO $ do
decode' (simpleBody response) `shouldBe` Just tweety
liftIO $ decode' (simpleBody response) `shouldBe` Just tweety
it "returns 404 if the decoding fails" $ do
get "/notAnInt" `shouldRespondWith` 404
with (return (serve
(Proxy :: Proxy (Capture "captured" String :> Raw))
@ -122,18 +126,23 @@ getSpec = do
describe "Servant.API.Get" $ do
let server = return alice :<|> return ()
with (return $ serve getApi server) $ do
it "allows to GET a Person" $ do
response <- get "/"
return response `shouldRespondWith` 200
liftIO $ do
decode' (simpleBody response) `shouldBe` Just alice
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
it "throws 405 (wrong method) on POSTs" $ do
post "/" "" `shouldRespondWith` 405
post "/empty" "" `shouldRespondWith` 405
it "returns 204 if the type is '()'" $ do
get "empty" `shouldRespondWith` ""{ matchStatus = 204 }
it "returns 415 if the Accept header is not supported" $ do
Test.Hspec.Wai.request methodGet "" [(hAccept, "crazy/mime")] ""
`shouldRespondWith` 415
type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
@ -486,6 +495,9 @@ type AlternativeApi =
"foo" :> Get '[JSON] Person
:<|> "bar" :> Get '[JSON] Animal
:<|> "foo" :> Get '[PlainText] T.Text
:<|> "bar" :> Post '[JSON] Animal
:<|> "bar" :> Put '[JSON] Animal
:<|> "bar" :> Delete
unionApi :: Proxy AlternativeApi
unionApi = Proxy
@ -494,11 +506,15 @@ unionServer =
return alice
:<|> return jerry
:<|> return "a string"
:<|> return jerry
:<|> return jerry
:<|> return ()
unionSpec :: Spec
unionSpec = do
describe "Servant.API.Alternative" $ do
with (return $ serve unionApi unionServer) $ do
it "unions endpoints" $ do
response <- get "/foo"
liftIO $ do
@ -508,9 +524,13 @@ unionSpec = do
liftIO $ do
decode' (simpleBody response_) `shouldBe`
Just jerry
it "checks all endpoints before returning 406" $ do
it "checks all endpoints before returning 415" $ do
get "/foo" `shouldRespondWith` 200
it "returns 404 if the path does not exist" $ do
get "/nonexistent" `shouldRespondWith` 404
-- | Test server error functionality.
errorsSpec :: Spec
errorsSpec = do