packages feed

armor (empty) → 0.1

raw patch · 10 files changed

+506/−0 lines, 10 filesdep +HUnitdep +aesondep +armorsetup-changed

Dependencies added: HUnit, aeson, armor, base, bytestring, containers, directory, filepath, hspec, lens, text

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for armor++## 0.1      -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2017, Doug Beardsley+Copyright (c) 2017, Formation Inc.+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 Doug Beardsley nor the names of its other 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ armor.cabal view
@@ -0,0 +1,69 @@+name:                armor+version:             0.1+synopsis:            Armor data structures against serialization backwards compatibility problems+description:         Tests the serialization backwards compatibility of data types by storing+                     serialized representations in .test files to be checked into your project's+                     version control.+license:             BSD3+license-file:        LICENSE+author:              Doug Beardsley+maintainer:          mightybyte@gmail.com+copyright:           Doug Beardsley, Formation Inc.+homepage:            https://github.com/mightybyte/armor+bug-reports:         https://github.com/mightybyte/armor/issues+category:            Data+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10+tested-with:+  GHC==7.10.3,+  GHC==8.0.2,+  GHC==8.2.1,+  GHC==8.4.1++Source-repository head+  Type:     git+  Location: https://github.com/mightybyte/armor.git++library+  exposed-modules:+    Armor++  hs-source-dirs:      src+  ghc-options: -Wall+  build-depends:+    HUnit      >= 1.5  && < 1.7,+    base       >= 4.6  && < 4.12,+    bytestring >= 0.10 && < 0.11,+    containers >= 0.5  && < 0.6,+    directory  >= 1.2  && < 1.4,+    filepath   >= 1.4  && < 1.5,+    lens       >= 4.16 && < 4.17++  default-language:    Haskell2010++test-suite testsuite+  hs-source-dirs: test+  type: exitcode-stdio-1.0+  main-is: Main.hs++  other-modules:+    AppA+    AppB+    TestAppA+    TestAppB++  ghc-options: -Wall+  build-depends:+    HUnit,+    aeson        >= 1.0 && < 1.3,+    armor,+    base,+    bytestring,+    containers,+    directory,+    hspec        >= 2.4 && < 2.5,+    lens,+    text         >= 1.2 && < 1.3++  default-language:    Haskell2010
+ src/Armor.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Armor+  ( Version(..)+  , Armored(..)+  , ArmorConfig(..)+  , defArmorConfig+  , testArmor+  , testArmorMany+  ) where++------------------------------------------------------------------------------+import           Control.Lens+import           Control.Monad+import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import           Data.Map        (Map)+import qualified Data.Map        as M+import           Data.Typeable+#if !MIN_VERSION_base(4,8,0)+import           Data.Word+#endif+import           System.Directory+import           System.FilePath+import           Test.HUnit.Base+import           Text.Printf+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Version numbers are simple monotonically increasing positive integers.+newtype Version a = Version { unVersion :: Word }+  deriving (Eq,Ord,Show,Read)+++------------------------------------------------------------------------------+-- | Core type class for armoring types.  Includes a version and all the+-- type's serializations that you want to armor.+class Armored a where+  -- | Current version number for the data type.+  version :: Version a+  -- | Map of serializations keyed by a unique ID used to refer to each+  -- serialization. A serialization is a tuple of @(a -> ByteString)@ and+  -- @(ByteString -> Maybe a)@. Represented here as a prism.+  serializations :: Map String (APrism' ByteString a)+++------------------------------------------------------------------------------+-- | The mode of operation for armor test cases.+data ArmorMode+  = SaveOnly+    -- ^ Write test files for serializations that don't have them, but don't+    -- do any tests to verify that existing files are deserialized properly.+  | TestOnly+    -- ^ Run tests to verify that existing files are deserialized properly,+    -- but don't write any missing files.+  | SaveAndTest+    -- ^ Do both the save and test phases.+  deriving (Eq,Ord,Show,Read,Enum,Bounded)+++------------------------------------------------------------------------------+-- | Config data for armor tests.+data ArmorConfig = ArmorConfig+    { acArmorMode   :: ArmorMode+    , acStoreDir    :: FilePath+    -- ^ Directory where all the test serializations are stored.+    , acNumVersions :: Maybe Word+    -- ^ How many versions back to test for backwards compatibility.  A value+    -- of @Just 0@ means that it only tests that the current version satisfies+    -- @parse . render == id@.  @Just 1@ means that it will verify that the+    -- previous version can still be parse.  @Just 2@ the previous two+    -- versions, etc.  Nothing means that all versions will be tested.+    }+++------------------------------------------------------------------------------+-- | Default value for ArmorConfig.+defArmorConfig :: ArmorConfig+defArmorConfig = ArmorConfig SaveAndTest "test-data" Nothing+++------------------------------------------------------------------------------+-- | Tests the serialization backwards compatibility of a data type by storing+-- serialized representations in .test files to be checked into your project's+-- version control.+--+-- First, this function checks the directory 'acStoreDir' for the existence of+-- a file @foo-000.test@.  If it doesn't exist, it creates it for each+-- serialization with the serialized representation of the val parameter.+--+-- Next, it checks that the serialized formats in the most recent+-- 'acNumVersions' of the stored @.test@ files are parsable by the current+-- version of the serialization.+testArmor+    :: (Eq a, Show a, Typeable a, Armored a)+    => ArmorConfig+    -> String+    -> a+    -> Test+testArmor ac valId val =+    TestList [ testIt s | s <- M.toList serializations ]+  where+    testIt s = test (testSerialization ac valId val s)+++------------------------------------------------------------------------------+-- Same as 'testArmor', but more convenient for testing several values of the+-- same type.+testArmorMany+    :: (Eq a, Show a, Typeable a, Armored a)+    => ArmorConfig+    -> Map String a+    -> Test+testArmorMany ac valMap = TestList $ map doOne $ M.toList valMap+  where+    doOne (k,v) = TestLabel k $ testArmor ac k v+++------------------------------------------------------------------------------+testSerialization+    :: forall a. (Eq a, Show a, Typeable a, Armored a)+    => ArmorConfig+    -> String+    -> a+    -> (String, APrism' ByteString a)+    -> Assertion+testSerialization ac valId val s@(_,p) = do+    let d = getVersionDir ac val s+        f = getVersionFilename valId curVer+        fp = d </> f+    when (acArmorMode ac /= TestOnly) $ do+      createDirectoryIfMissing True d+      fileExists <- doesFileExist fp+      when (not fileExists) $+        B.writeFile fp (review (clonePrism p) val)+    when (acArmorMode ac /= SaveOnly) $ do+      mapM_ (assertVersionParses d . Version) vs+  where+    curVer :: Version a+    curVer = version+    vs = reverse [maybe 0 (unVersion curVer -) (acNumVersions ac) .. unVersion curVer]+    assertVersionParses d ver = do+        let f = getVersionFilename valId ver+            fp = d </> f+        exists <- doesFileExist fp+        if exists+          then do bs <- B.readFile fp+                  case preview (clonePrism p) bs of+                    Nothing -> assertFailure $+                      printf "Not backwards compatible with version %d: %s"+                             (unVersion ver) fp+                    Just v -> assertEqual ("File parsed but values didn't match: " ++ fp) val v+          else putStrLn $ "\nSkipping missing file " ++ fp+++------------------------------------------------------------------------------+getVersionFilename :: String -> Version a -> String+getVersionFilename valId ver = printf "%s-%03d.test" valId (unVersion ver)+++------------------------------------------------------------------------------+getVersionDir :: Typeable a => ArmorConfig -> a -> (FilePath, t) -> FilePath+getVersionDir ac val (nm,_) = acStoreDir ac </> show (typeOf val) </> nm
+ test/AppA.lhs view
@@ -0,0 +1,91 @@+The easiest way to explain this package is to walk through a case study of using+it. This is a literate Haskell file in the test suite, so let's get some imports+out of the way first.++> {-# LANGUAGE DeriveGeneric #-}+>+> module AppA where+>+> ------------------------------------------------------------------------------+> import           Armor+> import           Control.Lens+> import           Data.Aeson+> import           Data.ByteString      (ByteString)+> import           Data.ByteString.Lazy (fromStrict, toStrict)+> import qualified Data.Map             as M+> import qualified Data.Text            as T+> import           Data.Text.Encoding+> import           Data.Typeable+> import           GHC.Generics+> import           Text.Read+> ------------------------------------------------------------------------------++Imagine you have the following data types:++> data Employee = Employee+>     { employeeFirstName :: String+>     , employeeLastName  :: String+>     , employeeTenure    :: Int+>     } deriving (Eq, Ord, Show, Read, Typeable, Generic)+>+> data EmployeeLevel = Executive | Manager | Worker+>   deriving (Eq, Ord, Show, Read, Typeable, Generic)++Ignore this for now.  It's just here for testing.++You want to store this data in your database as a serialized JSON blob. (That+might not very plausible for this example, but it's definitely a fairly common+thing, so suspend disbelief for a moment.)++> instance FromJSON Employee+> instance ToJSON Employee+>+> instance FromJSON EmployeeLevel+> instance ToJSON EmployeeLevel++Now, to use the armor package you need to define an `Armored` instance for your+data type. To do that you need to define two things. A version number and a list+of serializations you want armored. We'll discuss the serializations in more+detail below.++One notable point about the serializations is that we need to be able to create+a unique identifier for them later. So armor requires a `Map String (APrism'+ByteString a)` where the `String` is a unique and hopefully meaningful+identifier for this serialization.++> instance Armored Employee where+>     version = Version 0+>     serializations = M.fromList+>         [ ("show", showPrism)+>         , ("aeson", aesonPrism)+>         ]+>+> instance Armored EmployeeLevel where+>     version = Version 0+>     serializations = M.fromList+>         [ ("show", showPrism)+>         , ("aeson", aesonPrism)+>         ]++This tutorial is a part of the armor test suite, and since we don't want armor+to depend on any specific serialization packages we're using Show as an example+of how armor supports any number of serialiaztions.++A serialization is simply a pair of a serialization function that converts your+data type to ByteString and a deserialization function that converts a+ByteString to a Maybe of your data type. If you're familiar with the lens+package, this is a prism, so that's what we use here.++> showPrism :: (Read a, Show a) => Prism' ByteString a+> showPrism =+>     prism' (encodeUtf8 . T.pack . show) (readMaybe . T.unpack . decodeUtf8)+>+> aesonPrism :: (FromJSON a, ToJSON a) => Prism' ByteString a+> aesonPrism =+>     prism' (toStrict . encode) (decode . fromStrict)+>++Once you have defined your `Armored` instances, the next step is to define your+tests.  To see an example of that go here:++https://github.com/TaktInc/armor/blob/master/test/TestAppA.lhs
+ test/AppB.lhs view
@@ -0,0 +1,60 @@+> {-# LANGUAGE DeriveGeneric #-}+>+> module AppB where+>+> ------------------------------------------------------------------------------+> import           Armor+> import           Data.Aeson+> import qualified Data.Map             as M+> import           Data.Typeable+> import           GHC.Generics+> ------------------------------------------------------------------------------+> import           AppA                 (showPrism, aesonPrism)+> ------------------------------------------------------------------------------++Time goes by and we discover we need to add a new field to Employee. Since we+care about backwards compatibility and there isn't a reasonable default for the+age field, we add it as a Maybe.++> data Employee = Employee+>     { employeeFirstName :: String+>     , employeeLastName  :: String+>     , employeeTenure    :: Int+>     , employeeAge       :: Maybe Int+>     } deriving (Eq, Ord, Show, Read, Typeable, Generic)++The EmployeeLevel data type stays the same.++> data EmployeeLevel = Executive | Manager | Worker+>   deriving (Eq, Ord, Show, Read, Typeable, Generic)+>+> instance FromJSON Employee+> instance ToJSON Employee+>+> instance FromJSON EmployeeLevel+> instance ToJSON EmployeeLevel++We update the `Armored` instance to version 1. If you forget to updated the+version, the armor tests should still fail because the existing version 0+serialization files will not be overwritten.++NOTE / TODO: In the future we may be able to have explicit checking for this+situation and have special alerts to change the version number.++> instance Armored Employee where+>     version = Version 1+>     serializations = M.fromList+>         [ ("show", showPrism)+>         , ("aeson", aesonPrism)+>         ]+>+> instance Armored EmployeeLevel where+>     version = Version 0+>     serializations = M.fromList+>         [ ("show", showPrism)+>         , ("aeson", aesonPrism)+>         ]++Now go to the TestAppB module to see how we update the tests for the new field.++https://github.com/TaktInc/armor/blob/master/test/TestAppB.lhs
+ test/Main.hs view
@@ -0,0 +1,31 @@+module Main where++------------------------------------------------------------------------------+import           Armor+import           Control.Monad+import           System.Directory+import           Test.HUnit+import           Test.Hspec+------------------------------------------------------------------------------+import           TestAppA+import           TestAppB+------------------------------------------------------------------------------++conf :: ArmorConfig+conf = defArmorConfig++main :: IO ()+main = do+    exists <- doesDirectoryExist (acStoreDir conf)+    when exists $ removeDirectoryRecursive (acStoreDir conf)+    acount <- runTestTT (aTests conf)+    bcount <- runTestTT (bTests conf)+    putStrLn $ "A: " ++ showCounts acount+    putStrLn $ "B: " ++ showCounts bcount+    hspec $ describe "armor tests" $ do+      it "correctly handles AppA" $+        Counts 8 8 0 0 == acount+      it "correctly handles AppB" $+        Counts 10 10 0 1 == bcount+    removeDirectoryRecursive (acStoreDir conf)+
+ test/TestAppA.lhs view
@@ -0,0 +1,27 @@+> module TestAppA where+>+> ------------------------------------------------------------------------------+> import           Test.HUnit+> import qualified Data.Map        as M+> ------------------------------------------------------------------------------+> import           Armor+> import           AppA+> ------------------------------------------------------------------------------++To actually enable the armoring of your data types, write tests as follows:++> aTests :: ArmorConfig -> Test+> aTests ac = TestList+>     [ testArmor ac "e1" (Employee "Bob" "Smith" 5)+>     , testArmorMany ac $ M.fromList+>         [("e", Executive) , ("m", Manager) , ("w", Worker)]+>     ]++See the documentation for the `testArmor` function for more detailed information.++With the above tests in your app, you'll see that a number of `.test` files will+be automatically created that store the serialized data and are used to check+that they can be correctly parsed.  Eventually you'll need to change the data+type in some way.  See this file for a case study of how that might play out:++https://github.com/TaktInc/armor/blob/master/test/AppB.lhs
+ test/TestAppB.lhs view
@@ -0,0 +1,27 @@+> module TestAppB where+>+> ------------------------------------------------------------------------------+> import           Test.HUnit+> import qualified Data.Map        as M+> ------------------------------------------------------------------------------+> import           Armor+> import           AppB+> ------------------------------------------------------------------------------++Since the new field is a Maybe, we update the old test with a Nothing value+because that's what we expect the serialization to do.  We also add a new test+exercising the new field.  This test should have a new value ID so it gets a+different `.test` file.++> bTests :: ArmorConfig -> Test+> bTests ac = TestList+>     [ testArmor ac "e1" (Employee "Bob" "Smith" 5 Nothing)+>     , testArmor ac "e2" (Employee "Jane" "Doe" 8 (Just 33))+>     , testArmorMany ac $ M.fromList+>         [("e", Executive) , ("m", Manager) , ("w", Worker)]+>     ]++These new tests will pass for the aeson serialization because the generic aeson+deserialization functions will interpret the absence of the age field as a+Nothing. The show serialization will fail because Read for the new data type+requires the age field to be present.