Merge pull request #56 from anton-k/write-core-tests

Draft: Write core tests

Makefile

@@ -4,7 +4,7 @@ build:
 	stack build 
 
 test:
-	stack test
+	stack test 
 
 run:
 	stack run

mig-server/mig-server.cabal

@@ -37,24 +37,23 @@ description:        With library mig we can build lightweight and composable ser
                     > -- | Init simple hello world server whith two routes:
                     > server :: Server IO
                     > server =
-                    >   "api" /. "v1" /.
-                    >     mconcat
+                    >   "api/v1" /.
                     >       [ "hello" /. hello
                     >       , "bye" /. bye
                     >       ]
                     >
                     > -- | Handler takes no inputs and marked as Get HTTP-request that returns Text.
                     > hello :: Get (Resp Text)
-                    > hello = Get $ pure $ ok "Hello World"
+                    > hello = pure $ ok "Hello World"
                     >
                     > -- | Handle with URL-param query and json body input as Post HTTP-request that returns Text.
                     > bye :: Query "name" Text -> Body Text -> Post (Resp Text)
-                    > bye (Query name) (Body greeting) = Post $
+                    > bye (Query name) (Body greeting) =
                     >   pure $ ok $ "Bye to " <> name <> " " <> greeting
                     .
                     Please see:
                     .
-                    * quick start guide at <https://github.com/anton-k/mig#readme>
+                    * quick start guide at <https://anton-k.github.io/mig/>
                     .
                     * examples directory for more fun servers: at <https://github.com/anton-k/mig/tree/main/examples/mig-example-apps#readme>
 category:           Web

mig/mig.cabal

@@ -88,3 +88,40 @@ library
     , text
     , transformers
   default-language: GHC2021
+
+test-suite mig-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Test.Api
+      Test.Server
+      Test.Server.Common
+      Test.Server.Counter
+      Test.Server.Hello
+      Test.Server.RouteArgs
+      Paths_mig
+  hs-source-dirs:
+      test
+  default-extensions:
+      OverloadedStrings
+      TypeFamilies
+      OverloadedRecordDot
+      DuplicateRecordFields
+      LambdaCase
+      DerivingStrategies
+      StrictData
+      AllowAmbiguousTypes
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      aeson
+    , base >=4.7 && <5
+    , bytestring
+    , containers
+    , hspec
+    , http-api-data
+    , http-types
+    , mig
+    , mtl
+    , openapi3
+    , text
+  default-language: GHC2021

mig/package.yaml

@@ -28,28 +28,6 @@ description: |
   .
   * examples directory for more fun servers: at <https://github.com/anton-k/mig/tree/main/examples/mig-example-apps#readme>
 
-dependencies:
-- base >= 4.7 && < 5
-- aeson
-- text
-- http-types
-- blaze-html
-- bytestring
-- containers
-- mtl
-- exceptions
-- http-api-data
-- http-media
-- case-insensitive
-- safe
-- openapi3
-- filepath
-- extra
-- insert-ordered-containers
-- lens
-- lrucache
-- transformers
-
 default-extensions:
   - OverloadedStrings
   - TypeFamilies
@@ -77,3 +55,45 @@ ghc-options:
 
 library:
   source-dirs: src
+  dependencies:
+  - base >= 4.7 && < 5
+  - aeson
+  - text
+  - http-types
+  - blaze-html
+  - bytestring
+  - containers
+  - mtl
+  - exceptions
+  - http-api-data
+  - http-media
+  - case-insensitive
+  - safe
+  - openapi3
+  - filepath
+  - extra
+  - insert-ordered-containers
+  - lens
+  - lrucache
+  - transformers
+
+tests:
+  mig-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - aeson
+    - base >= 4.7 && < 5
+    - containers
+    - mig
+    - hspec
+    - text
+    - http-types
+    - mtl
+    - openapi3
+    - http-api-data
+    - bytestring

mig/src/Mig/Core/Types/Http.hs

@@ -6,6 +6,7 @@ module Mig.Core.Types.Http (
   Request (..),
   Response (..),
   ResponseBody (..),
+  HeaderMap,
   QueryMap,
   ToText (..),
 
@@ -46,6 +47,7 @@ data Response = Response
   , body :: ResponseBody
   -- ^ response body
   }
+  deriving (Show, Eq)
 
 -- | Response with no content
 noContentResponse :: Status -> Response
@@ -56,6 +58,7 @@ data ResponseBody
   = RawResp MediaType BL.ByteString
   | FileResp FilePath
   | StreamResp
+  deriving (Show, Eq)
 
 -- | Http request
 data Request = Request

