├── .gitignore ├── .travis.yml ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── armor.cabal ├── default.nix ├── src └── Armor.hs └── test ├── AppA.lhs ├── AppB.lhs ├── Main.hs ├── TestAppA.lhs └── TestAppB.lhs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | *.o 4 | *.hi 5 | *.swp 6 | .cabal-sandbox 7 | cabal.sandbox.config 8 | .stack-work/* 9 | .ghc.environment* 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This Travis job script has been generated by a script via 2 | # 3 | # haskell-ci 'travis' 'armor.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.12.1 12 | # 13 | version: ~> 1.0 14 | language: c 15 | os: linux 16 | dist: xenial 17 | git: 18 | # whether to recursively clone submodules 19 | submodules: false 20 | cache: 21 | directories: 22 | - $HOME/.cabal/packages 23 | - $HOME/.cabal/store 24 | - $HOME/.hlint 25 | before_cache: 26 | - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log 27 | # remove files that are regenerated by 'cabal update' 28 | - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* 29 | - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json 30 | - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache 31 | - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar 32 | - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx 33 | - rm -rfv $CABALHOME/packages/head.hackage 34 | jobs: 35 | include: 36 | - compiler: ghc-9.0.1 37 | addons: {"apt":{"packages":["ghc-9.0.1","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 38 | os: linux 39 | - compiler: ghc-8.10.1 40 | addons: {"apt":{"packages":["ghc-8.10.1","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 41 | os: linux 42 | - compiler: ghc-8.8.3 43 | addons: {"apt":{"packages":["ghc-8.8.3","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 44 | os: linux 45 | - compiler: ghc-8.6.3 46 | addons: {"apt":{"packages":["ghc-8.6.3","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 47 | os: linux 48 | - compiler: ghc-8.4.4 49 | addons: {"apt":{"packages":["ghc-8.4.4","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 50 | os: linux 51 | - compiler: ghc-8.2.2 52 | addons: {"apt":{"packages":["ghc-8.2.2","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 53 | os: linux 54 | - compiler: ghc-8.0.2 55 | addons: {"apt":{"packages":["ghc-8.0.2","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 56 | os: linux 57 | - compiler: ghc-7.10.3 58 | addons: {"apt":{"packages":["ghc-7.10.3","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main"}]}} 59 | os: linux 60 | before_install: 61 | - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') 62 | - WITHCOMPILER="-w $HC" 63 | - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') 64 | - HCPKG="$HC-pkg" 65 | - unset CC 66 | - CABAL=/opt/ghc/bin/cabal 67 | - CABALHOME=$HOME/.cabal 68 | - export PATH="$CABALHOME/bin:$PATH" 69 | - TOP=$(pwd) 70 | - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" 71 | - echo $HCNUMVER 72 | - CABAL="$CABAL -vnormal+nowrap" 73 | - set -o pipefail 74 | - TEST=--enable-tests 75 | - BENCH=--enable-benchmarks 76 | - HEADHACKAGE=false 77 | - rm -f $CABALHOME/config 78 | - | 79 | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config 80 | echo "remote-build-reporting: anonymous" >> $CABALHOME/config 81 | echo "write-ghc-environment-files: never" >> $CABALHOME/config 82 | echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config 83 | echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config 84 | echo "world-file: $CABALHOME/world" >> $CABALHOME/config 85 | echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config 86 | echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config 87 | echo "installdir: $CABALHOME/bin" >> $CABALHOME/config 88 | echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config 89 | echo "store-dir: $CABALHOME/store" >> $CABALHOME/config 90 | echo "install-dirs user" >> $CABALHOME/config 91 | echo " prefix: $CABALHOME" >> $CABALHOME/config 92 | echo "repository hackage.haskell.org" >> $CABALHOME/config 93 | echo " url: http://hackage.haskell.org/" >> $CABALHOME/config 94 | install: 95 | - ${CABAL} --version 96 | - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" 97 | - | 98 | echo "program-default-options" >> $CABALHOME/config 99 | echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config 100 | - cat $CABALHOME/config 101 | - rm -fv cabal.project cabal.project.local cabal.project.freeze 102 | - travis_retry ${CABAL} v2-update -v 103 | # Generate cabal.project 104 | - rm -rf cabal.project cabal.project.local cabal.project.freeze 105 | - touch cabal.project 106 | - | 107 | echo "packages: ." >> cabal.project 108 | - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo 'package armor' >> cabal.project ; fi 109 | - "if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" 110 | - | 111 | - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(armor)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" 112 | - cat cabal.project || true 113 | - cat cabal.project.local || true 114 | - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi 115 | - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} 116 | - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" 117 | - rm cabal.project.freeze 118 | - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all 119 | - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all 120 | script: 121 | - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) 122 | # Packaging... 123 | - ${CABAL} v2-sdist all 124 | # Unpacking... 125 | - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ 126 | - cd ${DISTDIR} || false 127 | - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; 128 | - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; 129 | - PKGDIR_armor="$(find . -maxdepth 1 -type d -regex '.*/armor-[0-9.]*')" 130 | # Generate cabal.project 131 | - rm -rf cabal.project cabal.project.local cabal.project.freeze 132 | - touch cabal.project 133 | - | 134 | echo "packages: ${PKGDIR_armor}" >> cabal.project 135 | - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo 'package armor' >> cabal.project ; fi 136 | - "if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" 137 | - | 138 | - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(armor)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" 139 | - cat cabal.project || true 140 | - cat cabal.project.local || true 141 | # Building... 142 | # this builds all libraries and executables (without tests/benchmarks) 143 | - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all 144 | # Building with tests and benchmarks... 145 | # build & run tests, build benchmarks 146 | - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all --write-ghc-environment-files=always 147 | # Testing... 148 | - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all --test-show-details=direct 149 | # cabal check... 150 | - (cd ${PKGDIR_armor} && ${CABAL} -vnormal check) 151 | # haddock... 152 | - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all 153 | # Building without installed constraints for packages in global-db... 154 | - rm -f cabal.project.local 155 | - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all 156 | 157 | # REGENDATA ("0.12.1",["travis","armor.cabal"]) 158 | # EOF 159 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for armor 2 | 3 | ## 0.2 -- 2021-05-06 4 | 5 | * Widen version bounds 6 | * Support and test through GHC 9 7 | * Expose more customizable test function 8 | * Change default mechanics of FilePath generation 9 | 10 | WARNING: Depending on how you use armor this is a potentially 11 | backwards-incompatible change! As a precaution we are doing a major version 12 | bump even though the change would only technically need a C bump. 13 | 14 | The best way to upgrade your app is to upgrade armor in a commit by itself 15 | with no other changes to your app. That way, if there armor has test case 16 | failures, you know that they are innocuous because no part of the rest of your 17 | app changed functionaly. So you can simple delete the failing golds, 18 | regenerate them, and check the new ones into source control. 19 | 20 | ## 0.1 -- 2018-03-14 21 | 22 | * First version. Released on an unsuspecting world. 23 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, Doug Beardsley 2 | Copyright (c) 2017, Formation Inc. 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright notice, this 12 | list of conditions and the following disclaimer in the documentation and/or 13 | other materials provided with the distribution. 14 | 15 | Neither the name of Doug Beardsley nor the names of its other contributors may 16 | be used to endorse or promote products derived from this software without 17 | specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 20 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 21 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Armor 2 | 3 | [![Build Status](https://travis-ci.org/mightybyte/armor.svg?branch=master)](https://travis-ci.org/mightybyte/armor) 4 | 5 | Armor yourself against backwards-incompatible serializations once and for all. 6 | 7 | See the 8 | [ChangeLog](https://github.com/mightybyte/armor/blob/master/ChangeLog.md) for 9 | information about changes between versions. 10 | 11 | ## Motivation 12 | 13 | As almost everyone with significant experience managing production software 14 | systems knows, backwards compatibility is incredibly important for any data that 15 | is persisted by an application. If you make a change to a data structure that is 16 | not backwards compatible with the existing serialized formats, your app will 17 | break as soon as it encounters the existing format. Even if you have 100% test 18 | coverage, your tests still might not catch this problem because it's not a 19 | problem with your app at any single point in time, but a problem with how your 20 | app evolves over time. 21 | 22 | More subtly, if you deploy a backwards incompatible migration, your app may 23 | persist some data in the new format before it crashes on the old format. This 24 | can leave your system in the horrible state where not only will it not work with 25 | the new code, but rolling back to the old code will also break because the old 26 | code doesn't support the new serialized format! You have two incomptable 27 | serializations active at the same time! 28 | 29 | Proper migration systems can reduce the chances of this problem occurring, but 30 | if your system has any kind of queueing system or message bus, your migrations 31 | might not be applied to in-flight messages. Clearly we need something to help us 32 | protect against this problem. Enter `armor`. 33 | 34 | For an overview of how to use this package, check out the [literate Haskell 35 | tutorial in the test suite](test/AppA.lhs). 36 | 37 | ## Credits 38 | 39 | Inspiration for this package came from [Soostone's safecopy-hunit package](https://github.com/Soostone/safecopy-hunit). 40 | 41 | Details were refined in production at [Formation](http://formation.ai/) 42 | (previously Takt). 43 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /armor.cabal: -------------------------------------------------------------------------------- 1 | name: armor 2 | version: 0.2.0.1 3 | synopsis: Prevent serialization backwards compatibility problems using golden tests 4 | description: Tests the serialization backwards compatibility of data types by storing 5 | serialized representations in .test files to be checked into your project's 6 | version control. 7 | license: BSD3 8 | license-file: LICENSE 9 | author: Doug Beardsley 10 | maintainer: mightybyte@gmail.com 11 | copyright: Doug Beardsley, Formation Inc. 12 | homepage: https://github.com/mightybyte/armor 13 | bug-reports: https://github.com/mightybyte/armor/issues 14 | category: Data,Testing 15 | build-type: Simple 16 | extra-source-files: ChangeLog.md 17 | cabal-version: >=1.10 18 | tested-with: 19 | GHC==7.10.3, 20 | GHC==8.0.2, 21 | GHC==8.2.2, 22 | GHC==8.4.4, 23 | GHC==8.6.3, 24 | GHC==8.8.3, 25 | GHC==8.10.1, 26 | GHC==9.0.1 27 | 28 | extra-source-files: 29 | default.nix 30 | README.md 31 | 32 | Source-repository head 33 | Type: git 34 | Location: https://github.com/mightybyte/armor.git 35 | 36 | library 37 | exposed-modules: 38 | Armor 39 | 40 | hs-source-dirs: src 41 | ghc-options: -Wall 42 | build-depends: 43 | HUnit >= 1.5 && < 1.7, 44 | base >= 4.6 && < 4.16, 45 | bytestring >= 0.10 && < 0.12, 46 | containers >= 0.5 && < 0.7, 47 | directory >= 1.2 && < 1.4, 48 | filepath >= 1.4 && < 1.5, 49 | hashable >= 1.3 && < 1.4, 50 | lens >= 4.16 && < 5.1 51 | 52 | default-language: Haskell2010 53 | 54 | test-suite testsuite 55 | hs-source-dirs: test 56 | type: exitcode-stdio-1.0 57 | main-is: Main.hs 58 | 59 | other-modules: 60 | AppA 61 | AppB 62 | TestAppA 63 | TestAppB 64 | 65 | ghc-options: -Wall 66 | build-depends: 67 | HUnit, 68 | aeson >= 1.0 && < 1.6, 69 | armor, 70 | base, 71 | bytestring, 72 | containers, 73 | directory, 74 | hspec >= 2.4 && < 2.8, 75 | lens, 76 | text >= 1.2 && < 1.3 77 | 78 | default-language: Haskell2010 79 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { compiler ? "ghc8104" 2 | , rev ? "282473158cf8fafb736ed2a09f328be8b7ed2efa" 3 | , sha256 ? "1nz2h6dmb6s5zcilb39l116y4dmp1c6w9n110g4dilm6v01linj2" 4 | , pkgs ? 5 | import (builtins.fetchTarball { 6 | url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz"; 7 | inherit sha256; }) { 8 | config.allowBroken = false; 9 | config.allowUnfree = true; 10 | } 11 | }: 12 | let gitignoreSrc = import (pkgs.fetchFromGitHub { 13 | owner = "hercules-ci"; 14 | repo = "gitignore"; 15 | rev = "2ced4519f865341adcb143c5d668f955a2cb997f"; 16 | sha256 = "0fc5bgv9syfcblp23y05kkfnpgh3gssz6vn24frs8dzw39algk2z"; 17 | }) {}; 18 | 19 | in 20 | pkgs.haskell.packages.${compiler}.developPackage { 21 | name = builtins.baseNameOf ./.; 22 | root = gitignoreSrc.gitignoreSource ./.; 23 | 24 | overrides = self: super: with pkgs.haskell.lib; { 25 | # Don't run a package's test suite 26 | # foo = dontCheck super.foo; 27 | # 28 | # Don't enforce package's version constraints 29 | # bar = doJailbreak super.bar; 30 | # 31 | # Get a specific hackage version straight from hackage. Unlike the above 32 | # callHackage approach, this will always succeed if the version is on 33 | # hackage. The downside is that you have to specify the hash manually. 34 | # aeson = callHackageDirect { 35 | # pkg = "aeson"; 36 | # ver = "1.4.2.0"; 37 | # sha256 = "0qcczw3l596knj9s4ha07wjspd9wkva0jv4734sv3z3vdad5piqh"; 38 | # } {}; 39 | # 40 | # To discover more functions that can be used to modify haskell 41 | # packages, run "nix-repl", type "pkgs.haskell.lib.", then hit 42 | # to get a tab-completed list of functions. 43 | }; 44 | source-overrides = { 45 | # Use a specific hackage version using callHackage. Only works if the 46 | # version you want is in the version of all-cabal-hashes that you have. 47 | # bytestring = "0.10.8.1"; 48 | # 49 | # Use a particular commit from github 50 | # parsec = pkgs.fetchFromGitHub 51 | # { owner = "hvr"; 52 | # repo = "parsec"; 53 | # rev = "c22d391c046ef075a6c771d05c612505ec2cd0c3"; 54 | # sha256 = "0phar79fky4yzv4hq28py18i4iw779gp5n327xx76mrj7yj87id3"; 55 | # }; 56 | }; 57 | modifier = drv: pkgs.haskell.lib.overrideCabal drv (attrs: { 58 | buildTools = (attrs.buildTools or []) ++ [ 59 | pkgs.haskell.packages.${compiler}.cabal-install 60 | pkgs.haskell.packages.${compiler}.ghcid 61 | ]; 62 | }); 63 | } 64 | -------------------------------------------------------------------------------- /src/Armor.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module Armor 6 | ( Version(..) 7 | , Armored(..) 8 | , ArmorMode(..) 9 | , ArmorConfig(..) 10 | , defArmorConfig 11 | , testArmor 12 | , testArmorMany 13 | , testSerialization 14 | , GoldenTest(..) 15 | , goldenFilePath 16 | ) where 17 | 18 | ------------------------------------------------------------------------------ 19 | import Control.Lens 20 | import Control.Monad 21 | import Data.ByteString (ByteString) 22 | import qualified Data.ByteString as B 23 | import Data.Char 24 | import Data.Hashable 25 | import Data.Map (Map) 26 | import qualified Data.Map as M 27 | import Data.Typeable 28 | #if !MIN_VERSION_base(4,8,0) 29 | import Data.Word 30 | #endif 31 | import Numeric 32 | import System.Directory 33 | import System.FilePath 34 | import Test.HUnit.Base 35 | import Text.Printf 36 | ------------------------------------------------------------------------------ 37 | 38 | 39 | ------------------------------------------------------------------------------ 40 | -- | Version numbers are simple monotonically increasing positive integers. 41 | newtype Version a = Version { unVersion :: Word } 42 | deriving (Eq,Ord,Show,Read) 43 | 44 | 45 | ------------------------------------------------------------------------------ 46 | -- | Core type class for armoring types. Includes a version and all the 47 | -- type's serializations that you want to armor. 48 | class Armored a where 49 | -- | Current version number for the data type. 50 | version :: Version a 51 | -- | Map of serializations keyed by a unique ID used to refer to each 52 | -- serialization. A serialization is a tuple of @(a -> ByteString)@ and 53 | -- @(ByteString -> Maybe a)@. Represented here as a prism. 54 | serializations :: Map String (APrism' ByteString a) 55 | 56 | 57 | ------------------------------------------------------------------------------ 58 | -- | The mode of operation for armor test cases. 59 | data ArmorMode 60 | = SaveOnly 61 | -- ^ Write test files for serializations that don't have them, but don't 62 | -- do any tests to verify that existing files are deserialized properly. 63 | | TestOnly 64 | -- ^ Run tests to verify that existing files are deserialized properly, 65 | -- but don't write any missing files. 66 | | SaveAndTest 67 | -- ^ Do both the save and test phases. 68 | deriving (Eq,Ord,Show,Read,Enum,Bounded) 69 | 70 | 71 | ------------------------------------------------------------------------------ 72 | -- | Config data for armor tests. 73 | data ArmorConfig = ArmorConfig 74 | { acArmorMode :: ArmorMode 75 | , acStoreDir :: FilePath 76 | -- ^ Directory where all the test serializations are stored. 77 | , acNumVersions :: Maybe Word 78 | -- ^ How many versions back to test for backwards compatibility. A value 79 | -- of @Just 0@ means that it only tests that the current version satisfies 80 | -- @parse . render == id@. @Just 1@ means that it will verify that the 81 | -- previous version can still be parse. @Just 2@ the previous two 82 | -- versions, etc. Nothing means that all versions will be tested. 83 | } 84 | 85 | 86 | ------------------------------------------------------------------------------ 87 | -- | Default value for ArmorConfig. 88 | defArmorConfig :: ArmorConfig 89 | defArmorConfig = ArmorConfig SaveAndTest "test-data" Nothing 90 | 91 | 92 | ------------------------------------------------------------------------------ 93 | -- | Tests the serialization backwards compatibility of a data type by storing 94 | -- serialized representations in .test files to be checked into your project's 95 | -- version control. 96 | -- 97 | -- First, this function checks the directory 'acStoreDir' for the existence of 98 | -- a file @foo-000.test@. If it doesn't exist, it creates it for each 99 | -- serialization with the serialized representation of the val parameter. 100 | -- 101 | -- Next, it checks that the serialized formats in the most recent 102 | -- 'acNumVersions' of the stored @.test@ files are parsable by the current 103 | -- version of the serialization. 104 | testArmor 105 | :: (Eq a, Show a, Typeable a, Armored a) 106 | => ArmorConfig 107 | -> String 108 | -> a 109 | -> Test 110 | testArmor ac valId val = 111 | TestList [ testIt s | s <- M.toList serializations ] 112 | where 113 | testIt s = test (testSerialization ac goldenFilePath valId s val) 114 | 115 | 116 | ------------------------------------------------------------------------------ 117 | -- | Same as 'testArmor', but more convenient for testing several values of the 118 | -- same type. 119 | testArmorMany 120 | :: (Eq a, Show a, Typeable a, Armored a) 121 | => ArmorConfig 122 | -> Map String a 123 | -> Test 124 | testArmorMany ac valMap = TestList $ map doOne $ M.toList valMap 125 | where 126 | doOne (k,v) = TestLabel k $ testArmor ac k v 127 | 128 | 129 | ------------------------------------------------------------------------------ 130 | -- | Lower level assertion function that works for a wider array of test 131 | -- frameworks. 132 | -- 133 | -- This function can make two different assertions. It fails if the values fail 134 | -- to parse, and it asserts that the values are equal to the expected value. 135 | -- This latter assertion is only done for the most recent version because 136 | -- changes that impact the structure of a data type can result in erroneous 137 | -- failures due to changes in the order that the test cases are generated. 138 | -- 139 | -- In other words, if you make an innocuous change like adding a constructor and 140 | -- start getting "values didn't match" failures, all you need to do is bump the 141 | -- data type's version. Armor will still guarantee that those serializations 142 | -- parse properly but the incorrect value failures will be suppressed. 143 | testSerialization 144 | :: forall a. (Eq a, Show a, Typeable a, Armored a) 145 | => ArmorConfig 146 | -> (GoldenTest a -> FilePath) 147 | -- ^ Customizable location where the serializations will be stored. We 148 | -- recommend 'goldenFilePath' as a standard out-of-the-box scheme. 149 | -> String 150 | -> (String, APrism' ByteString a) 151 | -> a 152 | -> Assertion 153 | testSerialization ac makeFilePath valName (sname,p) val = do 154 | ensureTestFileExists 155 | when (acArmorMode ac /= SaveOnly) $ 156 | mapM_ (assertVersionParses . Version) vs 157 | where 158 | makeGT = GoldenTest val valName sname p 159 | curVer :: Version a 160 | curVer = version 161 | vs = reverse [maybe 0 (unVersion curVer -) (acNumVersions ac) .. unVersion curVer] 162 | ensureTestFileExists = do 163 | let fp = acStoreDir ac makeFilePath (makeGT curVer) 164 | d = dropFileName fp 165 | when (acArmorMode ac /= TestOnly) $ do 166 | createDirectoryIfMissing True d 167 | fileExists <- doesFileExist fp 168 | when (not fileExists) $ 169 | B.writeFile fp (review (clonePrism p) val) 170 | assertVersionParses ver = do 171 | let fp = acStoreDir ac makeFilePath (makeGT ver) 172 | exists <- doesFileExist fp 173 | if exists 174 | then do bs <- B.readFile fp 175 | case preview (clonePrism p) bs of 176 | Nothing -> assertFailure $ 177 | printf "Not backwards compatible with version %d: %s" 178 | (unVersion ver) fp 179 | Just v -> when (ver == curVer) $ 180 | assertEqual ("File parsed but values didn't match: " ++ fp) val v 181 | else putStrLn $ "\nSkipping missing file " ++ fp 182 | 183 | ------------------------------------------------------------------------------ 184 | -- | Data structure that holds all the values needed for a golden test 185 | data GoldenTest a = GoldenTest 186 | { gtTestVal :: a 187 | , gtValName :: String 188 | , gtSerializationName :: String 189 | , gtPrism :: APrism' ByteString a 190 | , gtVersion :: Version a 191 | } 192 | 193 | ------------------------------------------------------------------------------ 194 | -- | Constructs the FilePath where the serialization will be stored (relative to 195 | -- the base directory defined in ArmorConfig). 196 | -- 197 | -- This function uses typeOf as a part of the directory hierarchy to 198 | -- disambiguate tests for different data types. typeOf can contain single 199 | -- quotes, spaces, and parenthesis in the case of type constructors that have 200 | -- type variables so we only take the first alphanumeric characters so that the 201 | -- paths will be meaningful to humans and then add four characters of the type's 202 | -- hash for disambiguation. 203 | goldenFilePath :: Typeable a => GoldenTest a -> FilePath 204 | goldenFilePath gt = 205 | (concat [takeWhile isAlpha ty, "-", h]) 206 | gtSerializationName gt 207 | printf "%s-%03d.test" (gtValName gt) (unVersion $ gtVersion gt) 208 | where 209 | ty = show $ typeOf $ gtTestVal gt 210 | h = take 4 $ showHex (abs $ hash ty) "" 211 | -------------------------------------------------------------------------------- /test/AppA.lhs: -------------------------------------------------------------------------------- 1 | The easiest way to explain this package is to walk through a case study of using 2 | it. This is a literate Haskell file in the test suite, so let's get some imports 3 | out of the way first. 4 | 5 | > {-# LANGUAGE DeriveGeneric #-} 6 | > 7 | > module AppA where 8 | > 9 | > ------------------------------------------------------------------------------ 10 | > import Armor 11 | > import Control.Lens 12 | > import Data.Aeson 13 | > import Data.ByteString (ByteString) 14 | > import Data.ByteString.Lazy (fromStrict, toStrict) 15 | > import qualified Data.Map as M 16 | > import qualified Data.Text as T 17 | > import Data.Text.Encoding 18 | > import Data.Typeable 19 | > import GHC.Generics 20 | > import Text.Read 21 | > ------------------------------------------------------------------------------ 22 | 23 | Imagine you have the following data types: 24 | 25 | > data Employee = Employee 26 | > { employeeFirstName :: String 27 | > , employeeLastName :: String 28 | > , employeeTenure :: Int 29 | > } deriving (Eq, Ord, Show, Read, Typeable, Generic) 30 | > 31 | > data EmployeeLevel = Executive | Manager | Worker 32 | > deriving (Eq, Ord, Show, Read, Typeable, Generic) 33 | 34 | Ignore this for now. It's just here for testing. 35 | 36 | You want to store this data in your database as a serialized JSON blob. (That 37 | might not very plausible for this example, but it's definitely a fairly common 38 | thing, so suspend disbelief for a moment.) 39 | 40 | > instance FromJSON Employee 41 | > instance ToJSON Employee 42 | > 43 | > instance FromJSON EmployeeLevel 44 | > instance ToJSON EmployeeLevel 45 | 46 | Now, to use the armor package you need to define an `Armored` instance for your 47 | data type. To do that you need to define two things. A version number and a list 48 | of serializations you want armored. We'll discuss the serializations in more 49 | detail below. 50 | 51 | One notable point about the serializations is that we need to be able to create 52 | a unique identifier for them later. So armor requires a `Map String (APrism' 53 | ByteString a)` where the `String` is a unique and hopefully meaningful 54 | identifier for this serialization. 55 | 56 | > instance Armored Employee where 57 | > version = Version 0 58 | > serializations = M.fromList 59 | > [ ("show", showPrism) 60 | > , ("aeson", aesonPrism) 61 | > ] 62 | > 63 | > instance Armored EmployeeLevel where 64 | > version = Version 0 65 | > serializations = M.fromList 66 | > [ ("show", showPrism) 67 | > , ("aeson", aesonPrism) 68 | > ] 69 | 70 | This tutorial is a part of the armor test suite, and since we don't want armor 71 | to depend on any specific serialization packages we're using Show as an example 72 | of how armor supports any number of serializations. 73 | 74 | A serialization is simply a pair of a serialization function that converts your 75 | data type to ByteString and a deserialization function that converts a 76 | ByteString to a Maybe of your data type. If you're familiar with the lens 77 | package, this is a prism, so that's what we use here. 78 | 79 | > showPrism :: (Read a, Show a) => Prism' ByteString a 80 | > showPrism = 81 | > prism' (encodeUtf8 . T.pack . show) (readMaybe . T.unpack . decodeUtf8) 82 | > 83 | > aesonPrism :: (FromJSON a, ToJSON a) => Prism' ByteString a 84 | > aesonPrism = 85 | > prism' (toStrict . encode) (decode . fromStrict) 86 | > 87 | 88 | Once you have defined your `Armored` instances, the next step is to define your 89 | tests. To see an example of that go here: 90 | 91 | https://github.com/mightybyte/armor/blob/master/test/TestAppA.lhs 92 | -------------------------------------------------------------------------------- /test/AppB.lhs: -------------------------------------------------------------------------------- 1 | > {-# LANGUAGE DeriveGeneric #-} 2 | > 3 | > module AppB where 4 | > 5 | > ------------------------------------------------------------------------------ 6 | > import Armor 7 | > import Data.Aeson 8 | > import qualified Data.Map as M 9 | > import Data.Typeable 10 | > import GHC.Generics 11 | > ------------------------------------------------------------------------------ 12 | > import AppA (showPrism, aesonPrism) 13 | > ------------------------------------------------------------------------------ 14 | 15 | Time goes by and we discover we need to add a new field to Employee. Since we 16 | care about backwards compatibility and there isn't a reasonable default for the 17 | age field, we add it as a Maybe. 18 | 19 | > data Employee = Employee 20 | > { employeeFirstName :: String 21 | > , employeeLastName :: String 22 | > , employeeTenure :: Int 23 | > , employeeAge :: Maybe Int 24 | > } deriving (Eq, Ord, Show, Read, Typeable, Generic) 25 | 26 | The EmployeeLevel data type stays the same. 27 | 28 | > data EmployeeLevel = Executive | Manager | Worker 29 | > deriving (Eq, Ord, Show, Read, Typeable, Generic) 30 | > 31 | > instance FromJSON Employee 32 | > instance ToJSON Employee 33 | > 34 | > instance FromJSON EmployeeLevel 35 | > instance ToJSON EmployeeLevel 36 | 37 | We update the `Armored` instance to version 1. If you forget to update the 38 | version, the armor tests should still fail because the existing version 0 39 | serialization files will not be overwritten. 40 | 41 | NOTE / TODO: In the future we may be able to have explicit checking for this 42 | situation and have special alerts to change the version number. 43 | 44 | > instance Armored Employee where 45 | > version = Version 1 46 | > serializations = M.fromList 47 | > [ ("show", showPrism) 48 | > , ("aeson", aesonPrism) 49 | > ] 50 | > 51 | > instance Armored EmployeeLevel where 52 | > version = Version 0 53 | > serializations = M.fromList 54 | > [ ("show", showPrism) 55 | > , ("aeson", aesonPrism) 56 | > ] 57 | 58 | Now go to the TestAppB module to see how we update the tests for the new field. 59 | 60 | https://github.com/mightybyte/armor/blob/master/test/TestAppB.lhs 61 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | ------------------------------------------------------------------------------ 4 | import Armor 5 | import Control.Monad 6 | import System.Directory 7 | import Test.HUnit 8 | import Test.Hspec 9 | ------------------------------------------------------------------------------ 10 | import TestAppA 11 | import TestAppB 12 | ------------------------------------------------------------------------------ 13 | 14 | conf :: ArmorConfig 15 | conf = defArmorConfig 16 | 17 | main :: IO () 18 | main = do 19 | exists <- doesDirectoryExist (acStoreDir conf) 20 | when exists $ removeDirectoryRecursive (acStoreDir conf) 21 | acount <- runTestTT (aTests conf) 22 | bcount <- runTestTT (bTests conf) 23 | putStrLn $ "A: " ++ showCounts acount 24 | putStrLn $ "B: " ++ showCounts bcount 25 | hspec $ describe "armor tests" $ do 26 | it "correctly handles AppA" $ 27 | Counts 8 8 0 0 == acount 28 | it "correctly handles AppB" $ 29 | Counts 10 10 0 1 == bcount 30 | removeDirectoryRecursive (acStoreDir conf) 31 | 32 | -------------------------------------------------------------------------------- /test/TestAppA.lhs: -------------------------------------------------------------------------------- 1 | > module TestAppA where 2 | > 3 | > ------------------------------------------------------------------------------ 4 | > import Test.HUnit 5 | > import qualified Data.Map as M 6 | > ------------------------------------------------------------------------------ 7 | > import Armor 8 | > import AppA 9 | > ------------------------------------------------------------------------------ 10 | 11 | To actually enable the armoring of your data types, write tests as follows: 12 | 13 | > aTests :: ArmorConfig -> Test 14 | > aTests ac = TestList 15 | > [ testArmor ac "e1" (Employee "Bob" "Smith" 5) 16 | > , testArmorMany ac $ M.fromList 17 | > [("e", Executive) , ("m", Manager) , ("w", Worker)] 18 | > ] 19 | 20 | See the documentation for the `testArmor` function for more detailed information. 21 | 22 | With the above tests in your app, you'll see that a number of `.test` files will 23 | be automatically created that store the serialized data and are used to check 24 | that they can be correctly parsed. Eventually you'll need to change the data 25 | type in some way. See this file for a case study of how that might play out: 26 | 27 | https://github.com/mightybyte/armor/blob/master/test/AppB.lhs 28 | -------------------------------------------------------------------------------- /test/TestAppB.lhs: -------------------------------------------------------------------------------- 1 | > module TestAppB where 2 | > 3 | > ------------------------------------------------------------------------------ 4 | > import Test.HUnit 5 | > import qualified Data.Map as M 6 | > ------------------------------------------------------------------------------ 7 | > import Armor 8 | > import AppB 9 | > ------------------------------------------------------------------------------ 10 | 11 | Since the new field is a Maybe, we update the old test with a Nothing value 12 | because that's what we expect the serialization to do. We also add a new test 13 | exercising the new field. This test should have a new value ID so it gets a 14 | different `.test` file. 15 | 16 | > bTests :: ArmorConfig -> Test 17 | > bTests ac = TestList 18 | > [ testArmor ac "e1" (Employee "Bob" "Smith" 5 Nothing) 19 | > , testArmor ac "e2" (Employee "Jane" "Doe" 8 (Just 33)) 20 | > , testArmorMany ac $ M.fromList 21 | > [("e", Executive) , ("m", Manager) , ("w", Worker)] 22 | > ] 23 | 24 | These new tests will pass for the aeson serialization because the generic aeson 25 | deserialization functions will interpret the absence of the age field as a 26 | Nothing. The show serialization will fail because Read for the new data type 27 | requires the age field to be present. 28 | --------------------------------------------------------------------------------