Rework Todo example, add test suite

example/example.cabal

@@ -10,35 +10,51 @@ copyright:           David Johnson (c) 2015-2016
 category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
+data-files:
+  swagger.json
 
-executable swagger-server
-  main-is: Server.hs
-  build-depends:
-                    base
+library
+  ghc-options:      -Wall
+  hs-source-dirs: src/
+  exposed-modules:
+    Todo
+  build-depends:  base
                 , aeson
-                , bytestring == 0.10.*
+                , lens
                 , servant
-                , either
                 , servant-server
                 , servant-swagger
                 , swagger2
-                , lens
-                , wai
-                , warp
+                , text
+                , time
   default-language: Haskell2010
 
-executable swagger-file
-  main-is: File.hs
-  build-depends:
-                    base
-                , aeson
-                , bytestring == 0.10.*
-                , servant
-                , swagger2
-                , either
+executable swagger-server
+  ghc-options:      -Wall
+  hs-source-dirs: server/
+  main-is: Main.hs
+  build-depends:  base
+                , example
                 , servant-server
-                , servant-swagger
-                , lens
+                , warp
+  default-language: Haskell2010
+
+test-suite swagger-server-spec
+  ghc-options:      -Wall
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          Spec.hs
+  other-modules:
+    TodoSpec
+    Paths_example
+  build-depends:    base  == 4.*
+                  , aeson
+                  , bytestring
+                  , example
+                  , hspec
+                  , servant-swagger
+                  , QuickCheck
+                  , quickcheck-instances
   default-language: Haskell2010
 
 executable readme

example/server/Main.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import Network.Wai.Handler.Warp
+import Servant
+import Todo
+
+main :: IO ()
+main = do
+  putStrLn "Running on port 8000"
+  run 8000 $ serve (Proxy :: Proxy API) server
+

example/src/Todo.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TypeOperators              #-}
+module Todo where
+
+import Control.Lens
+import Data.Aeson
+import Data.Proxy
+import Data.Text (Text)
+import Data.Time (UTCTime(..), fromGregorian)
+import Data.Typeable
+import Data.Swagger
+import GHC.Generics
+import Servant
+import Servant.Swagger
+
+todoAPI :: Proxy TodoAPI
+todoAPI = Proxy
+
+-- | The API of a Todo service.
+type TodoAPI
+    = "todo" :> Get '[JSON] [Todo]
+ :<|> "todo" :> ReqBody '[JSON] Todo :> Post '[JSON] TodoId
+ :<|> "todo" :> Capture "id" TodoId :> Get '[JSON] Todo
+ :<|> "todo" :> Capture "id" TodoId :> ReqBody '[JSON] Todo :> Put '[JSON] TodoId
+
+-- | API for serving @swagger.json@.
+type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
+
+-- | Combined API of a Todo service with Swagger documentation.
+type API = SwaggerAPI :<|> TodoAPI
+
+-- | A single Todo entry.
+data Todo = Todo
+  { created :: UTCTime  -- ^ Creation datetime.
+  , summary :: Text     -- ^ Task summary.
+  } deriving (Show, Generic, Typeable)
+
+-- | A unique Todo entry ID.
+newtype TodoId = TodoId Int
+  deriving (Show, Generic, Typeable, ToJSON, FromText)
+
+instance ToJSON Todo
+instance FromJSON Todo
+
+instance ToSchema Todo where
+  declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+    & mapped.schema.description ?~ "This is some real Todo right here"
+    & mapped.schema.example ?~ toJSON (Todo (UTCTime (fromGregorian 2015 12 31) 0) "get milk")
+
+instance ToParamSchema TodoId
+instance ToSchema TodoId
+
+-- | Swagger spec for Todo API.
+todoSwagger :: Swagger
+todoSwagger = toSwagger todoAPI
+  & info.title   .~ "Todo API"
+  & info.version .~ "1.0"
+  & info.description ?~ "This is an API that tests swagger integration"
+  & info.license ?~ ("MIT" & url ?~ URL "http://mit.com")
+
+-- | Combined server of a Todo service with Swagger documentation.
+server :: Server API
+server = return todoSwagger :<|> error "not implemented"
+

example/swagger.json

@@ -0,0 +1 @@
+{"swagger":"2.0","info":{"version":"1.0","title":"Todo API","license":{"url":"http://mit.com","name":"MIT"},"description":"This is an API that tests swagger integration"},"definitions":{"Todo":{"example":{"summary":"get milk","created":"2015-12-31T00:00:00.000000000000Z"},"required":["created","summary"],"type":"object","description":"This is some real Todo right here","properties":{"summary":{"type":"string"},"created":{"$ref":"#/definitions/UTCTime"}}},"UTCTime":{"format":"yyyy-mm-ddThh:MM:ssZ","type":"string"},"TodoId":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"paths":{"/todo/{id}":{"get":{"responses":{"404":{"description":"`id` not found"},"200":{"schema":{"$ref":"#/definitions/Todo"},"description":""}},"produces":["application/json"],"parameters":[{"maximum":9223372036854775807,"minimum":-9223372036854775808,"required":true,"in":"path","name":"id","type":"integer"}]},"put":{"consumes":["application/json"],"responses":{"404":{"description":"`id` not found"},"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/TodoId"},"description":""}},"produces":["application/json"],"parameters":[{"maximum":9223372036854775807,"minimum":-9223372036854775808,"required":true,"in":"path","name":"id","type":"integer"},{"required":true,"schema":{"$ref":"#/definitions/Todo"},"in":"body","name":"body"}]}},"/todo":{"post":{"consumes":["application/json"],"responses":{"400":{"description":"Invalid `body`"},"201":{"schema":{"$ref":"#/definitions/TodoId"},"description":""}},"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/Todo"},"in":"body","name":"body"}]},"get":{"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/Todo"},"type":"array"},"description":""}},"produces":["application/json"]}}}}

example/test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

example/test/TodoSpec.hs

@@ -0,0 +1,25 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module TodoSpec where
+
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import Servant.Swagger.Test
+import Test.Hspec
+import Test.QuickCheck
+import Test.QuickCheck.Instances ()
+import Todo
+import Paths_example
+
+spec :: Spec
+spec = describe "Swagger" $ do
+  context "ToJSON matches ToSchema" $ validateEveryToJSON todoAPI
+  it "swagger.json is up-to-date" $ do
+    path <- getDataFileName "swagger.json"
+    swag <- eitherDecode <$> BL8.readFile path
+    swag `shouldBe` Right todoSwagger
+
+instance Arbitrary Todo where
+  arbitrary = Todo <$> arbitrary <*> arbitrary
+
+instance Arbitrary TodoId where
+  arbitrary = TodoId <$> arbitrary