mig/test/Spec.hs

@@ -0,0 +1,10 @@
+import Test.Api qualified as Api
+import Test.Server qualified as Server
+
+import Test.Hspec
+
+main :: IO ()
+main =
+  hspec $ do
+    Api.spec
+    Server.spec

mig/test/Test/Api.hs

@@ -0,0 +1,76 @@
+module Test.Api (spec) where
+
+import Data.Map.Strict qualified as Map
+import Data.Text (Text)
+import Mig.Core.Api
+import Test.Hspec
+
+spec :: Spec
+spec = describe "api" $ do
+  checkRoutes
+  checkCaptures
+  checkFlatApi
+
+notFound :: (Show a, Eq a) => Maybe a -> Expectation
+notFound a = a `shouldBe` Nothing
+
+-- static routes
+
+checkRoutes :: Spec
+checkRoutes = do
+  it "enter route (positive cases)" $ do
+    getPath ["api", "v1", "hello"] helloApi `shouldBe` Just ("hello", mempty)
+    getPath ["api", "v1", "bye"] helloApi `shouldBe` Just ("bye", mempty)
+  it "enter route (negative cases)" $
+    mapM_
+      notFound
+      [ getPath ["api", "v1"] helloApi
+      , getPath [] helloApi
+      , getPath ["api", "v1", "hello", "there"] helloApi
+      , getPath ["api", "v1"] (mempty @(Api Text))
+      , getPath [] (mempty @(Api Text))
+      ]
+
+helloApi :: Api Text
+helloApi =
+  WithPath "api/v1" $
+    mconcat
+      [ WithPath "hello" (HandleRoute "hello")
+      , WithPath "bye" (HandleRoute "bye")
+      ]
+
+-- captures
+
+checkCaptures :: Spec
+checkCaptures = do
+  it "captures (positive cases)" $ do
+    getPath ["api", "capture1", "hello"] captureApi
+      `shouldBe` Just ("capture1", Map.fromList [("name1", "hello")])
+    getPath ["api", "capture2", "hello", "bye"] captureApi
+      `shouldBe` Just ("capture2", Map.fromList [("name1", "hello"), ("name2", "bye")])
+
+  it "captures (negative cases)" $
+    mapM_
+      (notFound . flip getPath captureApi)
+      [ ["api", "capture1"]
+      , ["api", "capture2", "hello"]
+      , ["api", "capture2", "hello", "bye", "error"]
+      ]
+
+captureApi :: Api Text
+captureApi =
+  WithPath "api" $
+    mconcat
+      [ WithPath ("capture1" <> Path [CapturePath "name1"]) (HandleRoute "capture1")
+      , WithPath ("capture2" <> Path [CapturePath "name1", CapturePath "name2"]) (HandleRoute "capture2")
+      ]
+
+-- flat api
+
+checkFlatApi :: Spec
+checkFlatApi =
+  it "flat api" $
+    flatApi helloApi
+      `shouldBe` [ ("api/v1/hello", "hello")
+                 , ("api/v1/bye", "bye")
+                 ]

mig/test/Test/Server.hs

@@ -0,0 +1,12 @@
+module Test.Server (spec) where
+
+import Test.Hspec
+import Test.Server.Counter qualified as Counter
+import Test.Server.Hello qualified as Hello
+import Test.Server.RouteArgs qualified as RouteArgs
+
+spec :: Spec
+spec = describe "server" $ do
+  Hello.spec
+  RouteArgs.spec
+  Counter.spec

mig/test/Test/Server/Common.hs

@@ -0,0 +1,36 @@
+module Test.Server.Common (
+  emptyReq,
+  jsonResp,
+  parseResp,
+) where
+
+import Data.Aeson qualified as Json
+import Data.Map.Strict qualified as Map
+import Mig.Core
+import Network.HTTP.Types.Method (methodGet)
+import Network.HTTP.Types.Status (ok200)
+
+emptyReq :: Request
+emptyReq =
+  Request
+    { path = []
+    , query = mempty
+    , capture = mempty
+    , headers = Map.fromList [("Accept", "application/json")]
+    , method = methodGet
+    , readBody = pure (Right "")
+    , isSecure = False
+    }
+
+jsonResp :: (Json.ToJSON a) => a -> Response
+jsonResp a =
+  Response
+    { status = ok200
+    , headers = [("Content-Type", "application/json")]
+    , body = RawResp "application/json" (Json.encode a)
+    }
+
+parseResp :: (Json.FromJSON a) => Response -> Maybe a
+parseResp resp = case resp.body of
+  RawResp "application/json" bsResp -> Json.decode bsResp
+  _ -> Nothing