nri-test-encoding (empty) → 0.1.0.0
raw patch · 7 files changed
+403/−0 lines, 7 filesdep +aesondep +aeson-prettydep +base
Dependencies added: aeson, aeson-pretty, base, bytestring, filepath, nri-prelude, servant, servant-auth-server, servant-server, text
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- README.md +4/−0
- nri-test-encoding.cabal +52/−0
- src/Examples.hs +98/−0
- src/Test/Encoding.hs +21/−0
- src/Test/Encoding/Routes.hs +194/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Unreleased next version++# 0.1.0.0++- Initial release.
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,4 @@+# NriTestEncoding++A library to simplify writing golden tests for encoding types.+
+ nri-test-encoding.cabal view
@@ -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 <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-test-encoding>.+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
+ src/Examples.hs view
@@ -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" ()
+ src/Test/Encoding.hs view
@@ -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)
+ src/Test/Encoding/Routes.hs view
@@ -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" ()