Pay back some test-debt

test/Servant/ServerSpec.hs

@@ -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
+        liftIO $ decode' (simpleBody response) `shouldBe` Just tweety
-          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
+        liftIO $ decode' (simpleBody response) `shouldBe` Just alice
-          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