diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Unreleased next version + +# 0.1.0.0 + +- Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2021, NoRedInk +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +* Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# NriTestEncoding + +A library to simplify writing golden tests for encoding types. + diff --git a/nri-test-encoding.cabal b/nri-test-encoding.cabal new file mode 100644 --- /dev/null +++ b/nri-test-encoding.cabal @@ -0,0 +1,52 @@ +cabal-version: 1.18 + +-- This file has been generated from package.yaml by hpack version 0.34.2. +-- +-- see: https://github.com/sol/hpack + +name: nri-test-encoding +version: 0.1.0.0 +synopsis: A library to simplify writing golden tests for encoding types. +description: Please see the README at . +category: Testing +homepage: https://github.com/NoRedInk/haskell-libraries#readme +bug-reports: https://github.com/NoRedInk/haskell-libraries/issues +author: NoRedInk +maintainer: haskell-open-source@noredink.com +copyright: 2021 NoRedInk Corp. +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-doc-files: + README.md + LICENSE + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/NoRedInk/haskell-libraries + subdir: nri-test-encoding + +library + exposed-modules: + Examples + Test.Encoding + Test.Encoding.Routes + other-modules: + Paths_nri_test_encoding + hs-source-dirs: + src + default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns + build-depends: + aeson >=1.4.6.0 && <1.6 + , aeson-pretty >=0.8.0 && <0.9 + , base >=4.12.0.0 && <4.16 + , bytestring >=0.10.8.2 && <0.12 + , filepath >=1.4.2.1 && <1.5 + , nri-prelude >=0.1.0.0 && <0.7 + , servant >=0.16.2 && <0.19 + , servant-auth-server >=0.4.5.1 && <0.5 + , servant-server >=0.16.2 && <0.19 + , text >=1.2.3.1 && <1.3 + default-language: Haskell2010 diff --git a/src/Examples.hs b/src/Examples.hs new file mode 100644 --- /dev/null +++ b/src/Examples.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} + +-- | Helpers for associating example values with all the types we use in our +-- APIs. This allows us to write tests that will warn us when the encoding of +-- our types change, potentially in backwards-incompatible ways. +module Examples + ( HasExamples (..), + Examples, + example, + render, + ) +where + +import qualified Data.Aeson +import qualified Data.Aeson.Encode.Pretty +import qualified Data.ByteString.Lazy +import qualified Data.List.NonEmpty as NonEmpty +import Data.Proxy (Proxy (Proxy)) +import qualified Data.Text +import qualified Data.Text.Encoding +import qualified Dict +import qualified List +import NriPrelude +import Prelude ((<>)) +import qualified Prelude + +-- | Example values of a type. +newtype Examples = Examples (NonEmpty.NonEmpty Example) + +data Example = Example + { description :: Text, + encodedValue :: Text + } + deriving (Eq, Ord) + +-- | Create an example for a type. Examples consists of a description and an +-- encoded value. +example :: Data.Aeson.ToJSON a => Text -> a -> Examples +example description x = + Example + { description, + encodedValue = + Data.Aeson.Encode.Pretty.encodePretty x + |> Data.ByteString.Lazy.toStrict + |> Data.Text.Encoding.decodeUtf8 + } + |> Prelude.pure + |> Examples + +-- | A helper type class that provides us example values of particular types. +-- The `IsApi` typeclass below will demand we define an instance of this type +-- class for each type used in a request or response body. +class HasExamples t where + examples :: Proxy t -> Examples + +instance Prelude.Semigroup Examples where + (Examples xs) <> (Examples ys) = Examples (xs <> ys) + +-- | Render example values to a Text. +render :: Examples -> Text +render (Examples examples') = + NonEmpty.toList examples' + |> List.map renderExample + |> Data.Text.intercalate "\n\n" + +renderExample :: Example -> Text +renderExample example' = + description example' + ++ "\n" + ++ encodedValue example' + +instance (HasExamples a, HasExamples b) => HasExamples (a, b) where + examples _ = examples (Proxy :: Proxy a) ++ examples (Proxy :: Proxy b) + +instance (HasExamples a, HasExamples b, HasExamples c) => HasExamples (a, b, c) where + examples _ = + examples (Proxy :: Proxy a) + ++ examples (Proxy :: Proxy b) + ++ examples (Proxy :: Proxy c) + +instance (HasExamples a, HasExamples b) => HasExamples (Dict.Dict a b) where + examples _ = examples (Proxy :: Proxy a) ++ examples (Proxy :: Proxy b) + +instance (HasExamples a) => HasExamples (Maybe a) where + examples _ = examples (Proxy :: Proxy a) + +instance (HasExamples a) => HasExamples (a, List a) where + examples _ = examples (Proxy :: Proxy a) + +instance (HasExamples a) => HasExamples (List a) where + examples _ = examples (Proxy :: Proxy a) + +instance HasExamples Int where + examples _ = example "int" (1 :: Int) + +instance HasExamples () where + examples _ = example "unit" () diff --git a/src/Test/Encoding.hs b/src/Test/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Test/Encoding.hs @@ -0,0 +1,21 @@ +-- | Turns `Examples` into a `Test` +module Test.Encoding (examplesToTest) where + +import qualified Examples +import qualified Expect +import NriPrelude +import System.FilePath (()) +import qualified System.FilePath as FilePath +import Test (Test, test) +import qualified Text + +-- | Creates tests for some examples +examplesToTest :: Text -> Text -> Examples.Examples -> Test +examplesToTest name fileName examples = + test name <| \() -> + Expect.equalToContentsOf + ( "test" "golden-results" Text.toList fileName + |> FilePath.makeValid + |> Text.fromList + ) + (Examples.render examples) diff --git a/src/Test/Encoding/Routes.hs b/src/Test/Encoding/Routes.hs new file mode 100644 --- /dev/null +++ b/src/Test/Encoding/Routes.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Test helpers to ensure we don't change types or encodings of types +-- used in our request and response bodies by accident. `crawl` will +-- traverse our entire `Routes` API for request and response body types, +-- and fail to compile if we don't provide example values for each. We +-- can then run a golden result test for each, meaning we encode each +-- example value to JSON and check it matches a known-good encoding we +-- have comitted to the repo. +module Test.Encoding.Routes (tests, IsApi (..)) where + +import Data.Proxy (Proxy (Proxy)) +import qualified Data.Typeable as Typeable +import qualified Debug +import qualified Examples +import qualified Expect +import GHC.TypeLits (KnownSymbol, symbolVal) +import qualified List +import NriPrelude +import qualified Servant +import Servant.API (Capture', QueryFlag, Raw, ReqBody, Verb, (:<|>), (:>)) +import Servant.API.Generic (ToServantApi) +import qualified Servant.Auth.Server +import Test (Test, describe, test) +import qualified Test.Encoding +import qualified Text + +-- | Creates tests for routes and custom types used in routes. +-- +-- Example usage: +-- describe +-- "Spec.ApiEncoding" +-- (TestEncoding.tests (Proxy :: Proxy Routes.Routes)) +tests :: forall routes. IsApi (ToServantApi routes) => Proxy routes -> List Test +tests _ = + let routes = crawl (Proxy :: Proxy (ToServantApi routes)) + in [ test "route types haven't changed" <| \() -> + routes + |> routesToText + |> Expect.equalToContentsOf "test/golden-results/route-types.json", + describe + "encodings of custom types" + ( routes + |> routesWithExamples + |> List.map + ( \(route, examples) -> + Test.Encoding.examplesToTest ("Examples for route `" ++ routeName route ++ "`") (routeToFileName route) examples + ) + ) + ] + +data Route = Route + { path :: [Text], + method :: Text, + requestBody :: Maybe SomeType, + responseBody :: SomeType + } + +data SomeType where + SomeType :: (Typeable.Typeable t, Examples.HasExamples t) => Proxy t -> SomeType + +routesWithExamples :: List Route -> List (Route, Examples.Examples) +routesWithExamples routes = + routes + |> List.map + ( \route@Route {requestBody, responseBody} -> + ( route, + case (requestBody, responseBody) of + (Nothing, SomeType t) -> Examples.examples t + (Just (SomeType s), SomeType t) -> Examples.examples s ++ Examples.examples t + ) + ) + +routeName :: Route -> Text +routeName route = + Text.join " " [method route, Text.join "/" (path route)] + +routeToFileName :: Route -> Text +routeToFileName route = + method route ++ "-" ++ Text.join "-" (path route) ++ ".json" + +routesToText :: List Route -> Text +routesToText routes = + routes + |> List.concatMap + ( \route -> + case requestBody route of + Nothing -> + [ Text.join + " " + [ routeName route, + "response", + printType (responseBody route) + ] + ] + Just body -> + [ Text.join + " " + [ routeName route, + "response", + printType (responseBody route) + ], + Text.join + " " + [ routeName route, + "request", + printType body + ] + ] + ) + |> List.sort + |> Text.join "\n" + +printType :: SomeType -> Text +printType (SomeType t) = + Typeable.typeRep t + |> Debug.toString + +-- | A helper type class that provides us example values of particular types. +-- The `IsApi` typeclass below will demand we define an instance of this type +-- class for each type used in a request or response body. + +-- | A helper type class that can crawl our servant `Routes` type and return us +-- JSON-encoded examples for each request and response body type in that API. +-- Example usage: +-- +-- routes = crawl (Proxy :: Proxy (ToServantApi Routes.Routes)) +class IsApi a where + crawl :: Proxy a -> [Route] + +instance (IsApi a, IsApi b) => IsApi (a :<|> b) where + crawl _ = crawl (Proxy :: Proxy a) ++ crawl (Proxy :: Proxy b) + +instance (KnownSymbol s, IsApi a) => IsApi (s :> a) where + crawl _ = + crawl (Proxy :: Proxy a) + |> List.map + ( \route -> + route + { path = + Text.fromList (symbolVal (Proxy :: Proxy s)) : + path route + } + ) + +instance (KnownSymbol s, IsApi a) => IsApi (Capture' mods s paramType :> a) where + crawl _ = + crawl (Proxy :: Proxy a) + |> List.map + ( \route -> + route + { path = (":" ++ Text.fromList (symbolVal (Proxy :: Proxy s))) : path route + } + ) + +instance (Typeable.Typeable body, Examples.HasExamples body, IsApi a) => IsApi (ReqBody encodings body :> a) where + crawl _ = + crawl (Proxy :: Proxy a) + |> List.map + ( \route -> + route + { requestBody = Just (SomeType (Proxy :: Proxy body)) + } + ) + +instance + (Typeable.Typeable method, Typeable.Typeable body, Examples.HasExamples body) => + IsApi (Verb method status encodings body) + where + crawl _ = + [ Route + { path = [], + requestBody = Nothing, + method = + Typeable.typeRep (Proxy :: Proxy method) + |> Debug.toString, + responseBody = SomeType (Proxy :: Proxy body) + } + ] + +instance (IsApi a) => IsApi (Servant.Auth.Server.Auth types user :> a) where + crawl _ = crawl (Proxy :: Proxy a) + +instance IsApi Raw where + crawl _ = [] + +instance (IsApi a) => IsApi (QueryFlag flag :> a) where + crawl _ = crawl (Proxy :: Proxy a) + +instance Examples.HasExamples Servant.NoContent where + examples _ = Examples.example "NoContent" ()