acid-state-0.16.0.1/0000755000000000000000000000000013660647235012155 5ustar0000000000000000acid-state-0.16.0.1/acid-state.cabal0000644000000000000000000001407713660647235015170 0ustar0000000000000000Name: acid-state Version: 0.16.0.1 Synopsis: Add ACID guarantees to any serializable Haskell data structure. Description: Use regular Haskell data structures as your database and get stronger ACID guarantees than most RDBMS offer. Homepage: https://github.com/acid-state/acid-state License: PublicDomain Author: David Himmelstrup Maintainer: Lemmih -- Copyright: Category: Database Build-type: Simple Cabal-version: >=1.10 tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.3, GHC == 8.8.3, GHC == 8.10.1 Extra-source-files: CHANGELOG.md test-state/OldStateTest1/*.log test-state/OldStateTest1/*.version test-state/OldStateTest2/*.log test-state/OldStateTest2/*.version test-state/OldStateTest3/*.log test-state/OldStateTest3/*.version Source-repository head type: git location: https://github.com/acid-state/acid-state flag skip-state-machine-test description: If enabled, do not build/run the state-machine test default: False manual: True Library Exposed-Modules: Data.Acid, Data.Acid.Archive, Data.Acid.Common, Data.Acid.Local, Data.Acid.Memory, Data.Acid.Memory.Pure, Data.Acid.Remote, Data.Acid.Advanced, Data.Acid.Log, Data.Acid.CRC, Data.Acid.Abstract, Data.Acid.Core, Data.Acid.TemplateHaskell Data.Acid.Repair Other-modules: Paths_acid_state, FileIO Build-depends: array, base >= 4.5.1.0 && < 5, bytestring >= 0.10.2, cereal >= 0.4.1.0, containers, safecopy >= 0.6 && < 0.11, stm >= 2.4, directory, filelock, filepath, mtl, network < 3.2, network-bsd, template-haskell < 2.17, th-expand-syns if os(windows) Build-depends: Win32 else Build-depends: unix Hs-Source-Dirs: src/ if os(windows) Hs-Source-Dirs: src-win32/ else Hs-Source-Dirs: src-unix/ default-language: Haskell2010 GHC-Options: -fwarn-unused-imports -fwarn-unused-binds executable acid-state-repair hs-source-dirs: repair build-depends: acid-state , base , directory main-is: Main.hs default-language: Haskell2010 test-suite specs type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs build-depends: base , acid-state , deepseq , hspec , hspec-discover , mtl , safecopy , template-haskell build-tool-depends: hspec-discover:hspec-discover ghc-options: -threaded -rtsopts -with-rtsopts=-N other-modules: Data.Acid.TemplateHaskellSpec default-language: Haskell2010 test-suite state-machine type: exitcode-stdio-1.0 hs-source-dirs: test main-is: StateMachine.hs build-depends: base , acid-state , containers , deepseq >= 1.4.0.0 , directory , hedgehog , mtl , safecopy ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall other-modules: Data.Acid.KeyValueStateMachine Data.Acid.StateMachineTest default-language: Haskell2010 if flag(skip-state-machine-test) buildable: False test-suite examples type: exitcode-stdio-1.0 hs-source-dirs: examples examples/errors main-is: Examples.hs build-depends: base , acid-state , cereal , containers , directory , mtl , network , safecopy , text , time ghc-options: -threaded -rtsopts -with-rtsopts=-N other-modules: ChangeState ChangeVersion CheckpointCutsEvent Exceptions HelloDatabase HelloWorld HelloWorldNoTH KeyValue KeyValueNoTH MonadStateConstraint ParameterisedState RemoteClient RemoteCommon RemoteServer RemoveEvent SlowCheckpoint StressTest StressTestNoTH if !os(windows) other-modules: Proxy default-language: Haskell2010 benchmark loading-benchmark type: exitcode-stdio-1.0 hs-source-dirs: benchmarks/loading main-is: Benchmark.hs other-modules: Benchmark.FileSystem Benchmark.Model Benchmark.Prelude build-depends: random, directory, system-fileio == 0.3.*, system-filepath, criterion >= 1.0.0.0 && < 1.6, mtl, base, acid-state default-language: Haskell2010 default-extensions: PatternGuards GADTs StandaloneDeriving MultiParamTypeClasses ScopedTypeVariables FlexibleInstances TypeFamilies TypeOperators FlexibleContexts NoImplicitPrelude EmptyDataDecls DataKinds NoMonomorphismRestriction RankNTypes ConstraintKinds DefaultSignatures TupleSections TemplateHaskell OverloadedStrings DeriveDataTypeable ghc-options: -O2 acid-state-0.16.0.1/Setup.hs0000644000000000000000000000005613660647235013612 0ustar0000000000000000import Distribution.Simple main = defaultMain acid-state-0.16.0.1/CHANGELOG.md0000644000000000000000000000334713660647235013775 0ustar00000000000000000.15.0 ====== - change text of error messages to include module names ([#116](https://github.com/acid-state/acid-state/pull/116)) - depend on filelock library to avoid locking bug ([#91](https://github.com/acid-state/acid-state/pull/91)) - permit events that are polymorphic in the base monad, with a MonadReader/MonadState constraint ([#94](https://github.com/acid-state/acid-state/pull/94)) - fix a minor memory leak ([#104](https://github.com/acid-state/acid-state/pull/104)) - add a test suite and extend examples ([#98](https://github.com/acid-state/acid-state/pull/98)) - improve benchmarks ([#113](https://github.com/acid-state/acid-state/pull/113)) - expose internal modules (subject to change in the future) 0.14.3 ====== - support building on GHC 8.2 - update links from seize.it to github.com 0.14.2 ====== - createCheckpoint now cuts a new events file ([#74](https://github.com/acid-state/acid-state/pull/74)) 0.14.1 ====== - fix bug in archiveLog that resulted in logs being moved prematurely ([#22](https://github.com/acid-state/acid-state/issues/22)) - tweaks for GHC 8.0.x, template-haskell 2.11.x - fix compilation of benchmarks 0.14.0 ====== - fixes for cereal 0.5 while maintaining cereal 0.4 compatibility. IMPORTANT: cereal 0.5 / safecopy 0.9 change the serialization format of Float/Double. Migration should be performed automatically on old data. However, you should be aware that once you upgrade to safecopy 0.9 / cereal 0.5, your data will be migrated and not readable by older versions of your application which are compiled against safecopy 0.8 / cereal 0.4. - additional fixes for TH and kinded type variables ([#56](https://github.com/acid-state/acid-state/pull/56)) acid-state-0.16.0.1/test-state/0000755000000000000000000000000013660647235014252 5ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest1/0000755000000000000000000000000013660647235016712 5ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest1/events.version0000644000000000000000000000000613660647235021621 0ustar00000000000000000.15.0acid-state-0.16.0.1/test-state/OldStateTest1/checkpoints.version0000644000000000000000000000000613660647235022627 0ustar00000000000000000.15.0acid-state-0.16.0.1/test-state/OldStateTest1/events-0000000000.log0000644000000000000000000021347613660647235021753 0ustar0000000000000000f&(Data.Acid.KeyValueStateMachine.InsertKey" 2JU )Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U2)Data.Acid.KeyValueStateMachine.ReverseKeydE(Data.Acid.KeyValueStateMachine.InsertKey h(Data.Acid.KeyValueStateMachine.InsertKey$5lFkU)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyg{|(Data.Acid.KeyValueStateMachine.InsertKey#m7dU )Data.Acid.KeyValueStateMachine.ReverseKeyg3(Data.Acid.KeyValueStateMachine.InsertKey# OWldu(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyeS(Data.Acid.KeyValueStateMachine.InsertKey! 9hn(Data.Acid.KeyValueStateMachine.InsertKey$cqtkU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey j/S(Data.Acid.KeyValueStateMachine.InsertKey&3GlNkiU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey h(Data.Acid.KeyValueStateMachine.InsertKey$knGRmE(Data.Acid.KeyValueStateMachine.InsertKey) JL5AFp7EgkN^(Data.Acid.KeyValueStateMachine.InsertKey'Y7d0R1aU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) VkoQsoo7Je#(Data.Acid.KeyValueStateMachine.InsertKey!IU2)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyj(Data.Acid.KeyValueStateMachine.InsertKey& EsHYW5n(Data.Acid.KeyValueStateMachine.InsertKey* T2erRC81fIlW(Data.Acid.KeyValueStateMachine.InsertKey( LXb2ae9ii(Data.Acid.KeyValueStateMachine.InsertKey%uSB8uj;(Data.Acid.KeyValueStateMachine.InsertKey&HbCZLYd(Data.Acid.KeyValueStateMachine.InsertKey g(Data.Acid.KeyValueStateMachine.InsertKey#iUZU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey nr(Data.Acid.KeyValueStateMachine.InsertKey* sPoKP9mg4Nkk(Data.Acid.KeyValueStateMachine.InsertKey'MT5L7BSdE(Data.Acid.KeyValueStateMachine.InsertKey e(Data.Acid.KeyValueStateMachine.InsertKey!qk(Data.Acid.KeyValueStateMachine.InsertKey'kZziBzWU )Data.Acid.KeyValueStateMachine.ReverseKeyl(Data.Acid.KeyValueStateMachine.InsertKey(DEce4pBIU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyj;<(Data.Acid.KeyValueStateMachine.InsertKey& VJtNOwj(Data.Acid.KeyValueStateMachine.InsertKey&0dy1AIU2)Data.Acid.KeyValueStateMachine.ReverseKeydU(Data.Acid.KeyValueStateMachine.InsertKey U )Data.Acid.KeyValueStateMachine.ReverseKeyd5(Data.Acid.KeyValueStateMachine.InsertKey i}y(Data.Acid.KeyValueStateMachine.InsertKey%cJuuefP(Data.Acid.KeyValueStateMachine.InsertKey" 6sk(Data.Acid.KeyValueStateMachine.InsertKey'qImoN8Uj(Data.Acid.KeyValueStateMachine.InsertKey&Xu93W0iq(Data.Acid.KeyValueStateMachine.InsertKey%DOWkZg((Data.Acid.KeyValueStateMachine.InsertKey#OGPU)Data.Acid.KeyValueStateMachine.ReverseKeyjaG(Data.Acid.KeyValueStateMachine.InsertKey&BKiQQhUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyd(Data.Acid.KeyValueStateMachine.InsertKey k(Data.Acid.KeyValueStateMachine.InsertKey' cYttlmVU2)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey f(Data.Acid.KeyValueStateMachine.InsertKey"khiz(Data.Acid.KeyValueStateMachine.InsertKey%TeAX4Ux)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) 2OQbmTzJcg(Data.Acid.KeyValueStateMachine.InsertKey#IcxU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyg=(Data.Acid.KeyValueStateMachine.InsertKey#74rU)Data.Acid.KeyValueStateMachine.ReverseKeyk](Data.Acid.KeyValueStateMachine.InsertKey'6dMPuPCdU(Data.Acid.KeyValueStateMachine.InsertKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyn6(Data.Acid.KeyValueStateMachine.InsertKey* CLrCCGYOVql+(Data.Acid.KeyValueStateMachine.InsertKey(v4dPqNYrU2)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyhڝ(Data.Acid.KeyValueStateMachine.InsertKey$XoyekI(Data.Acid.KeyValueStateMachine.InsertKey'ZZw5iQkUhJ)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey U )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyfH(Data.Acid.KeyValueStateMachine.InsertKey"LyU)Data.Acid.KeyValueStateMachine.ReverseKeyh0(Data.Acid.KeyValueStateMachine.InsertKey$Pp1vi&(Data.Acid.KeyValueStateMachine.InsertKey%RK7omh=r(Data.Acid.KeyValueStateMachine.InsertKey$89vFU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeym5-(Data.Acid.KeyValueStateMachine.InsertKey) Tf0KQuwOfh@(Data.Acid.KeyValueStateMachine.InsertKey$C84TkQU(Data.Acid.KeyValueStateMachine.InsertKey'RF7YpGqm(Data.Acid.KeyValueStateMachine.InsertKey) MECtTMbKrU)Data.Acid.KeyValueStateMachine.ReverseKeykf(Data.Acid.KeyValueStateMachine.InsertKey'NZtOErOUx)Data.Acid.KeyValueStateMachine.ReverseKey jk7(Data.Acid.KeyValueStateMachine.InsertKey& 3auX2dh+@(Data.Acid.KeyValueStateMachine.InsertKey$yKBWU)Data.Acid.KeyValueStateMachine.ReverseKeyf2(Data.Acid.KeyValueStateMachine.InsertKey"3wU)Data.Acid.KeyValueStateMachine.ReverseKeyns(Data.Acid.KeyValueStateMachine.InsertKey* An5PcEU6WKj0(Data.Acid.KeyValueStateMachine.InsertKey&Uyv8R6U)Data.Acid.KeyValueStateMachine.ReverseKeygj=(Data.Acid.KeyValueStateMachine.InsertKey#cKon(Data.Acid.KeyValueStateMachine.InsertKey* nvQrOaxRgnjz(Data.Acid.KeyValueStateMachine.InsertKey&kYglm8U)Data.Acid.KeyValueStateMachine.ReverseKeyn(Data.Acid.KeyValueStateMachine.InsertKey* 1TXcS71qgpk=(Data.Acid.KeyValueStateMachine.InsertKey' Ydxf6eWU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyl>(Data.Acid.KeyValueStateMachine.InsertKey(HUY9z2ZpgQ(Data.Acid.KeyValueStateMachine.InsertKey#2oXf(Data.Acid.KeyValueStateMachine.InsertKey"Pym(Data.Acid.KeyValueStateMachine.InsertKey) PJWRDLPY0j(Data.Acid.KeyValueStateMachine.InsertKey&aHUN8gin(Data.Acid.KeyValueStateMachine.InsertKey%qMUsaU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyir(Data.Acid.KeyValueStateMachine.InsertKey%8bMLKU2)Data.Acid.KeyValueStateMachine.ReverseKeyh=((Data.Acid.KeyValueStateMachine.InsertKey$ mO8EUx)Data.Acid.KeyValueStateMachine.ReverseKey d(Data.Acid.KeyValueStateMachine.InsertKey jl(Data.Acid.KeyValueStateMachine.InsertKey&0MYJ2NjG(Data.Acid.KeyValueStateMachine.InsertKey&6yZUxmU2)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyf(Data.Acid.KeyValueStateMachine.InsertKey"ITmj4(Data.Acid.KeyValueStateMachine.InsertKey) 2gpab8BvmU)Data.Acid.KeyValueStateMachine.ReverseKeyf+(Data.Acid.KeyValueStateMachine.InsertKey"CAiW(Data.Acid.KeyValueStateMachine.InsertKey%65ESog(Data.Acid.KeyValueStateMachine.InsertKey#GdzkH(Data.Acid.KeyValueStateMachine.InsertKey' LeHNZS3l?)(Data.Acid.KeyValueStateMachine.InsertKey(exp5E4HCl/O(Data.Acid.KeyValueStateMachine.InsertKey(9oQ1enhMU)Data.Acid.KeyValueStateMachine.ReverseKeyh@t(Data.Acid.KeyValueStateMachine.InsertKey$5OO4U)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey mm(Data.Acid.KeyValueStateMachine.InsertKey) eUkXdEosvU )Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyla(Data.Acid.KeyValueStateMachine.InsertKey(rveLS5pVU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyd(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyn[u(Data.Acid.KeyValueStateMachine.InsertKey* T8xpwR5ZZUU[)Data.Acid.KeyValueStateMachine.ReverseKeyjȮ(Data.Acid.KeyValueStateMachine.InsertKey&EwqZREd(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U )Data.Acid.KeyValueStateMachine.ReverseKeyl(Data.Acid.KeyValueStateMachine.InsertKey( gGMrXC1BU[)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey ib(Data.Acid.KeyValueStateMachine.InsertKey%XCerqU2)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyjF(Data.Acid.KeyValueStateMachine.InsertKey&KGOY70k(Data.Acid.KeyValueStateMachine.InsertKey' iX26B9iU)Data.Acid.KeyValueStateMachine.ReverseKeye (Data.Acid.KeyValueStateMachine.InsertKey!zU2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U )Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey k(Data.Acid.KeyValueStateMachine.InsertKey'0bEPUQEUx)Data.Acid.KeyValueStateMachine.ReverseKey e$(Data.Acid.KeyValueStateMachine.InsertKey!Fg(Data.Acid.KeyValueStateMachine.InsertKey#iE6U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyd5(Data.Acid.KeyValueStateMachine.InsertKey lk(Data.Acid.KeyValueStateMachine.InsertKey(Z2rQrk8xg(Data.Acid.KeyValueStateMachine.InsertKey#XagU)Data.Acid.KeyValueStateMachine.ReverseKeydu(Data.Acid.KeyValueStateMachine.InsertKey eo(Data.Acid.KeyValueStateMachine.InsertKey!TU[)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey m(Data.Acid.KeyValueStateMachine.InsertKey) isJseh7WzU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeye|W(Data.Acid.KeyValueStateMachine.InsertKey!lU2)Data.Acid.KeyValueStateMachine.ReverseKeyfG(Data.Acid.KeyValueStateMachine.InsertKey"oqU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyn(Data.Acid.KeyValueStateMachine.InsertKey* cIb5zwXOsXn7(Data.Acid.KeyValueStateMachine.InsertKey* 29oZzS0UbqmY(Data.Acid.KeyValueStateMachine.InsertKey) 002gB7ILkU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeym#(Data.Acid.KeyValueStateMachine.InsertKey) cP5Q9SKHOjג(Data.Acid.KeyValueStateMachine.InsertKey&cdSS3rgN(Data.Acid.KeyValueStateMachine.InsertKey# V9FU)Data.Acid.KeyValueStateMachine.ReverseKeylp(Data.Acid.KeyValueStateMachine.InsertKey(VQp4RiD7i(Data.Acid.KeyValueStateMachine.InsertKey%quYrbg~2(Data.Acid.KeyValueStateMachine.InsertKey#JgPU[)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey Ux)Data.Acid.KeyValueStateMachine.ReverseKey m,(Data.Acid.KeyValueStateMachine.InsertKey) cTAzQLoYJU[)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyl~(Data.Acid.KeyValueStateMachine.InsertKey(wIqSU7xih&X(Data.Acid.KeyValueStateMachine.InsertKey$k46pgk(Data.Acid.KeyValueStateMachine.InsertKey#TF4f.(Data.Acid.KeyValueStateMachine.InsertKey"mogZ(Data.Acid.KeyValueStateMachine.InsertKey#yw2U )Data.Acid.KeyValueStateMachine.ReverseKeyk(Data.Acid.KeyValueStateMachine.InsertKey'4DvE7zIU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeye (Data.Acid.KeyValueStateMachine.InsertKey!yU )Data.Acid.KeyValueStateMachine.ReverseKeyg8(Data.Acid.KeyValueStateMachine.InsertKey#zFPd5(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyl(Data.Acid.KeyValueStateMachine.InsertKey(xeqh84ezn,(Data.Acid.KeyValueStateMachine.InsertKey* S3a5KHS4s6U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey gZ(Data.Acid.KeyValueStateMachine.InsertKey#NE1mu(Data.Acid.KeyValueStateMachine.InsertKey) IYYn6OHVMU)Data.Acid.KeyValueStateMachine.ReverseKeylA(Data.Acid.KeyValueStateMachine.InsertKey(id8wlzQLU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey Ux)Data.Acid.KeyValueStateMachine.ReverseKey lNF(Data.Acid.KeyValueStateMachine.InsertKey( fK12J7UoU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyes(Data.Acid.KeyValueStateMachine.InsertKey! CU)Data.Acid.KeyValueStateMachine.ReverseKeyjM(Data.Acid.KeyValueStateMachine.InsertKey&CGdI7Tk%(Data.Acid.KeyValueStateMachine.InsertKey'6XfEwKAU2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyhtQ(Data.Acid.KeyValueStateMachine.InsertKey$S5gQU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey e(Data.Acid.KeyValueStateMachine.InsertKey! ol(Data.Acid.KeyValueStateMachine.InsertKey( MtLPKxNiUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U2)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey h(Data.Acid.KeyValueStateMachine.InsertKey$LO8Bh (Data.Acid.KeyValueStateMachine.InsertKey$ MF8dU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyj-(Data.Acid.KeyValueStateMachine.InsertKey&BKG24SU)Data.Acid.KeyValueStateMachine.ReverseKeyhU(Data.Acid.KeyValueStateMachine.InsertKey$ePUHUx)Data.Acid.KeyValueStateMachine.ReverseKey d(Data.Acid.KeyValueStateMachine.InsertKey h<(Data.Acid.KeyValueStateMachine.InsertKey$ 6KGDU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyeg(Data.Acid.KeyValueStateMachine.InsertKey!ql(Data.Acid.KeyValueStateMachine.InsertKey(JpsNo8e3f (Data.Acid.KeyValueStateMachine.InsertKey"Y7U2)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U2)Data.Acid.KeyValueStateMachine.ReverseKeyjO(Data.Acid.KeyValueStateMachine.InsertKey&i5bPs4U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) 1HY9Mrm6CUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyd(Data.Acid.KeyValueStateMachine.InsertKey in>(Data.Acid.KeyValueStateMachine.InsertKey%KrMF5l(Data.Acid.KeyValueStateMachine.InsertKey(pAclOJy2U)Data.Acid.KeyValueStateMachine.ReverseKeyi4(Data.Acid.KeyValueStateMachine.InsertKey%LFukWU)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) 2n4BrSYI4nX(Data.Acid.KeyValueStateMachine.InsertKey* IQoNeApRTJU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyl (Data.Acid.KeyValueStateMachine.InsertKey(eblsY62ad(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyg!(Data.Acid.KeyValueStateMachine.InsertKey#y4an*(Data.Acid.KeyValueStateMachine.InsertKey* 7irHAYmVVOl2'(Data.Acid.KeyValueStateMachine.InsertKey(B0IXt9Ycl0(Data.Acid.KeyValueStateMachine.InsertKey(0gbmMKkFh(Data.Acid.KeyValueStateMachine.InsertKey$a9VVh(Data.Acid.KeyValueStateMachine.InsertKey$znFmf#(Data.Acid.KeyValueStateMachine.InsertKey"b3j(Data.Acid.KeyValueStateMachine.InsertKey&iilLBTgȊ(Data.Acid.KeyValueStateMachine.InsertKey#XDIU)Data.Acid.KeyValueStateMachine.ReverseKeydU(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeygRB(Data.Acid.KeyValueStateMachine.InsertKey#eDqeg(Data.Acid.KeyValueStateMachine.InsertKey!Mh$(Data.Acid.KeyValueStateMachine.InsertKey$gnq6U)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeygw(Data.Acid.KeyValueStateMachine.InsertKey#oB7k(Data.Acid.KeyValueStateMachine.InsertKey'ycQwelqjf(Data.Acid.KeyValueStateMachine.InsertKey& UmWakeU[)Data.Acid.KeyValueStateMachine.ReverseKeyde(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey k(Data.Acid.KeyValueStateMachine.InsertKey'76ty62Md(Data.Acid.KeyValueStateMachine.InsertKey l(Data.Acid.KeyValueStateMachine.InsertKey(OEaeiM9xg(Data.Acid.KeyValueStateMachine.InsertKey#HzGU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyh.U(Data.Acid.KeyValueStateMachine.InsertKey$2Xc0UhJ)Data.Acid.KeyValueStateMachine.ReverseKey lZ(Data.Acid.KeyValueStateMachine.InsertKey(QiXkMnmKU)Data.Acid.KeyValueStateMachine.ReverseKeyjB>(Data.Acid.KeyValueStateMachine.InsertKey& g1SptLU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) Jr8yAsFPpUx)Data.Acid.KeyValueStateMachine.ReverseKey Ux)Data.Acid.KeyValueStateMachine.ReverseKey f=(Data.Acid.KeyValueStateMachine.InsertKey"Opnpk(Data.Acid.KeyValueStateMachine.InsertKey* 9k0FWiXa1Rk(Data.Acid.KeyValueStateMachine.InsertKey'F4dfoifk(Data.Acid.KeyValueStateMachine.InsertKey'TAYOnzrUx)Data.Acid.KeyValueStateMachine.ReverseKey fl(Data.Acid.KeyValueStateMachine.InsertKey"uNk(Data.Acid.KeyValueStateMachine.InsertKey' p13wdzCU)Data.Acid.KeyValueStateMachine.ReverseKeyn8(Data.Acid.KeyValueStateMachine.InsertKey* vcAuvTMAuCU)Data.Acid.KeyValueStateMachine.ReverseKeyn5(Data.Acid.KeyValueStateMachine.InsertKey* PnIlUBbWCtU)Data.Acid.KeyValueStateMachine.ReverseKeyeq(Data.Acid.KeyValueStateMachine.InsertKey! aU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) SdgWWgUE5dU(Data.Acid.KeyValueStateMachine.InsertKey n(Data.Acid.KeyValueStateMachine.InsertKey* LeCNhYJSYMmO7(Data.Acid.KeyValueStateMachine.InsertKey) GqP4NODQNU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyk(Data.Acid.KeyValueStateMachine.InsertKey' kfUWI89f (Data.Acid.KeyValueStateMachine.InsertKey"mmd(Data.Acid.KeyValueStateMachine.InsertKey Ux)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey Ux)Data.Acid.KeyValueStateMachine.ReverseKey i(Data.Acid.KeyValueStateMachine.InsertKey% AM8I6i(Data.Acid.KeyValueStateMachine.InsertKey%8BUYim(Data.Acid.KeyValueStateMachine.InsertKey) eNKtc7dOJl(Data.Acid.KeyValueStateMachine.InsertKey(xfsyVB7Vkh(Data.Acid.KeyValueStateMachine.InsertKey'qHwDQGKU)Data.Acid.KeyValueStateMachine.ReverseKeyg0b(Data.Acid.KeyValueStateMachine.InsertKey#Q8ik*4(Data.Acid.KeyValueStateMachine.InsertKey'XqP15fcU)Data.Acid.KeyValueStateMachine.ReverseKeyl(Data.Acid.KeyValueStateMachine.InsertKey( tGxGk7Qed5(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyn(Data.Acid.KeyValueStateMachine.InsertKey* xO0R4XbpZXU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyf݉(Data.Acid.KeyValueStateMachine.InsertKey"nIU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyg{(Data.Acid.KeyValueStateMachine.InsertKey#HVEU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyd(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeymC(Data.Acid.KeyValueStateMachine.InsertKey) 1F0S9xeVtU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyd5(Data.Acid.KeyValueStateMachine.InsertKey m(Data.Acid.KeyValueStateMachine.InsertKey) uz4og0FbuU2)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey nl(Data.Acid.KeyValueStateMachine.InsertKey* qOuG5URCwzU)Data.Acid.KeyValueStateMachine.ReverseKeyeۯ(Data.Acid.KeyValueStateMachine.InsertKey!Ph.(Data.Acid.KeyValueStateMachine.InsertKey$GeJ4jqK(Data.Acid.KeyValueStateMachine.InsertKey&DbU3gZh0(Data.Acid.KeyValueStateMachine.InsertKey$ZXtwhR(Data.Acid.KeyValueStateMachine.InsertKey$FSzXU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeye(Data.Acid.KeyValueStateMachine.InsertKey!JnH(Data.Acid.KeyValueStateMachine.InsertKey* vmeuxd47cEfw(Data.Acid.KeyValueStateMachine.InsertKey" 65k̯(Data.Acid.KeyValueStateMachine.InsertKey'tGe90VHj; (Data.Acid.KeyValueStateMachine.InsertKey&pBvbAgj7(Data.Acid.KeyValueStateMachine.InsertKey&v6rStQUx)Data.Acid.KeyValueStateMachine.ReverseKey hXl(Data.Acid.KeyValueStateMachine.InsertKey$WY2zU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyn(Data.Acid.KeyValueStateMachine.InsertKey* XoJUErm64gU)Data.Acid.KeyValueStateMachine.ReverseKeynX(Data.Acid.KeyValueStateMachine.InsertKey* 2IsW1WRn1ydU(Data.Acid.KeyValueStateMachine.InsertKey n(Data.Acid.KeyValueStateMachine.InsertKey* nyR5GLghWYm/(Data.Acid.KeyValueStateMachine.InsertKey) AXs5EaywEkeR(Data.Acid.KeyValueStateMachine.InsertKey'l9nIOFxgGd(Data.Acid.KeyValueStateMachine.InsertKey# eRQU2)Data.Acid.KeyValueStateMachine.ReverseKeyf(Data.Acid.KeyValueStateMachine.InsertKey"77n(Data.Acid.KeyValueStateMachine.InsertKey* Vd0xIxexL5n(Data.Acid.KeyValueStateMachine.InsertKey* iKqzJcVuXhUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyg(Data.Acid.KeyValueStateMachine.InsertKey# RoKU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyg*(Data.Acid.KeyValueStateMachine.InsertKey#Q7tU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey nMa(Data.Acid.KeyValueStateMachine.InsertKey* gmTDDEcq2pU2)Data.Acid.KeyValueStateMachine.ReverseKeydU(Data.Acid.KeyValueStateMachine.InsertKey Ux)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyd(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyeì(Data.Acid.KeyValueStateMachine.InsertKey!cmw(Data.Acid.KeyValueStateMachine.InsertKey) 9a7KipetMUhJ)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey lM(Data.Acid.KeyValueStateMachine.InsertKey(KsY2Aecmi(Data.Acid.KeyValueStateMachine.InsertKey% NfK0Un(Data.Acid.KeyValueStateMachine.InsertKey* gY9ZQUfaYEg(Data.Acid.KeyValueStateMachine.InsertKey# fRSlp(Data.Acid.KeyValueStateMachine.InsertKey(4837laU9U[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeye(Data.Acid.KeyValueStateMachine.InsertKey!iU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) W4TO6gHJ8h!(Data.Acid.KeyValueStateMachine.InsertKey$lW4we(Data.Acid.KeyValueStateMachine.InsertKey!QU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyh(Data.Acid.KeyValueStateMachine.InsertKey$m6HGgY(Data.Acid.KeyValueStateMachine.InsertKey# q5GU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U2)Data.Acid.KeyValueStateMachine.ReverseKeyj (Data.Acid.KeyValueStateMachine.InsertKey& RVwtSciX(Data.Acid.KeyValueStateMachine.InsertKey%1QMBUU)Data.Acid.KeyValueStateMachine.ReverseKeyf(Data.Acid.KeyValueStateMachine.InsertKey"5ij݊(Data.Acid.KeyValueStateMachine.InsertKey&2JcwO6m{(Data.Acid.KeyValueStateMachine.InsertKey) 3eyPvP3EmU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyj(Data.Acid.KeyValueStateMachine.InsertKey&x7S6VgU)Data.Acid.KeyValueStateMachine.ReverseKeykq(Data.Acid.KeyValueStateMachine.InsertKey'6mN7NAYnm(Data.Acid.KeyValueStateMachine.InsertKey* di9iguiVV2U)Data.Acid.KeyValueStateMachine.ReverseKeyiY(Data.Acid.KeyValueStateMachine.InsertKey%6A5GDU)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeynV(Data.Acid.KeyValueStateMachine.InsertKey* knCaz7yqAFn7(Data.Acid.KeyValueStateMachine.InsertKey* FXFb4lKdybU)Data.Acid.KeyValueStateMachine.ReverseKeymr(Data.Acid.KeyValueStateMachine.InsertKey) fV9bHxRuNd5(Data.Acid.KeyValueStateMachine.InsertKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey it(Data.Acid.KeyValueStateMachine.InsertKey% 2eiJxi0b(Data.Acid.KeyValueStateMachine.InsertKey%mpZdsU2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyi(Data.Acid.KeyValueStateMachine.InsertKey% i4Di4g(Data.Acid.KeyValueStateMachine.InsertKey#YBNnד(Data.Acid.KeyValueStateMachine.InsertKey* hNrpXXEaZmlvL(Data.Acid.KeyValueStateMachine.InsertKey(We01VSSce(Data.Acid.KeyValueStateMachine.InsertKey!EUx)Data.Acid.KeyValueStateMachine.ReverseKey n9(Data.Acid.KeyValueStateMachine.InsertKey* rSkEyUFhYmUx)Data.Acid.KeyValueStateMachine.ReverseKey hƤ(Data.Acid.KeyValueStateMachine.InsertKey$yylWh(Data.Acid.KeyValueStateMachine.InsertKey$ 5XQSU)Data.Acid.KeyValueStateMachine.ReverseKeykQ/(Data.Acid.KeyValueStateMachine.InsertKey'p89LVFlfV(Data.Acid.KeyValueStateMachine.InsertKey"qvUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyh(Data.Acid.KeyValueStateMachine.InsertKey$ oLEqn2(Data.Acid.KeyValueStateMachine.InsertKey* GLRmEt2Cw1U2)Data.Acid.KeyValueStateMachine.ReverseKeyh<(Data.Acid.KeyValueStateMachine.InsertKey$p7oGU[)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U )Data.Acid.KeyValueStateMachine.ReverseKeym(Data.Acid.KeyValueStateMachine.InsertKey) C8GTzn3ysU)Data.Acid.KeyValueStateMachine.ReverseKeyjjN(Data.Acid.KeyValueStateMachine.InsertKey&kdqsQqU)Data.Acid.KeyValueStateMachine.ReverseKeydu(Data.Acid.KeyValueStateMachine.InsertKey de(Data.Acid.KeyValueStateMachine.InsertKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyi#(Data.Acid.KeyValueStateMachine.InsertKey%G5wYsedV(Data.Acid.KeyValueStateMachine.InsertKey!rU)Data.Acid.KeyValueStateMachine.ReverseKeyg;(Data.Acid.KeyValueStateMachine.InsertKey#3HcUx)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeygW^(Data.Acid.KeyValueStateMachine.InsertKey#txBU )Data.Acid.KeyValueStateMachine.ReverseKeynn(Data.Acid.KeyValueStateMachine.InsertKey* 3EbHnrFu3wUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyjч(Data.Acid.KeyValueStateMachine.InsertKey&9Eisn9U)Data.Acid.KeyValueStateMachine.ReverseKeyg5(Data.Acid.KeyValueStateMachine.InsertKey#NDdU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey d5(Data.Acid.KeyValueStateMachine.InsertKey ji(Data.Acid.KeyValueStateMachine.InsertKey&3uBdCRU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyjX(Data.Acid.KeyValueStateMachine.InsertKey&5Hq4RDi(Data.Acid.KeyValueStateMachine.InsertKey%3HetlU)Data.Acid.KeyValueStateMachine.ReverseKeyma(Data.Acid.KeyValueStateMachine.InsertKey) 7xEoLGUOWks!(Data.Acid.KeyValueStateMachine.InsertKey'zCGyzDFUhJ)Data.Acid.KeyValueStateMachine.ReverseKey k(Data.Acid.KeyValueStateMachine.InsertKey'gm2NNoLU2)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyhv(Data.Acid.KeyValueStateMachine.InsertKey$r0pve(Data.Acid.KeyValueStateMachine.InsertKey!viY(Data.Acid.KeyValueStateMachine.InsertKey%Nrnflg(Data.Acid.KeyValueStateMachine.InsertKey#rCpU)Data.Acid.KeyValueStateMachine.ReverseKeyeَ(Data.Acid.KeyValueStateMachine.InsertKey!pU)Data.Acid.KeyValueStateMachine.ReverseKeyeP(Data.Acid.KeyValueStateMachine.InsertKey!qUx)Data.Acid.KeyValueStateMachine.ReverseKey jhC(Data.Acid.KeyValueStateMachine.InsertKey&5BCGwTU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey d(Data.Acid.KeyValueStateMachine.InsertKey h(Data.Acid.KeyValueStateMachine.InsertKey$oazMew(Data.Acid.KeyValueStateMachine.InsertKey!ge~(Data.Acid.KeyValueStateMachine.InsertKey!DU )Data.Acid.KeyValueStateMachine.ReverseKeyiͳ(Data.Acid.KeyValueStateMachine.InsertKey%FwQHUkp(Data.Acid.KeyValueStateMachine.InsertKey'Am4qK38U[)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey i(Data.Acid.KeyValueStateMachine.InsertKey%oRkxeU)Data.Acid.KeyValueStateMachine.ReverseKeylk(Data.Acid.KeyValueStateMachine.InsertKey( aE4bvifEU)Data.Acid.KeyValueStateMachine.ReverseKeyiX(Data.Acid.KeyValueStateMachine.InsertKey% q0dBOU)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey ij(Data.Acid.KeyValueStateMachine.InsertKey%mXr2FU)Data.Acid.KeyValueStateMachine.ReverseKeyiLN(Data.Acid.KeyValueStateMachine.InsertKey%zpfPwU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyht(Data.Acid.KeyValueStateMachine.InsertKey$ AqTPde(Data.Acid.KeyValueStateMachine.InsertKey l/u(Data.Acid.KeyValueStateMachine.InsertKey(Np7IaoMOU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeye?`(Data.Acid.KeyValueStateMachine.InsertKey!oUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey m(Data.Acid.KeyValueStateMachine.InsertKey) Amh3WYeAXg1(Data.Acid.KeyValueStateMachine.InsertKey#KKPf(Data.Acid.KeyValueStateMachine.InsertKey" xqU)Data.Acid.KeyValueStateMachine.ReverseKeyh(Data.Acid.KeyValueStateMachine.InsertKey$y5Pld(Data.Acid.KeyValueStateMachine.InsertKey l=(Data.Acid.KeyValueStateMachine.InsertKey(4upc5RaPj0(Data.Acid.KeyValueStateMachine.InsertKey&KKNEa8nޑ(Data.Acid.KeyValueStateMachine.InsertKey* 1Ra1obuINafk(Data.Acid.KeyValueStateMachine.InsertKey"ZcU[)Data.Acid.KeyValueStateMachine.ReverseKeyd(Data.Acid.KeyValueStateMachine.InsertKey d(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest1/checkpoints-0000000000.log0000644000000000000000000000000013660647235022732 0ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest2/0000755000000000000000000000000013660647235016713 5ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest2/events-0000000143.log0000644000000000000000000000121513660647235021746 0ustar0000000000000000g(Data.Acid.KeyValueStateMachine.InsertKey#zAAU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeykN(Data.Acid.KeyValueStateMachine.InsertKey' XBvIQHXj(Data.Acid.KeyValueStateMachine.InsertKey&3Eu5d3k<(Data.Acid.KeyValueStateMachine.InsertKey'prAocOcacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000141.log0000644000000000000000000000027613660647235021752 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events.version0000644000000000000000000000000613660647235021622 0ustar00000000000000000.15.0acid-state-0.16.0.1/test-state/OldStateTest2/events-0000000031.log0000644000000000000000000000216513660647235021747 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyk(Data.Acid.KeyValueStateMachine.InsertKey'I8m9qCSU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyde(Data.Acid.KeyValueStateMachine.InsertKey kz(Data.Acid.KeyValueStateMachine.InsertKey' OGmW6BlU2)Data.Acid.KeyValueStateMachine.ReverseKeyeg(Data.Acid.KeyValueStateMachine.InsertKey!oU)Data.Acid.KeyValueStateMachine.ReverseKeyjQ|(Data.Acid.KeyValueStateMachine.InsertKey&b8oiifU )Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000019.log0000644000000000000000000000235313660647235021754 0ustar0000000000000000j^(Data.Acid.KeyValueStateMachine.InsertKey& pI19AMn5O(Data.Acid.KeyValueStateMachine.InsertKey* mXixL4IwCAUx)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey n(Data.Acid.KeyValueStateMachine.InsertKey* wBOKllBhhCU2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey lڋ(Data.Acid.KeyValueStateMachine.InsertKey(gODqRLNQU2)Data.Acid.KeyValueStateMachine.ReverseKeyn(Data.Acid.KeyValueStateMachine.InsertKey* 0wS1D6YaNFU[)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000069.log0000644000000000000000000000155013660647235021757 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyf(Data.Acid.KeyValueStateMachine.InsertKey"HMU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000082.log0000644000000000000000000000317713660647235021761 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyk(Data.Acid.KeyValueStateMachine.InsertKey' B3xbADPUhJ)Data.Acid.KeyValueStateMachine.ReverseKey k(Data.Acid.KeyValueStateMachine.InsertKey' Dxswslme(Data.Acid.KeyValueStateMachine.InsertKey!iU)Data.Acid.KeyValueStateMachine.ReverseKeyg (Data.Acid.KeyValueStateMachine.InsertKey# HhBU )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUx)Data.Acid.KeyValueStateMachine.ReverseKey U2)Data.Acid.KeyValueStateMachine.ReverseKeyj5((Data.Acid.KeyValueStateMachine.InsertKey&nyCIhXn(Data.Acid.KeyValueStateMachine.InsertKey* 6or8uBHs6kU)Data.Acid.KeyValueStateMachine.ReverseKeyh}x(Data.Acid.KeyValueStateMachine.InsertKey$ 3tldU )Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000122.log0000644000000000000000000000063613660647235021751 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyer(Data.Acid.KeyValueStateMachine.InsertKey!4U)Data.Acid.KeyValueStateMachine.ReverseKeygr(Data.Acid.KeyValueStateMachine.InsertKey#9r7acid-state-0.16.0.1/test-state/OldStateTest2/events-0000000042.log0000644000000000000000000000032713660647235021747 0ustar0000000000000000U2)Data.Acid.KeyValueStateMachine.ReverseKeyn (Data.Acid.KeyValueStateMachine.InsertKey* chgM4NPymxacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000057.log0000644000000000000000000000031513660647235021752 0ustar0000000000000000d(Data.Acid.KeyValueStateMachine.InsertKey U)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000127.log0000644000000000000000000000061413660647235021752 0ustar0000000000000000Ux)Data.Acid.KeyValueStateMachine.ReverseKey e(Data.Acid.KeyValueStateMachine.InsertKey!nU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000046.log0000644000000000000000000000217313660647235021754 0ustar0000000000000000Ux)Data.Acid.KeyValueStateMachine.ReverseKey l(Data.Acid.KeyValueStateMachine.InsertKey(ENdfLrrWU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeym4(Data.Acid.KeyValueStateMachine.InsertKey) fNptuYoDkl(Data.Acid.KeyValueStateMachine.InsertKey(YoBtZOo6e4(Data.Acid.KeyValueStateMachine.InsertKey! VU2)Data.Acid.KeyValueStateMachine.ReverseKeye˭(Data.Acid.KeyValueStateMachine.InsertKey!rU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000126.log0000644000000000000000000000015613660647235021752 0ustar0000000000000000d(Data.Acid.KeyValueStateMachine.InsertKey acid-state-0.16.0.1/test-state/OldStateTest2/events-0000000078.log0000644000000000000000000000015713660647235021761 0ustar0000000000000000eG(Data.Acid.KeyValueStateMachine.InsertKey!Oacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000044.log0000644000000000000000000000031613660647235021747 0ustar0000000000000000eD(Data.Acid.KeyValueStateMachine.InsertKey!OU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000079.log0000644000000000000000000000045713660647235021765 0ustar0000000000000000Ux)Data.Acid.KeyValueStateMachine.ReverseKey gC@(Data.Acid.KeyValueStateMachine.InsertKey#hoyU2)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000131.log0000644000000000000000000000204313660647235021743 0ustar0000000000000000hϣ(Data.Acid.KeyValueStateMachine.InsertKey$ QHcikX(Data.Acid.KeyValueStateMachine.InsertKey' A2CzkvWl1(Data.Acid.KeyValueStateMachine.InsertKey(F6S1RwLPU[)Data.Acid.KeyValueStateMachine.ReverseKeyk](Data.Acid.KeyValueStateMachine.InsertKey' Hwkb05Kl(Data.Acid.KeyValueStateMachine.InsertKey(5uu96aFAU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000100.log0000644000000000000000000000027613660647235021745 0ustar0000000000000000U2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000060.log0000644000000000000000000000165013660647235021747 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeydU(Data.Acid.KeyValueStateMachine.InsertKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey k!(Data.Acid.KeyValueStateMachine.InsertKey' QQ16rCSU)Data.Acid.KeyValueStateMachine.ReverseKeyke(Data.Acid.KeyValueStateMachine.InsertKey'bbfYAe5km(Data.Acid.KeyValueStateMachine.InsertKey'xav24yEU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000117.log0000644000000000000000000000075613660647235021760 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyh:(Data.Acid.KeyValueStateMachine.InsertKey$KyJTUx)Data.Acid.KeyValueStateMachine.ReverseKey U)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000102.log0000644000000000000000000000032113660647235021736 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyhG(Data.Acid.KeyValueStateMachine.InsertKey$C5Wgacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000112.log0000644000000000000000000000105113660647235021740 0ustar0000000000000000f-(Data.Acid.KeyValueStateMachine.InsertKey"YsU )Data.Acid.KeyValueStateMachine.ReverseKeyl)(Data.Acid.KeyValueStateMachine.InsertKey(XP12PYY5e(Data.Acid.KeyValueStateMachine.InsertKey!Ak(Data.Acid.KeyValueStateMachine.InsertKey'sESXGsIacid-state-0.16.0.1/test-state/OldStateTest2/checkpoints.version0000644000000000000000000000000613660647235022630 0ustar00000000000000000.15.0acid-state-0.16.0.1/test-state/OldStateTest2/events-0000000098.log0000644000000000000000000000027613660647235021765 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000059.log0000644000000000000000000000016413660647235021756 0ustar0000000000000000j(Data.Acid.KeyValueStateMachine.InsertKey&6yxOwyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000104.log0000644000000000000000000000154313660647235021747 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyi+(Data.Acid.KeyValueStateMachine.InsertKey%CTkf3h(Data.Acid.KeyValueStateMachine.InsertKey$VmiRjh(Data.Acid.KeyValueStateMachine.InsertKey& xE5mABl (Data.Acid.KeyValueStateMachine.InsertKey( Lb9MuI0Qm(Data.Acid.KeyValueStateMachine.InsertKey) c0MQVcry0U)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000003.log0000644000000000000000000000067613660647235021753 0ustar0000000000000000mtZ(Data.Acid.KeyValueStateMachine.InsertKey) wlyLqfO3pf(Data.Acid.KeyValueStateMachine.InsertKey" ByU)Data.Acid.KeyValueStateMachine.ReverseKeyn(Data.Acid.KeyValueStateMachine.InsertKey* NAQ76vVIQQacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000017.log0000644000000000000000000000027613660647235021754 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000014.log0000644000000000000000000000050713660647235021746 0ustar0000000000000000kG&(Data.Acid.KeyValueStateMachine.InsertKey' 2Z3hpTNU)Data.Acid.KeyValueStateMachine.ReverseKeyiט(Data.Acid.KeyValueStateMachine.InsertKey% meu8yacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000000.log0000644000000000000000000000051013660647235021733 0ustar0000000000000000n(Data.Acid.KeyValueStateMachine.InsertKey* FAhndJvUhDgF(Data.Acid.KeyValueStateMachine.InsertKey#WJsU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest2/checkpoints-0000000000.log0000644000000000000000000000000013660647235022733 0ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest2/events-0000000012.log0000644000000000000000000000034113660647235021740 0ustar0000000000000000h(Data.Acid.KeyValueStateMachine.InsertKey$ 75KPef(Data.Acid.KeyValueStateMachine.InsertKey!oacid-state-0.16.0.1/test-state/OldStateTest2/events-0000000007.log0000644000000000000000000000100013660647235021735 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey dE(Data.Acid.KeyValueStateMachine.InsertKey k (Data.Acid.KeyValueStateMachine.InsertKey'n3iAL7PU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/0000755000000000000000000000000013660647235016714 5ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000036.log0000644000000000000000000000013713660647235021752 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000033.log0000644000000000000000000000061113660647235022752 0ustar0000000000000000cNg lT5cEx1QRkqH0Ta4 d0e7gnCsst OZZoIqbdMtWwwU voSVv33JY 8PqG8Xacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000032.log0000644000000000000000000000061013660647235022750 0ustar0000000000000000~|Mf lT5cEx1QRRNV8T4 d0e7gnCsst OZZoIqbdMtWwwU voSVv33JY 8PqG8Xacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000037.log0000644000000000000000000000015713660647235021755 0ustar0000000000000000e)(Data.Acid.KeyValueStateMachine.InsertKey! wacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000023.log0000644000000000000000000000061713660647235021751 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyhbK(Data.Acid.KeyValueStateMachine.InsertKey$BZGkU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000024.log0000644000000000000000000000061113660647235022752 0ustar0000000000000000̿<g honnniDOgRNV8T OYoLVlV1rIKxzm7 OZZoIqbdMkGZBp8Gqb VidTfOaw acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000019.log0000644000000000000000000000054213660647235022761 0ustar0000000000000000XM7@ H7MqvAxOg8AcB99EtKxzm7 OZZoIqbdMkGZBbqG8p O1CC acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000025.log0000644000000000000000000000222113660647235022752 0ustar0000000000000000U=h honnniDrpHRNV8T OYoLVlV1rIKxzm7 OZZoIqbdMkGZBp8Gqb VidTfOaw yk1>a honnniDrpHRNV8TMXhKxzm7 OZZoIqbdMkGZBp8Gqb VidTfOaw z@b honnniDHprRNV8TMXhKxzm7 OZZoIqbdMkGZBp8Gqb voSVv33JY acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000031.log0000644000000000000000000000061013660647235022747 0ustar0000000000000000~Lf lT5cEx1QRRNV8T4 d0e7gnCsst OZZoIqbdMtWwwU voSVv33JY X8GqP8acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000034.log0000644000000000000000000000032513660647235021747 0ustar0000000000000000l?(Data.Acid.KeyValueStateMachine.InsertKey(BgD7NB4yU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000018.log0000644000000000000000000000103513660647235021750 0ustar0000000000000000U2)Data.Acid.KeyValueStateMachine.ReverseKeyj(Data.Acid.KeyValueStateMachine.InsertKey&b3fcA7k#(Data.Acid.KeyValueStateMachine.InsertKey'xAvqM7Hl(Data.Acid.KeyValueStateMachine.InsertKey(aiA9KMiOUhJ)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000030.log0000644000000000000000000000013713660647235021744 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000009.log0000644000000000000000000000045513660647235022763 0ustar0000000000000000#3 xAvqM7HtE99BcA87Acf3b OZZoIqbdMkGZB 6Ipv8KJr 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/events.version0000644000000000000000000000000613660647235021623 0ustar00000000000000000.15.0acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000020.log0000644000000000000000000000135313660647235022752 0ustar0000000000000000XM7@ H7MqvAxOg8AcB99EtKxzm7 OZZoIqbdMkGZBbqG8p O1CC :g H7MqvAxOgRNV8T OYoLVlV1rIKxzm7 OZZoIqbdMkGZBbqG8p VidTfOaw acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000034.log0000644000000000000000000000222713660647235022760 0ustar0000000000000000cNg lT5cEx1QRkqH0Ta4 d0e7gnCsst OZZoIqbdMtWwwU voSVv33JY 8PqG8X}VOOe lT5cEx1QRkqH0Ta4 d0e7gnCsst OZZoIqbdMihr voSVv33JY 8PqG8X}VOOe lT5cEx1QRkqH0Ta4 d0e7gnCsst OZZoIqbdMihr voSVv33JY 8PqG8Xacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000008.log0000644000000000000000000000044413660647235022760 0ustar0000000000000000xAvqM7HtE99BcA87Acf3bkGZB rJK8vpI6 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000031.log0000644000000000000000000000034213660647235021743 0ustar0000000000000000i(Data.Acid.KeyValueStateMachine.InsertKey%bqG8pek(Data.Acid.KeyValueStateMachine.InsertKey! Nacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000027.log0000644000000000000000000000032613660647235021752 0ustar0000000000000000m(Data.Acid.KeyValueStateMachine.InsertKey) OZZoIqbdMUhJ)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000033.log0000644000000000000000000000013713660647235021747 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000022.log0000644000000000000000000000061113660647235022750 0ustar0000000000000000;g H7MqvAxOgRNV8T OYoLVlV1rIKxzm7 OZZoIqbdMkGZBp8Gqb VidTfOaw acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000037.log0000644000000000000000000000223713660647235022764 0ustar00000000000000005Ql lT5cEx1QRkqH0TatRKoqq d0e7gnCsst OZZoIqbdMihr voSVv33JY MLc2oFuK5Ql lT5cEx1QRkqH0TatRKoqq d0e7gnCsst OZZoIqbdMihr voSVv33JY MLc2oFuKyrTSa lT5cEx1QRkqH0TaDuf d0e7gnCsst OZZoIqbdMihr voSVv33JY acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000023.log0000644000000000000000000000061113660647235022751 0ustar0000000000000000̿<g honnniDOgRNV8T OYoLVlV1rIKxzm7 OZZoIqbdMkGZBp8Gqb VidTfOaw acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000041.log0000644000000000000000000000050413660647235021744 0ustar0000000000000000fL&(Data.Acid.KeyValueStateMachine.InsertKey"Ogk(Data.Acid.KeyValueStateMachine.InsertKey' KxwnpTwUhJ)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000055.log0000644000000000000000000000054113660647235021752 0ustar0000000000000000i(Data.Acid.KeyValueStateMachine.InsertKey%RNV8Tl.(Data.Acid.KeyValueStateMachine.InsertKey( VidTfOawnn#(Data.Acid.KeyValueStateMachine.InsertKey* OYoLVlV1rIacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000044.log0000644000000000000000000000062013660647235022754 0ustar0000000000000000+\n fmZRQ1xEc5aT0HqkDuf tssCng7e0d ezVCh0WQuli9ihr g7aCCGVXfF lCErPJC3acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000097.log0000644000000000000000000000032413660647235021757 0ustar0000000000000000ks(Data.Acid.KeyValueStateMachine.InsertKey'q1WI9HeU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000083.log0000644000000000000000000000102513660647235021751 0ustar0000000000000000e(Data.Acid.KeyValueStateMachine.InsertKey!AU2)Data.Acid.KeyValueStateMachine.ReverseKeymt(Data.Acid.KeyValueStateMachine.InsertKey) ezVCh0WQuU)Data.Acid.KeyValueStateMachine.ReverseKeyg5(Data.Acid.KeyValueStateMachine.InsertKey#li9acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000045.log0000644000000000000000000000062013660647235022755 0ustar0000000000000000+^n ZmfRQ1xEc5aT0HqkDuf tssCng7e0d ezVCh0WQuli9rhi g7aCCGVXfF lCErPJC3acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000068.log0000644000000000000000000000034113660647235021754 0ustar0000000000000000hS(Data.Acid.KeyValueStateMachine.InsertKey$pVc5e(Data.Acid.KeyValueStateMachine.InsertKey!4acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000054.log0000644000000000000000000000013713660647235021752 0ustar0000000000000000U2)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000047.log0000644000000000000000000000000013660647235022747 0ustar0000000000000000acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000081.log0000644000000000000000000000033713660647235021754 0ustar0000000000000000g(Data.Acid.KeyValueStateMachine.InsertKey#Dufd(Data.Acid.KeyValueStateMachine.InsertKey acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000046.log0000644000000000000000000000062413660647235022762 0ustar0000000000000000-cr 4RQ1xEc5aT0HqkDuf tssCng7e0d uQW0hCVzeFSCZPMGLq1WI9He IYHbWmO lCErPJC3acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000094.log0000644000000000000000000000053213660647235021755 0ustar0000000000000000e(Data.Acid.KeyValueStateMachine.InsertKey!4l(Data.Acid.KeyValueStateMachine.InsertKey(FSCZPMGLk(Data.Acid.KeyValueStateMachine.InsertKey' IYHbWmOacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000043.log0000644000000000000000000000060713660647235022760 0ustar0000000000000000}Ye lT5cEx1QRaT0HqkDuf tssCng7e0d ezVCh0WQuli9ihr g7aCCGVXfF acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000078.log0000644000000000000000000000016113660647235021755 0ustar0000000000000000g/(Data.Acid.KeyValueStateMachine.InsertKey#ihracid-state-0.16.0.1/test-state/OldStateTest3/events-0000000044.log0000644000000000000000000000123113660647235021745 0ustar0000000000000000U )Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyU[)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyUhJ)Data.Acid.KeyValueStateMachine.ReverseKey UhJ)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000041.log0000644000000000000000000000141513660647235022754 0ustar0000000000000000|{Xd lT5cEx1QRaT0HqkDuf tssCng7e0d ezVCh0WQuli9ihr voSVv33JY }Ye lT5cEx1QRaT0HqkDuf tssCng7e0d ezVCh0WQuli9ihr g7aCCGVXfF acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000092.log0000644000000000000000000000027613660647235021760 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyU )Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000040.log0000644000000000000000000000060313660647235022751 0ustar0000000000000000yrTSa lT5cEx1QRkqH0TaDuf d0e7gnCsst OZZoIqbdMihr voSVv33JY acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000051.log0000644000000000000000000000045413660647235021751 0ustar0000000000000000d(Data.Acid.KeyValueStateMachine.InsertKey U2)Data.Acid.KeyValueStateMachine.ReverseKeyU)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000079.log0000644000000000000000000000035213660647235021760 0ustar0000000000000000l(Data.Acid.KeyValueStateMachine.InsertKey( MLc2oFuKj(Data.Acid.KeyValueStateMachine.InsertKey&tRKoqqacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000060.log0000644000000000000000000000016113660647235021744 0ustar0000000000000000g:(Data.Acid.KeyValueStateMachine.InsertKey#rpHacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000075.log0000644000000000000000000000015613660647235021756 0ustar0000000000000000dU(Data.Acid.KeyValueStateMachine.InsertKey acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000061.log0000644000000000000000000000016113660647235021745 0ustar0000000000000000g(Data.Acid.KeyValueStateMachine.InsertKey#MXhacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000077.log0000644000000000000000000000016413660647235021757 0ustar0000000000000000jG(Data.Acid.KeyValueStateMachine.InsertKey&kqH0Taacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000088.log0000644000000000000000000000017013660647235021756 0ustar0000000000000000nv(Data.Acid.KeyValueStateMachine.InsertKey* g7aCCGVXfFacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000089.log0000644000000000000000000000050613660647235021762 0ustar0000000000000000g(Data.Acid.KeyValueStateMachine.InsertKey#fmZU)Data.Acid.KeyValueStateMachine.ReverseKeyl(Data.Acid.KeyValueStateMachine.InsertKey( lCErPJC3acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000062.log0000644000000000000000000000032613660647235021751 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeym,(Data.Acid.KeyValueStateMachine.InsertKey) voSVv33JYacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000076.log0000644000000000000000000000013713660647235021756 0ustar0000000000000000Ux)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints.version0000644000000000000000000000000613660647235022631 0ustar00000000000000000.15.0acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000066.log0000644000000000000000000000016513660647235021756 0ustar0000000000000000k(Data.Acid.KeyValueStateMachine.InsertKey'5cEx1QRacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000099.log0000644000000000000000000000013713660647235021763 0ustar0000000000000000UP)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000067.log0000644000000000000000000000013713660647235021756 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000059.log0000644000000000000000000000016513660647235021760 0ustar0000000000000000k7(Data.Acid.KeyValueStateMachine.InsertKey'honnniDacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000065.log0000644000000000000000000000016313660647235021753 0ustar0000000000000000id(Data.Acid.KeyValueStateMachine.InsertKey%zJBFhacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000070.log0000644000000000000000000000105613660647235021751 0ustar0000000000000000flT(Data.Acid.KeyValueStateMachine.InsertKey"TlU )Data.Acid.KeyValueStateMachine.ReverseKeynV(Data.Acid.KeyValueStateMachine.InsertKey* d0e7gnCssti(Data.Acid.KeyValueStateMachine.InsertKey%tWwwUj(Data.Acid.KeyValueStateMachine.InsertKey& X8GqP8acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000064.log0000644000000000000000000000013713660647235021753 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000058.log0000644000000000000000000000013713660647235021756 0ustar0000000000000000U[)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000003.log0000644000000000000000000000046613660647235021751 0ustar0000000000000000n(Data.Acid.KeyValueStateMachine.InsertKey* wp2cMlo87dUhJ)Data.Acid.KeyValueStateMachine.ReverseKey U )Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000006.log0000644000000000000000000000034213660647235022753 0ustar0000000000000000߾dkDk16NtE99BcA8 rJK8vpI6 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000012.log0000644000000000000000000000123013660647235022745 0ustar0000000000000000B>$*H7MqvAxtE99BcA8y4BN7DgB OZZoIqbdMkGZBp8Gqb rJK8vpI6 NB2d%*xAvqM7HtE99BcA8y4BN7DgB OZZoIqbdMkGZBp8Gqb rJK8vpI6 Nacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000007.log0000644000000000000000000000034213660647235022754 0ustar0000000000000000dkDk16N8AcB99Et 6Ipv8KJr 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000016.log0000644000000000000000000000027613660647235021754 0ustar0000000000000000UhJ)Data.Acid.KeyValueStateMachine.ReverseKey U2)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/events-0000000002.log0000644000000000000000000000013713660647235021743 0ustar0000000000000000UhJ)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000000.log0000644000000000000000000000017013660647235021736 0ustar0000000000000000n\(Data.Acid.KeyValueStateMachine.InsertKey* mnZEhsHuYfacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000011.log0000644000000000000000000000051213660647235022746 0ustar0000000000000000@&!(H7MqvAxtE99BcA87Acf3b OZZoIqbdMkGZBbqG8p rJK8vpI6 Nacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000005.log0000644000000000000000000000034213660647235022752 0ustar0000000000000000߾dkDk16NtE99BcA8 rJK8vpI6 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000004.log0000644000000000000000000000034213660647235022751 0ustar0000000000000000߾dkDk16NtE99BcA8 rJK8vpI6 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000010.log0000644000000000000000000000045513660647235022753 0ustar0000000000000000# H7MqvAxtE99BcA87Acf3b OZZoIqbdMkGZB rJK8vpI6 9KXq5acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000029.log0000644000000000000000000000013713660647235021754 0ustar0000000000000000UhJ)Data.Acid.KeyValueStateMachine.ReverseKey acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000001.log0000644000000000000000000000013713660647235021742 0ustar0000000000000000U)Data.Acid.KeyValueStateMachine.ReverseKeyacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000028.log0000644000000000000000000000060413660647235022760 0ustar0000000000000000z3Bb honnniDrpHRNV8TMXhzJBFh OZZoIqbdMkGZBp8Gqb voSVv33JY acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000014.log0000644000000000000000000000130413660647235022751 0ustar0000000000000000XP6@ H7MqvAxOgtE99BcA8Kxzm7 OZZoIqbdMkGZBbqG8p O1CC XP6@ H7MqvAxOgtE99BcA8Kxzm7 OZZoIqbdMkGZBbqG8p O1CC acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000000.log0000644000000000000000000000014013660647235022741 0ustar0000000000000000V> mnZEhsHuYfacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000001.log0000644000000000000000000000030013660647235022740 0ustar0000000000000000VB> mnZEhsHuYfVB> mnZEhsHuYfacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000029.log0000644000000000000000000000141213660647235022757 0ustar0000000000000000{pFc honnniD5cEx1QRRNV8T4hFBJz OZZoIqbdMkGZBpVc5 voSVv33JY {pFc honnniD5cEx1QRRNV8T4hFBJz OZZoIqbdMkGZBpVc5 voSVv33JY acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000038.log0000644000000000000000000000050413660647235021752 0ustar0000000000000000Ux)Data.Acid.KeyValueStateMachine.ReverseKey hy(Data.Acid.KeyValueStateMachine.InsertKey$ CC1Oi(Data.Acid.KeyValueStateMachine.InsertKey%Kxzm7acid-state-0.16.0.1/test-state/OldStateTest3/events-0000000006.log0000644000000000000000000000206313660647235021747 0ustar0000000000000000k(Data.Acid.KeyValueStateMachine.InsertKey'uhznn1Fk(Data.Acid.KeyValueStateMachine.InsertKey'dkDk16NU)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyU2)Data.Acid.KeyValueStateMachine.ReverseKeyl(Data.Acid.KeyValueStateMachine.InsertKey(8AcB99Etlך(Data.Acid.KeyValueStateMachine.InsertKey( rJK8vpI6i(Data.Acid.KeyValueStateMachine.InsertKey% 9KXq5U2)Data.Acid.KeyValueStateMachine.ReverseKeydE(Data.Acid.KeyValueStateMachine.InsertKey acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000003.log0000644000000000000000000000020613660647235022747 0ustar0000000000000000|d d78olMc2pw mnZEhsHuYfacid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000017.log0000644000000000000000000000130413660647235022754 0ustar0000000000000000XM7@ H7MqvAxOg8AcB99EtKxzm7 OZZoIqbdMkGZBbqG8p O1CC XM7@ H7MqvAxOg8AcB99EtKxzm7 OZZoIqbdMkGZBbqG8p O1CC acid-state-0.16.0.1/test-state/OldStateTest3/checkpoints-0000000016.log0000644000000000000000000000054213660647235022756 0ustar0000000000000000XP6@ H7MqvAxOgtE99BcA8Kxzm7 OZZoIqbdMkGZBbqG8p O1CC acid-state-0.16.0.1/src-unix/0000755000000000000000000000000013660647235013725 5ustar0000000000000000acid-state-0.16.0.1/src-unix/FileIO.hs0000644000000000000000000000173113660647235015372 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} module FileIO(FHandle,open,write,flush,close) where import System.Posix(Fd(Fd), openFd, fdWriteBuf, closeFd, OpenMode(WriteOnly), defaultFileFlags, stdFileMode ) import Data.Word(Word8,Word32) import Foreign(Ptr) import Foreign.C(CInt(..)) data FHandle = FHandle Fd -- should handle opening flags correctly open :: FilePath -> IO FHandle open filename = fmap FHandle $ openFd filename WriteOnly (Just stdFileMode) defaultFileFlags write :: FHandle -> Ptr Word8 -> Word32 -> IO Word32 write (FHandle fd) data' length = fmap fromIntegral $ fdWriteBuf fd data' $ fromIntegral length -- Handle error values? flush :: FHandle -> IO () flush (FHandle (Fd c_fd)) = c_fsync c_fd >> return () foreign import ccall "fsync" c_fsync :: CInt -> IO CInt close :: FHandle -> IO () close (FHandle fd) = closeFd fd acid-state-0.16.0.1/src-win32/0000755000000000000000000000000013660647235013704 5ustar0000000000000000acid-state-0.16.0.1/src-win32/FileIO.hs0000644000000000000000000000163113660647235015350 0ustar0000000000000000module FileIO(FHandle,open,write,flush,close) where import System.Win32(HANDLE, createFile, gENERIC_WRITE, fILE_SHARE_NONE, cREATE_ALWAYS, fILE_ATTRIBUTE_NORMAL, win32_WriteFile, flushFileBuffers, closeHandle) import Data.Word(Word8,Word32) import Foreign(Ptr) import System.IO data FHandle = FHandle HANDLE open :: FilePath -> IO FHandle open filename = fmap FHandle $ createFile filename gENERIC_WRITE fILE_SHARE_NONE Nothing cREATE_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing write :: FHandle -> Ptr Word8 -> Word32 -> IO Word32 write (FHandle handle) data' length = win32_WriteFile handle data' length Nothing flush :: FHandle -> IO () flush (FHandle handle) = flushFileBuffers handle close :: FHandle -> IO () close (FHandle handle) = closeHandle handle acid-state-0.16.0.1/test/0000755000000000000000000000000013660647235013134 5ustar0000000000000000acid-state-0.16.0.1/test/StateMachine.hs0000644000000000000000000000034213660647235016034 0ustar0000000000000000module Main (main) where import Control.Monad (unless) import Data.Acid.KeyValueStateMachine import System.Exit (exitFailure) main :: IO () main = do ok <- tests unless ok exitFailure acid-state-0.16.0.1/test/Spec.hs0000644000000000000000000000005413660647235014361 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} acid-state-0.16.0.1/test/Data/0000755000000000000000000000000013660647235014005 5ustar0000000000000000acid-state-0.16.0.1/test/Data/Acid/0000755000000000000000000000000013660647235014645 5ustar0000000000000000acid-state-0.16.0.1/test/Data/Acid/TemplateHaskellSpec.hs0000644000000000000000000001357713660647235021110 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Data.Acid.TemplateHaskellSpec where import Test.Hspec hiding (context) import Data.SafeCopy (SafeCopy) import Data.Typeable (Typeable) import Control.DeepSeq (force) import Control.Exception (evaluate) import Language.Haskell.TH import Language.Haskell.TH.Quote import Control.Monad.Reader import Control.Monad.State import Data.Acid import Data.Acid.TemplateHaskell spec :: Spec spec = do let name = mkName "foo" nameT = ConT name upperName = mkName "Foo" upperNameT = ConT upperName describe "makeEventInstance" $ do it "works with monomorphic types" $ do eventType <- runQ [t| Int -> Query Char () |] makeEventInstance name eventType `quoteShouldBe` [d| instance QueryEvent $(return upperNameT) |] it "requires instances on polymorphic types" $ do let a = VarT (mkName "a") a' = return a eventType <- runQ [t| (Ord $(a')) => $(a') -> Update Char $(a') |] makeEventInstance name eventType `quoteShouldBe` [d| instance (Ord $(a')) => UpdateEvent $(return upperNameT) |] describe "analyseType" $ do it "can work with the Query type" $ do typ <- runQ [t| Int -> Query String Char |] analyseType name typ `shouldBe` TypeAnalysis { tyvars = [] , context = [] , argumentTypes = [ConT ''Int] , stateType = ConT ''String , resultType = ConT ''Char , isUpdate = False } it "can work with the Update type" $ do typ <- runQ [t| Int -> Update String Char |] analyseType name typ `shouldBe` TypeAnalysis { tyvars = [] , context = [] , argumentTypes = [ConT ''Int] , stateType = ConT ''String , resultType = ConT ''Char , isUpdate = True } it "can work with MonadReader" $ do typ <- runQ [t| forall m. (MonadReader Int m) => Int -> m () |] analyseType name typ `shouldBe` TypeAnalysis { tyvars = [] , context = [] , argumentTypes = [ConT ''Int] , stateType = ConT ''Int , resultType = TupleT 0 , isUpdate = False } it "can work with MonadState" $ do typ <- runQ [t| forall m. (MonadState Int m) => Int -> m () |] analyseType name typ `shouldBe` TypeAnalysis { tyvars = [] , context = [] , argumentTypes = [ConT ''Int] , stateType = ConT ''Int , resultType = TupleT 0 , isUpdate = True } it "can work with many type variables (note that eventCxts later rejects this)" $ do let m = mkName "m" typ <- runQ [t| (MonadReader Int $(varT m)) => Int -> Query Int ($(varT m) ()) |] analyseType name typ `shouldBe` TypeAnalysis { tyvars = [] , context = #if MIN_VERSION_template_haskell(2,10,0) [ ConT ''MonadReader `AppT` ConT ''Int `AppT` VarT m ] #else [ ClassP ''MonadReader [ConT ''Int, VarT m] ] #endif , argumentTypes = [ConT ''Int] , stateType = ConT ''Int , resultType = VarT m `AppT` TupleT 0 , isUpdate = False } describe "eventCxts" $ do let binders = [] stateType = ConT ''Char it "rejects types with constrainted type variables unknown to state" $ do let predicate eventType = evaluate . force . map show $ eventCxts stateType binders name eventType eventType <- runQ [t| forall a. (Ord a) => Int -> Query Char a |] predicate eventType `shouldThrow` anyErrorCall it "accepts types with unconstrained type variables" $ do eventType <- runQ [t| forall a. Int -> Query Char a |] eventCxts stateType binders name eventType `shouldBe` [] let x = mkName "x" it "accepts constrained type variables in the state" $ do let binders = [PlainTV (mkName "x")] stateType = ConT ''Maybe `AppT` VarT x eventType <- runQ [t| forall a. (Ord a) => Int -> Query (Maybe a) Int|] eventCxts stateType binders name eventType `shouldBe` #if MIN_VERSION_template_haskell(2,10,0) [ConT ''Ord `AppT` VarT x] #else [ClassP ''Ord [VarT x]] #endif it "can rename a polymorphic state" $ do eventType <- runQ [t| forall r m. (MonadReader r m, Ord r) => Int -> m Char |] eventCxts stateType binders name eventType `shouldBe` #if MIN_VERSION_template_haskell(2,10,0) [ConT ''Ord `AppT` ConT ''Char] #else [ClassP ''Ord [ConT ''Char]] #endif quoteShouldBe :: (Eq a, Show a) => Q a -> Q [a] -> Expectation quoteShouldBe qa qb = do actual <- runQ qa [expected] <- runQ qb actual `shouldBe` expected acid-state-0.16.0.1/test/Data/Acid/KeyValueStateMachine.hs0000644000000000000000000001444113660647235021220 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- | This module instantiates the general framework in -- 'Data.Acid.StateMachineTest' with an acid-state component that -- implements a simple key-value store. module Data.Acid.KeyValueStateMachine (tests) where import Control.DeepSeq import Control.Exception import Control.Monad.Reader import Control.Monad.State import Data.Acid import Data.Acid.StateMachineTest import Data.SafeCopy import qualified Data.Map as Map import Data.Typeable import GHC.Generics import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range type Key = Int type Value = String data KeyValue = KeyValue !(Map.Map Key Value) deriving (Eq, Show, Typeable) $(deriveSafeCopy 0 'base ''KeyValue) -- | Insert a key into the key-value store. insertKey :: Key -> Value -> Update KeyValue () insertKey key value = do KeyValue m <- get put (KeyValue (Map.insert key value m)) -- | A slightly more complicated update transaction: reverse the value -- at the given key, and return the resulting state. Crucially, this -- is non-idempotent, unlike 'insertKey'. reverseKey :: Key -> Update KeyValue KeyValue reverseKey key = do KeyValue m <- get let r = KeyValue (Map.adjust reverse key m) put r return r -- | An update that may fail: reverse the value at the given key, or -- fail if it is missing. reverseKeyOrFail :: Key -> Bomb -> Update KeyValue () reverseKeyOrFail key _ = do KeyValue m <- get case Map.lookup key m of Nothing -> failUpdate "key not in map" Just val -> put (KeyValue (Map.insert key (reverse val) m)) -- | An update that attempts to put an undefined state. This transaction should -- simply fail and not modify the state. breakState :: Update KeyValue () breakState = put (throw (TransactionError "broken state")) -- | An update that puts a partially-defined state. Unfortunately -- acid-state does not handle this case gracefully, and will fail with -- 'BlockedIndefinitelyOnMVar' (see #38). Thus this update is not -- included in 'keyValueCommands' below. breakState2 :: Update KeyValue () breakState2 = put (KeyValue (Map.singleton 1 (throw (TransactionError "broken state")))) -- | Look up a key from the store. lookupKey :: Key -> Query KeyValue (Maybe Value) lookupKey key = do KeyValue m <- ask return (Map.lookup key m) -- | Look up a key from the store, or fail if it is missing. lookupKeyOrFail :: Key -> Bomb -> Query KeyValue Value lookupKeyOrFail key _ = do KeyValue m <- ask maybe (failQuery "key not in map") return (Map.lookup key m) -- | Query the current value of the state. This is not used in the -- generated commands, but is used for checking the state we get back -- in 'prop_restore_old_state_1' etc. askState :: Query KeyValue KeyValue askState = ask $(makeAcidic ''KeyValue ['insertKey, 'reverseKey, 'reverseKeyOrFail, 'breakState, 'breakState2, 'lookupKey, 'lookupKeyOrFail, 'askState]) deriving instance Generic InsertKey deriving instance Generic ReverseKey deriving instance Generic ReverseKeyOrFail deriving instance Generic BreakState deriving instance Generic LookupKey deriving instance Generic LookupKeyOrFail deriving instance Show InsertKey deriving instance Show ReverseKey deriving instance Show ReverseKeyOrFail deriving instance Show BreakState deriving instance Show LookupKey deriving instance Show LookupKeyOrFail instance NFData InsertKey instance NFData ReverseKey instance NFData ReverseKeyOrFail instance NFData BreakState instance NFData LookupKey instance NFData LookupKeyOrFail genKey :: Gen Key genKey = Gen.int (Range.constant 1 10) genValue :: Gen Value genValue = Gen.string (Range.constant 0 10) Gen.alphaNum keyValueCommands :: MonadIO m => [Command Gen m (Model KeyValue)] keyValueCommands = [ acidUpdate (InsertKey <$> genKey <*> genValue) , acidUpdate (ReverseKey <$> genKey) , acidUpdateMayFail (ReverseKeyOrFail <$> genKey <*> genBomb) , acidUpdateMayFail (pure BreakState) , acidQuery (LookupKey <$> genKey) , acidQueryMayFail (LookupKeyOrFail <$> genKey <*> genBomb) ] -- | Possible initial states; because of #20 we can currently only use -- one of these when testing the properties. initialStates :: [KeyValue] initialStates = [ KeyValue Map.empty , KeyValue (Map.singleton 1 "foo") ] prop_sequential :: Property prop_sequential = acidStateSequentialProperty (acidStateInterface fp) (pure (head initialStates)) (Range.linear 1 10) keyValueCommands where fp = "state/KeyValueSequentialTest" prop_parallel :: Property prop_parallel = acidStateParallelProperty (acidStateInterface fp) (pure (head initialStates)) (Range.linear 1 10) (Range.linear 1 10) keyValueCommands where fp = "state/KeyValueParallelTest" prop_restore_old_state_1 :: Property prop_restore_old_state_1 = restoreOldStateProperty (acidStateInterface fp) (KeyValue Map.empty) AskState r where fp = "test-state/OldStateTest1" r = KeyValue (Map.fromList [(1,""),(2,""),(3,"y5Pl"),(4,""),(5,"Zc"),(6,"8aENKK") ,(7,"FDzyGCz"),(8,""),(9,"xq"),(10,"1Ra1obuINa")]) prop_restore_old_state_2 :: Property prop_restore_old_state_2 = restoreOldStateProperty (acidStateInterface fp) (KeyValue Map.empty) AskState r where fp = "test-state/OldStateTest2" r = KeyValue (Map.fromList [(1,"PLwR1S6F"),(2,"0yrcVQM0c"),(3,"zAA"),(4,"prAocOc") ,(5,"HM"),(6,"ENdfLrrW"),(7,"sESXGsI"),(8,"AFa69uu5") ,(9,"XBvIQHX"),(10,"A2CzkvW")]) prop_restore_old_state_3 :: Property prop_restore_old_state_3 = restoreOldStateProperty (acidStateInterface fp) (KeyValue Map.empty) AskState r where fp = "test-state/OldStateTest3" r = KeyValue (Map.fromList [(1,"4"),(2,"RQ1xEc5"),(3,"aT0Hqk"),(4,"Duf") ,(5,"tssCng7e0d"),(6,"uQW0hCVze"),(7,"FSCZPMGL") ,(8,"q1WI9He"),(9,"IYHbWmO"),(10,"lCErPJC3")]) tests :: IO Bool tests = checkParallel $$(discover) acid-state-0.16.0.1/test/Data/Acid/StateMachineTest.hs0000644000000000000000000005021213660647235020406 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- | This module provides a general framework for state-machine testing of -- acid-state components. It needs to be instantiated with a -- particular acid-state component to get a concrete test. module Data.Acid.StateMachineTest ( acidUpdate , acidUpdateMayFail , acidUpdateCheckFail , acidQuery , acidQueryMayFail , acidQueryCheckFail , acidStateSequentialProperty , acidStateParallelProperty , restoreOldStateProperty , acidStateInterface , AcidStateInterface(..) , Model(..) , open , close , checkpoint , checkpointClose , kill -- * Testing exceptions , TransactionError(..) , failQuery , failUpdate , Bomb(..) , explodeWHNF , explodeNF , genBomb ) where import Control.DeepSeq import Control.Exception (Exception, IOException, throw, catch, try, evaluate) import Control.Monad.Reader import Control.Monad.State import qualified Data.Acid as Acid import qualified Data.Acid.Common as Common import qualified Data.Acid.Core as Core import qualified Data.Acid.Local as Local import Data.Maybe import qualified Data.SafeCopy as SafeCopy import Data.Typeable import Hedgehog import qualified Hedgehog.Gen as Gen import System.Directory (removeDirectoryRecursive, removeFile) import System.IO.Unsafe (unsafePerformIO) -- | Exception to be thrown when a query or update fails. -- -- At the moment the only way to implement failing transactions is by -- throwing an exception from pure code. The state machine tests -- assume that all failures use 'failQuery' or 'failUpdate', which -- throw this exception. Thus we can catch this exception in cases -- where transaction failures are accepted. -- -- Even if acid-state provided a pure way to throw and catch errors in -- the 'Update' and 'Query' monads, we would still need to test that -- it correctly handles exceptions thrown during transactions. data TransactionError = TransactionError String deriving Show instance Exception TransactionError -- | Cause a 'Query' to fail in a (possibly) expected manner. See -- 'acidQueryMayFail' and 'acidQueryCheckFail'. failQuery :: String -> Acid.Query s a failQuery s = throw (TransactionError s) -- | Cause an 'Update' to fail in a (possibly) expected manner. See -- 'acidUpdateMayFail' and 'acidUpdateCheckFail'. failUpdate :: String -> Acid.Update s a failUpdate s = throw (TransactionError s) -- | Container for exceptions thrown from pure code. This is -- intended for use as an argument to transactions, for testing -- transactions that cannot be serialised. data Bomb = Bomb { unBomb :: Int } instance NFData Bomb where rnf (Bomb n) = rnf n -- | Slightly hacky 'Show' instance that will attempt to show -- something sensible even if evaluating the 'Bomb' throws an -- exception. instance Show Bomb where show b = "(Bomb " ++ s ++ ")" where s = unsafePerformIO $ evaluate (show (unBomb b)) `catch` \ TransactionError{} -> return "(exploded)" -- | Throw an exception when evaluated to WHNF. explodeWHNF :: Bomb explodeWHNF = throw (TransactionError "boom!") -- | Throw an exception when evaluated to NF (but not when -- evaluated to WHNF). explodeNF :: Bomb explodeNF = Bomb (throw (TransactionError "boom!")) -- | Generate a bomb that may or may not explode (throw an exception) -- when evaluated. genBomb :: Gen Bomb genBomb = Gen.element [Bomb 0, Bomb 1, Bomb 2, Bomb 3, explodeWHNF, explodeNF] $(SafeCopy.deriveSafeCopy 0 'SafeCopy.base ''Bomb) -- | Model of an acid-state component, for state machine property -- testing. We start in 'StateAbsent' and can transition to -- 'StateOpen' by opening the state for the first time. Thereafter we -- can transition between 'StateOpen' and 'StateClosed' by opening and -- closing the state. Both of the latter keep track of the current -- value of the state. data Model s (v :: * -> *) = StateAbsent -- ^ State is not present on disk | StateClosed s -- ^ State is present on disk, but not in memory | StateOpen s (Var (Opaque (Acid.AcidState s)) v) -- ^ State is open in memory -- | Return the handle to the acid-state component if it is open, or -- return 'Nothing' if it is closed or absent. modelHandle :: Model s v -> Maybe (Var (Opaque (Acid.AcidState s)) v) modelHandle (StateOpen _ hdl) = Just hdl modelHandle _ = Nothing -- | Is the state currently open? isOpen :: Model s v -> Bool isOpen = isJust . modelHandle -- | Return the current value of the state, if it is present. modelValue :: Model s v -> Maybe s modelValue (StateClosed s) = Just s modelValue (StateOpen s _) = Just s modelValue StateAbsent = Nothing -- | Description of the interface for performing -- meta-operations on an acid-state, such as opening, closing and -- checkpointing it. The testing code is abstracted over this -- interface so that we can substitute alternate serialisation -- backends. data AcidStateInterface s = (Typeable s, Acid.IsAcidic s, Show s) => AcidStateInterface { openState :: s -> IO (Acid.AcidState s) , closeState :: Acid.AcidState s -> IO () , checkpointState :: Acid.AcidState s -> IO () , checkpointCloseState :: Acid.AcidState s -> IO () , resetState :: IO () , statePath :: FilePath } -- | Standard implementation of the acid-state interface, using -- 'SafeCopy'-based serialisation. -- -- This takes the path to the state directory as an argument. -- Warning: this path will be deleted/overwritten! acidStateInterface :: (Acid.IsAcidic s, SafeCopy.SafeCopy s, Typeable s, Show s) => FilePath -> AcidStateInterface s acidStateInterface fp = AcidStateInterface { openState = Acid.openLocalStateFrom fp , closeState = Acid.closeAcidState , checkpointState = Acid.createCheckpoint , checkpointCloseState = Local.createCheckpointAndClose , resetState = removeDirectoryRecursive fp `catch` (\ (_ :: IOException) -> return ()) , statePath = fp } data Open s (v :: * -> *) = Open s deriving Show instance HTraversable (Open s) where htraverse _ (Open s) = pure (Open s) -- | Command to open the state, given the interface to use and a -- generator for possible initial state values. open :: MonadIO m => AcidStateInterface s -> Gen s -> Command Gen m (Model s) open AcidStateInterface{..} gen_initial_state = Command gen execute [ Require require, Update update ] where require model _ = not (isOpen model) gen StateAbsent = Just (Open <$> gen_initial_state) gen StateClosed{} = Just (Open <$> gen_initial_state) gen StateOpen{} = Nothing execute (Open initial_state) = liftIO (Opaque <$> openState initial_state) update StateAbsent (Open s) hdl = StateOpen s hdl update (StateClosed s) (Open _) hdl = StateOpen s hdl update StateOpen{} _ _ = error "open: state already open!" data WithState s (v :: * -> *) = WithState String (Var (Opaque (Acid.AcidState s)) v) deriving (Show) instance HTraversable (WithState s) where htraverse k (WithState l v) = WithState l <$> htraverse k v genWithState :: Applicative g => String -> Model s v -> Maybe (g (WithState s v)) genWithState l model = pure . WithState l <$> modelHandle model -- | Command to close the state. close :: MonadIO m => AcidStateInterface s -> Command Gen m (Model s) close AcidStateInterface{..} = Command (genWithState "Close") execute [ Require require, Update update ] where require model _ = isOpen model execute (WithState _ (Var (Concrete (Opaque st)))) = liftIO (closeState st) update (StateOpen s _) _ _ = StateClosed s update _ _ _ = error "close: not open" -- | Command to take a checkpoint of the state. checkpoint :: MonadIO m => AcidStateInterface s -> Command Gen m (Model s) checkpoint AcidStateInterface{..} = Command (genWithState "checkpoint") execute [ Require require ] where require model _ = isOpen model execute (WithState _ (Var (Concrete (Opaque st)))) = liftIO (checkpointState st) -- | Command to take a checkpoint and close the state, as a single atomic action. checkpointClose :: MonadIO m => AcidStateInterface s -> Command Gen m (Model s) checkpointClose AcidStateInterface{..} = Command (genWithState "checkpointClose") execute [ Require require, Update update ] where require model _ = isOpen model execute (WithState _ (Var (Concrete (Opaque st)))) = liftIO (checkpointCloseState st) update (StateOpen s _) _ _ = StateClosed s update _ _ _ = error "checkpointClose: not open" -- | Command to simulate killing the process without closing the -- state. This does not actually stop the old thread, though. -- -- The lock file is removed so that the state can be reopened -- (otherwise further commands would immediately fail). kill :: MonadIO m => AcidStateInterface s -> Command Gen m (Model s) kill AcidStateInterface{..} = Command (genWithState "kill") execute [ Require require, Update update ] where require model _ = isOpen model execute WithState{} = liftIO $ removeFile (statePath ++ "/open.lock") update (StateOpen s _) _ _ = StateClosed s update _ _ _ = error "kill: not open" data AcidCommand s e (v :: * -> *) = AcidCommand e (Var (Opaque (Acid.AcidState s)) v) deriving (Show) instance HTraversable (AcidCommand s e) where htraverse k (AcidCommand e s) = AcidCommand e <$> htraverse k s -- | Translate an acid-state update into a command that executes the -- update, given a generator of inputs. If the update fails, the -- property as a whole fails. acidUpdate :: forall s e m . ( Acid.IsAcidic s , Acid.EventState e ~ s , Acid.UpdateEvent e , Show e , NFData e , Eq (Acid.EventResult e) , Show (Acid.EventResult e) , Typeable (Acid.EventResult e) , MonadIO m ) => Gen e -> Command Gen m (Model s) acidUpdate = acidUpdateCheckFail (\ _ _ _ _ -> failure) -- | Translate an acid-state update into a command that executes the -- update, given a generator of inputs. If the update fails, the -- property as a whole succeeds. acidUpdateMayFail :: forall s e m . ( Acid.IsAcidic s , Acid.EventState e ~ s , Acid.UpdateEvent e , Show e , NFData e , Eq (Acid.EventResult e) , Show (Acid.EventResult e) , Typeable (Acid.EventResult e) , MonadIO m ) => Gen e -> Command Gen m (Model s) acidUpdateMayFail = acidUpdateCheckFail (\ _ _ _ _ -> return ()) -- | Translate an acid-state update into a command that executes the -- update, given a generator of inputs. If the update fails, the -- given predicate is tested on the old and new states, the event and -- the 'TransactionError' exception. acidUpdateCheckFail :: forall s e m . ( Acid.IsAcidic s , Acid.EventState e ~ s , Acid.UpdateEvent e , Show e , NFData e , Eq (Acid.EventResult e) , Show (Acid.EventResult e) , Typeable (Acid.EventResult e) , MonadIO m ) => (s -> s -> e -> TransactionError -> Test ()) -> Gen e -> Command Gen m (Model s) acidUpdateCheckFail allow_failure gen_event = Command gen execute [ Require require, Update update, Ensure ensure ] where -- Generate updates only when state is open gen :: Model s Symbolic -> Maybe (Gen (AcidCommand s e Symbolic)) gen model = case modelHandle model of Just st -> Just (AcidCommand <$> gen_event <*> pure st) Nothing -> Nothing -- Execute a concrete update directly using acid-state execute :: AcidCommand s e Concrete -> m (Either TransactionError (Acid.EventResult e)) execute (AcidCommand e (Var (Concrete (Opaque st)))) = liftIO (try (Acid.update st e)) -- Shrinking updates requires the state to be open require :: Model s Symbolic -> AcidCommand s e Symbolic -> Bool require model _ = isOpen model -- Updates cause the model state to be updated. This needs -- 'unsafePerformIO' because the update function must be pure, but -- we need to deal with the possibility of the transaction -- throwing a 'TransactionError' exception, in which case the -- state of the model should not change. We need to deepseq the -- update event itself, in case it contains a nested error that -- will show up during serialisation but is not forced by -- executing the transaction. update :: Model s v -> AcidCommand s e v -> Var (Either TransactionError (Acid.EventResult e)) v -> Model s v update (StateOpen s hdl) (AcidCommand c _) _ = unsafePerformIO $ do s' <- evaluate (c `deepseq` execState (lookupMethod c) s) `catch` \ (_ :: TransactionError) -> return s return (StateOpen s' hdl) update _ _ _ = error "acidUpdate: state not open" -- Evaluating the update directly on the model value of the old -- state should give the same result ensure :: Model s Concrete -> Model s Concrete -> AcidCommand s e Concrete -> Either TransactionError (Acid.EventResult e) -> Test () ensure model0 model1 (AcidCommand c _) (Left e) = case (modelValue model0, modelValue model1) of (Just v0, Just v1) -> allow_failure v0 v1 c e _ -> failure ensure model _ (AcidCommand c _) (Right o) = case modelValue model of Just v -> evalState (lookupMethod c) v === o Nothing -> failure -- | Translate an acid-state query into a command that executes the -- query, given a generator of inputs. If the query fails, the -- property as a whole fails. acidQuery :: forall s e m . ( Acid.IsAcidic s , Acid.EventState e ~ s , Acid.QueryEvent e , Show e , Eq (Acid.EventResult e) , Show (Acid.EventResult e) , Typeable (Acid.EventResult e) , MonadIO m , Eq s , Show s ) => Gen e -> Command Gen m (Model s) acidQuery = acidQueryCheckFail (\ _ _ _ -> failure) -- | Translate an acid-state query into a command that executes the -- query, given a generator of inputs. If the query fails, the -- property as a whole succeeds. acidQueryMayFail :: forall s e m . ( Acid.IsAcidic s , Acid.EventState e ~ s , Acid.QueryEvent e , Show e , Eq (Acid.EventResult e) , Show (Acid.EventResult e) , Typeable (Acid.EventResult e) , MonadIO m , Eq s , Show s ) => Gen e -> Command Gen m (Model s) acidQueryMayFail = acidQueryCheckFail (\ _ _ _ -> return ()) -- | Translate an acid-state query into a command that executes the -- query, given a generator of inputs. If the query fails, the given -- predicate is tested on the state, the event and the -- 'TransactionError' exception. acidQueryCheckFail :: forall s e m . ( Acid.IsAcidic s , Acid.EventState e ~ s , Acid.QueryEvent e , Show e , Eq (Acid.EventResult e) , Show (Acid.EventResult e) , Typeable (Acid.EventResult e) , MonadIO m , Eq s , Show s ) => (s -> e -> TransactionError -> Test ()) -> Gen e -> Command Gen m (Model s) acidQueryCheckFail allow_failure gen_event = Command gen execute [ Require require , Ensure unchanged_model , Ensure correct_output ] where -- Generate queries only when state is open gen model = case modelHandle model of Just st -> Just (AcidCommand <$> gen_event <*> pure st) Nothing -> Nothing -- Execute a concrete query directly using acid-state execute (AcidCommand e (Var (Concrete (Opaque st)))) = liftIO (try (evaluate =<< Acid.query st e)) -- Shrinking queries requires the state to be open require model _ = isOpen model -- Queries should not change the value in the model unchanged_model model0 model1 _ _ = modelValue model0 === modelValue model1 -- Evaluating the query directly on the model value of the old -- state should give the same result correct_output model _ (AcidCommand c _) r = case modelValue model of Just v -> case r of Right o -> evalState (lookupMethod c) v === o Left e -> allow_failure v c e Nothing -> failure -- | Extract the underlying method implementation in the pure 'State' -- monad for an acid-state query or update. lookupMethod :: (Core.Method m, Acid.IsAcidic (Core.MethodState m)) => m -> State (Core.MethodState m) (Core.MethodResult m) lookupMethod m = Core.lookupHotMethod mmap m where mmap = Core.mkMethodMap (Common.eventsToMethods Common.acidEvents) -- | Test the sequential property (agreement between model and -- implementation) for an acid-state component, given the interface, a -- generator for initial values of the state, and a list of commands -- built from 'acidQuery' and 'acidUpdate'. Additional commands will -- be added to open and close the state. -- -- Note that if the generator for initial values can return more than -- one result, this will fail due to #20. acidStateSequentialProperty :: AcidStateInterface s -> Gen s -> Range Int -> [Command Gen (TestT IO) (Model s)] -> Property acidStateSequentialProperty i gen_initial_state range commands = property $ do actions <- forAll $ Gen.sequential range StateAbsent $ [ open i gen_initial_state , close i , checkpoint i , checkpointClose i , kill i ] ++ commands ++ commands test $ do liftIO $ resetState i executeSequential StateAbsent actions -- | Test the parallel property (absence of race conditions) for an -- acid-state component, given the interface, a generator for initial -- values of the state, and a list of commands built from 'acidQuery' -- and 'acidUpdate'. Additional commands will be added to open and -- close the state. -- -- Note that if the generator for initial values can return more than -- one result, this will fail due to #20. -- -- The state cannot be opened twice in parallel, so the length of the -- sequential prefix must be at least 1, so that the open command -- happens exactly once. acidStateParallelProperty :: AcidStateInterface s -> Gen s -> Range Int -> Range Int -> [Command Gen (TestT IO) (Model s)] -> Property acidStateParallelProperty i gen_initial_state prefix_range parallel_range commands = property $ do actions <- forAll $ Gen.parallel prefix_range parallel_range StateAbsent $ [ open i gen_initial_state , checkpoint i ] ++ commands ++ commands test $ do liftIO $ resetState i executeParallel StateAbsent actions -- | Test that restoring an acid-state component (with the given initial -- value), then executing the given query, results in the given -- expected value. This is mostly useful to test that restoring from -- files created by an older version of acid-state can still be read. restoreOldStateProperty :: (Acid.EventState e ~ s, Acid.EventResult e ~ r, Acid.QueryEvent e, Eq r, Show r) => AcidStateInterface s -> s -> e -> r -> Property restoreOldStateProperty i initial_state q expected_result = withTests 1 $ property $ test $ do liftIO $ removeFile (statePath i ++ "/open.lock") `catch` (\ (_ :: IOException) -> return ()) st <- liftIO $ openState i initial_state r <- liftIO $ Acid.query st q r === expected_result acid-state-0.16.0.1/examples/0000755000000000000000000000000013660647235013773 5ustar0000000000000000acid-state-0.16.0.1/examples/CheckpointCutsEvent.hs0000644000000000000000000000654613660647235020272 0ustar0000000000000000{- This example is mostly just to test that this bug is fixed: https://github.com/acid-state/acid-state/issues/73 At the end of a run, the checkpoint file should contain a single checkpoint and the event file should be empty. The old checkpoints and events should be in the Archive directory. In the Acrhive directory, each checkpoint file should contain one checkpoint, and each event file should contain 10 events. If you comment out the 'createArchive' line below, then the checkpoint files should contain 10 checkpoints each. -} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module CheckpointCutsEvent (main) where -- import Control.Concurrent import Control.Applicative import Control.Monad.Reader import Control.Monad.State import Data.Acid import Data.List import Data.SafeCopy import Data.Typeable import System.Directory import System.Environment ------------------------------------------------------ -- The Haskell structure that we want to encapsulate newtype Counter = Counter { unCounter :: Integer } deriving (Show, Typeable) $(deriveSafeCopy 0 'base ''Counter) incCounter :: Update Counter Integer incCounter = do (Counter c) <- get let c' = succ c put (Counter c') return c' $(makeAcidic ''Counter ['incCounter]) main :: IO () main = do putStrLn "CheckpointCutsEvent test" exists <- doesDirectoryExist fp when exists $ removeDirectoryRecursive fp acid <- openLocalStateFrom fp (Counter 0) replicateM_ 10 $ do is <- replicateM 10 (update acid IncCounter) print is createCheckpoint acid createArchive acid closeAcidState acid checkDirectoryContents fp expected_state checkDirectoryContents (fp ++ "/Archive") expected_archive s <- readFile (fp ++ "/events-0000000100.log") unless (s == "") $ error "non-empty events file" putStrLn "CheckpointCutsEvent done" where fp = "state/CheckpointCutsEvent" expected_state = [".","..","Archive","checkpoints-0000000009.log","checkpoints-0000000010.log" ,"checkpoints.version","events-0000000100.log","events.version","open.lock"] expected_archive = [".","..","checkpoints-0000000000.log","checkpoints-0000000001.log" ,"checkpoints-0000000002.log","checkpoints-0000000003.log","checkpoints-0000000004.log" ,"checkpoints-0000000005.log","checkpoints-0000000006.log","checkpoints-0000000007.log" ,"checkpoints-0000000008.log","events-0000000000.log","events-0000000010.log" ,"events-0000000020.log","events-0000000030.log","events-0000000040.log" ,"events-0000000050.log","events-0000000060.log","events-0000000070.log" ,"events-0000000080.log","events-0000000090.log"] checkDirectoryContents :: FilePath -> [FilePath] -> IO () checkDirectoryContents fp expected_fs = do putStrLn $ "Checking contents of " ++ fp fs <- sort <$> getDirectoryContents fp unless (fs == expected_fs) $ error $ "bad contents of " ++ fp ++ ": expected " ++ show expected_fs ++ " but got " ++ show fs acid-state-0.16.0.1/examples/Examples.hs0000644000000000000000000000055313660647235016110 0ustar0000000000000000module Main (main) where import qualified ChangeState import qualified ChangeVersion import qualified CheckpointCutsEvent import qualified Exceptions import qualified RemoveEvent import qualified SlowCheckpoint main :: IO () main = do ChangeState.test ChangeVersion.test CheckpointCutsEvent.main Exceptions.test RemoveEvent.test SlowCheckpoint.main acid-state-0.16.0.1/examples/HelloDatabase.hs0000644000000000000000000000261113660647235017017 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module HelloDatabase (main) where import Data.Acid import Control.Monad.Reader (ask) import Control.Monad.State (get, put) import Data.SafeCopy import System.Environment (getArgs) type Message = String data Database = Database [Message] $(deriveSafeCopy 0 'base ''Database) -- Transactions are defined to run in either the 'Update' monad -- or the 'Query' monad. addMessage :: Message -> Update Database () addMessage msg = do Database messages <- get put $ Database (msg:messages) viewMessages :: Int -> Query Database [Message] viewMessages limit = do Database messages <- ask return $ take limit messages -- This will define @ViewMessage@ and @AddMessage@ for us. $(makeAcidic ''Database ['addMessage, 'viewMessages]) main :: IO () main = do args <- getArgs database <- openLocalStateFrom "myDatabase/" (Database ["Welcome to the acid-state database."]) if null args then do messages <- query database (ViewMessages 10) putStrLn "Last 10 messages:" mapM_ putStrLn [ " " ++ message | message <- messages ] else do update database (AddMessage (unwords args)) putStrLn "Your message has been added to the database." acid-state-0.16.0.1/examples/RemoteClient.hs0000644000000000000000000000322213660647235016720 0ustar0000000000000000module RemoteClient (main) where import Control.Monad.Reader import Data.Acid import Data.Acid.Advanced import Data.Acid.Remote import Network.Socket (SockAddr(..)) import RemoteCommon import System.Environment import System.IO ------------------------------------------------------ -- This is how AcidState is used: open :: IO (AcidState StressState) open = openRemoteState skipAuthenticationPerform "localhost" 8080 -- on Unixy systems we could use a Unix Domain Socket -- open = openRemoteStateSockAddr skipAuthenticationPerform (SockAddrUnix "remote.socket") main :: IO () main = do args <- getArgs case args of ["checkpoint"] -> do acid <- open createCheckpoint acid ["query"] -> do acid <- open n <- query acid QueryState putStrLn $ "State value: " ++ show n ["poke"] -> do acid <- open putStr "Issuing 100k transactions... " hFlush stdout replicateM_ (100000-1) (scheduleUpdate acid PokeState) update acid PokeState putStrLn "Done" ["clear"] -> do acid <- open update acid ClearState createCheckpoint acid _ -> do putStrLn "Commands:" putStrLn " query Prints out the current state." putStrLn " poke Spawn 100k transactions." putStrLn " checkpoint Create a new checkpoint." acid-state-0.16.0.1/examples/HelloWorldNoTH.hs0000644000000000000000000000512013660647235017131 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} module HelloWorldNoTH (main) where import Data.Acid import Data.Acid.Advanced import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy import System.Environment import Data.Typeable ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data HelloWorldState = HelloWorldState String deriving (Show, Typeable) instance SafeCopy HelloWorldState where putCopy (HelloWorldState state) = contain $ safePut state getCopy = contain $ liftM HelloWorldState safeGet ------------------------------------------------------ -- The transaction we will execute over the state. writeState :: String -> Update HelloWorldState () writeState newValue = put (HelloWorldState newValue) queryState :: Query HelloWorldState String queryState = do HelloWorldState string <- ask return string ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do acid <- openLocalState (HelloWorldState "Hello world") args <- getArgs if null args then do string <- query acid QueryState putStrLn $ "The state is: " ++ string else do update acid (WriteState (unwords args)) putStrLn "The state has been modified!" ------------------------------------------------------ -- The gritty details. These things may be done with -- Template Haskell in the future. data WriteState = WriteState String data QueryState = QueryState deriving instance Typeable WriteState instance SafeCopy WriteState where putCopy (WriteState st) = contain $ safePut st getCopy = contain $ liftM WriteState safeGet instance Method WriteState where type MethodResult WriteState = () type MethodState WriteState = HelloWorldState instance UpdateEvent WriteState deriving instance Typeable QueryState instance SafeCopy QueryState where putCopy QueryState = contain $ return () getCopy = contain $ return QueryState instance Method QueryState where type MethodResult QueryState = String type MethodState QueryState = HelloWorldState instance QueryEvent QueryState instance IsAcidic HelloWorldState where acidEvents = [ UpdateEvent (\(WriteState newState) -> writeState newState) safeCopyMethodSerialiser , QueryEvent (\QueryState -> queryState) safeCopyMethodSerialiser ] acid-state-0.16.0.1/examples/MonadStateConstraint.hs0000644000000000000000000000272213660647235020436 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module MonadStateConstraint (main) where import Control.Monad.Reader import Control.Monad.State import Data.Acid import Data.SafeCopy import Data.Typeable import System.Environment ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data HelloWorldState = HelloWorldState String deriving (Show, Typeable) $(deriveSafeCopy 0 'base ''HelloWorldState) ------------------------------------------------------ -- The transaction we will execute over the state. writeState :: MonadState HelloWorldState m => String -> m () writeState newValue = put (HelloWorldState newValue) queryState :: MonadReader HelloWorldState m => m String queryState = do HelloWorldState string <- ask return string $(makeAcidic ''HelloWorldState ['writeState, 'queryState]) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do acid <- openLocalState (HelloWorldState "Hello world") args <- getArgs if null args then do string <- query acid QueryState putStrLn $ "The state is: " ++ string else do update acid (WriteState (unwords args)) putStrLn "The state has been modified!" acid-state-0.16.0.1/examples/ParameterisedState.hs0000644000000000000000000000240013660647235020111 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} module ParameterisedState (main) where import Control.Monad.State.Strict import Data.Acid import qualified Data.Map as Map import Data.SafeCopy (SafeCopy(..), deriveSafeCopy, base) import Data.Serialize import Data.Typeable import GHC.Generics data Entry k = Entry { key :: !k , val :: !Int } deriving (Eq, Ord, Generic) instance Serialize k => Serialize (Entry k) $(deriveSafeCopy 0 'base ''Entry) newtype Store k = Store { store :: Map.Map k (Entry k) } deriving (Eq, Generic) #if __GLASGOW_HASKELL__ <= 708 deriving instance Typeable1 Store #endif instance (Ord k, Serialize k, SafeCopy k, Typeable k) => SafeCopy (Store k) instance (Ord k, Serialize k) => Serialize (Store k) insertStore :: (Ord k, Serialize k) => Entry k -> Update (Store k) k insertStore item = do modify $ \(Store s) -> Store $ Map.insert (key item) item s return (key item) makeAcidic ''Store [ 'insertStore ] main :: IO () main = do st <- openLocalState (Store Map.empty :: Store String) k <- update st (InsertStore (Entry "A" 42)) putStrLn k acid-state-0.16.0.1/examples/StressTestNoTH.hs0000644000000000000000000000562013660647235017206 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} module StressTestNoTH (main) where import Data.Acid import Data.Acid.Advanced import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy import System.Environment import System.IO import Data.Typeable ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data StressState = StressState !Int deriving (Typeable) instance SafeCopy StressState where putCopy (StressState state) = contain $ safePut state getCopy = contain $ liftM StressState safeGet ------------------------------------------------------ -- The transaction we will execute over the state. pokeState :: Update StressState () pokeState = do StressState i <- get put (StressState (i+1)) queryState :: Query StressState Int queryState = do StressState i <- ask return i ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do args <- getArgs acid <- openLocalState (StressState 0) case args of ["checkpoint"] -> createCheckpoint acid ["query"] -> do n <- query acid QueryState putStrLn $ "State value: " ++ show n ["poke"] -> do putStr "Issuing 100k transactions... " hFlush stdout groupUpdates acid (replicate 100000 PokeState) putStrLn "Done" _ -> do putStrLn "Commands:" putStrLn " query Prints out the current state." putStrLn " poke Spawn 100k transactions." putStrLn " checkpoint Create a new checkpoint." ------------------------------------------------------ -- The gritty details. These things may be done with -- Template Haskell in the future. data PokeState = PokeState data QueryState = QueryState deriving instance Typeable PokeState instance SafeCopy PokeState where putCopy PokeState = contain $ return () getCopy = contain $ return PokeState instance Method PokeState where type MethodResult PokeState = () type MethodState PokeState = StressState instance UpdateEvent PokeState deriving instance Typeable QueryState instance SafeCopy QueryState where putCopy QueryState = contain $ return () getCopy = contain $ return QueryState instance Method QueryState where type MethodResult QueryState = Int type MethodState QueryState = StressState instance QueryEvent QueryState instance IsAcidic StressState where acidEvents = [ UpdateEvent (\PokeState -> pokeState) safeCopyMethodSerialiser , QueryEvent (\QueryState -> queryState) safeCopyMethodSerialiser ] acid-state-0.16.0.1/examples/RemoteServer.hs0000644000000000000000000000115413660647235016752 0ustar0000000000000000module RemoteServer where import Control.Exception (bracket) import Data.Acid (closeAcidState, openLocalState) import Data.Acid.Remote (acidServer, acidServerSockAddr, skipAuthenticationCheck) import RemoteCommon (StressState (..)) import Network.Socket (SockAddr(..)) main :: IO () main = bracket (openLocalState $ StressState 0) closeAcidState $ acidServer skipAuthenticationCheck 8080 -- on Unixy systems we could use a Unix Domain Socket -- closeAcidState $ acidServerSockAddr skipAuthenticationCheck (SockAddrUnix "remote.socket") acid-state-0.16.0.1/examples/HelloWorld.hs0000644000000000000000000000261413660647235016405 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module HelloWorld (main) where import Control.Monad.Reader import Control.Monad.State import Data.Acid import Data.SafeCopy import Data.Typeable import System.Environment ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data HelloWorldState = HelloWorldState String deriving (Show, Typeable) $(deriveSafeCopy 0 'base ''HelloWorldState) ------------------------------------------------------ -- The transaction we will execute over the state. writeState :: String -> Update HelloWorldState () writeState newValue = put (HelloWorldState newValue) queryState :: Query HelloWorldState String queryState = do HelloWorldState string <- ask return string $(makeAcidic ''HelloWorldState ['writeState, 'queryState]) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do acid <- openLocalState (HelloWorldState "Hello world") args <- getArgs if null args then do string <- query acid QueryState putStrLn $ "The state is: " ++ string else do update acid (WriteState (unwords args)) putStrLn "The state has been modified!" acid-state-0.16.0.1/examples/KeyValue.hs0000644000000000000000000000373213660647235016061 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module KeyValue (main) where import Data.Acid import Data.Acid.Remote import Control.Applicative import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy import System.Environment import System.Exit import System.IO import Data.Typeable import qualified Data.Map as Map ------------------------------------------------------ -- The Haskell structure that we want to encapsulate type Key = String type Value = String data KeyValue = KeyValue !(Map.Map Key Value) deriving (Typeable) $(deriveSafeCopy 0 'base ''KeyValue) ------------------------------------------------------ -- The transaction we will execute over the state. insertKey :: Key -> Value -> Update KeyValue () insertKey key value = do KeyValue m <- get put (KeyValue (Map.insert key value m)) lookupKey :: Key -> Query KeyValue (Maybe Value) lookupKey key = do KeyValue m <- ask return (Map.lookup key m) $(makeAcidic ''KeyValue ['insertKey, 'lookupKey]) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do args <- getArgs acid <- openLocalState (KeyValue Map.empty) case args of [key] -> do mbKey <- query acid (LookupKey key) case mbKey of Nothing -> putStrLn $ key ++ " has no associated value." Just value -> putStrLn $ key ++ " = " ++ value [key,val] -> do update acid (InsertKey key val) putStrLn "Done." _ -> do putStrLn "Usage:" putStrLn " key Lookup the value of 'key'." putStrLn " key value Set the value of 'key' to 'value'." closeAcidState acid acid-state-0.16.0.1/examples/StressTest.hs0000644000000000000000000000403713660647235016456 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module StressTest (main) where import Data.Acid import Data.Acid.Advanced (groupUpdates) import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy import System.Environment import System.IO import Data.Typeable ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data StressState = StressState !Int deriving (Typeable) $(deriveSafeCopy 0 'base ''StressState) ------------------------------------------------------ -- The transaction we will execute over the state. pokeState :: Update StressState () pokeState = do StressState i <- get put (StressState (i+1)) queryState :: Query StressState Int queryState = do StressState i <- ask return i clearState :: Update StressState () clearState = put $ StressState 0 $(makeAcidic ''StressState ['pokeState, 'queryState, 'clearState]) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do args <- getArgs acid <- openLocalState (StressState 0) case args of ["checkpoint"] -> createCheckpoint acid ["query"] -> do n <- query acid QueryState putStrLn $ "State value: " ++ show n ["poke"] -> do putStr "Issuing 100k transactions... " hFlush stdout groupUpdates acid (replicate 100000 PokeState) putStrLn "Done" ["clear"] -> do update acid ClearState createCheckpoint acid _ -> do putStrLn "Commands:" putStrLn " query Prints out the current state." putStrLn " poke Spawn 100k transactions." putStrLn " checkpoint Create a new checkpoint." acid-state-0.16.0.1/examples/RemoteCommon.hs0000644000000000000000000000170213660647235016733 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module RemoteCommon where import Control.Monad.Reader import Control.Monad.State import Data.Acid import Data.SafeCopy import Data.Typeable ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data StressState = StressState !Int deriving (Typeable) $(deriveSafeCopy 0 'base ''StressState) ------------------------------------------------------ -- The transaction we will execute over the state. pokeState :: Update StressState () pokeState = do StressState i <- get put (StressState (i+1)) queryState :: Query StressState Int queryState = do StressState i <- ask return i clearState :: Update StressState () clearState = put $ StressState 0 $(makeAcidic ''StressState ['pokeState, 'queryState, 'clearState]) acid-state-0.16.0.1/examples/SlowCheckpoint.hs0000644000000000000000000000632613660647235017272 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- With optimizations enabled, serializing the checkpoint can happen too quickly {-# OPTIONS_GHC -O0 #-} module SlowCheckpoint (main) where import Data.Acid import Control.Concurrent import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy import Data.Time import System.Directory import System.IO ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data SlowCheckpoint = SlowCheckpoint Int Int $(deriveSafeCopy 0 'base ''SlowCheckpoint) ------------------------------------------------------ -- The transaction we will execute over the state. -- This transaction adds a very computationally heavy entry -- into our state. However, since the state is lazy, the -- chunk will not be forced until we create a checkpoint. -- Computing 'last [0..100000000]' takes roughly 2 seconds -- on my machine. XXX Lemmih, 2011-04-26 setComputationallyHeavyData :: Update SlowCheckpoint () setComputationallyHeavyData = do SlowCheckpoint _slow tick <- get put $ SlowCheckpoint (last [0..100000000]) tick tick :: Update SlowCheckpoint Int tick = do SlowCheckpoint slow tick <- get put $ SlowCheckpoint slow (tick+1) return tick askTick :: Query SlowCheckpoint Int askTick = do SlowCheckpoint _ tick <- ask return tick $(makeAcidic ''SlowCheckpoint ['setComputationallyHeavyData, 'tick, 'askTick]) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do putStrLn "SlowCheckpoint test" exists <- doesDirectoryExist fp when exists $ removeDirectoryRecursive fp acid <- openLocalStateFrom fp (SlowCheckpoint 0 0) putStrLn "This example illustrates that the state is still accessible while" putStrLn "a checkpoint is being serialized. This is an important property when" putStrLn "the size of a checkpoint reaches several hundred megabytes." putStrLn "If you don't see any ticks while the checkpoint is being created, something" putStrLn "has gone awry." putStrLn "" doTick acid update acid SetComputationallyHeavyData forkIO $ do putStrLn "Serializing checkpoint..." t <- timeIt $ createCheckpoint acid n <- query acid AskTick putStrLn $ "Checkpoint created in: " ++ show t ++ " (saw " ++ show n ++ " ticks)" when (n < threshold) $ error $ "Not enough ticks! Expected at least " ++ show threshold replicateM_ 20 $ do doTick acid threadDelay (10^5) putStrLn "SlowCheckpoint done" where fp = "state/SlowCheckpoint" -- We must see at least this many ticks for the test to be considered a success threshold = 5 doTick acid = do tick <- update acid Tick putStrLn $ "Tick: " ++ show tick timeIt action = do t1 <- getCurrentTime ret <- action t2 <- getCurrentTime return (diffUTCTime t2 t1) acid-state-0.16.0.1/examples/KeyValueNoTH.hs0000644000000000000000000000616613660647235016616 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} module KeyValueNoTH (main) where import Data.Acid import Data.Acid.Advanced import Control.Applicative import Control.Monad.Reader import qualified Control.Monad.State as State import Data.SafeCopy import System.Environment import System.IO import Data.Typeable import qualified Data.Map as Map ------------------------------------------------------ -- The Haskell structure that we want to encapsulate type Key = String type Value = String data KeyValue = KeyValue !(Map.Map Key Value) deriving (Typeable) instance SafeCopy KeyValue where putCopy (KeyValue state) = contain $ safePut state getCopy = contain $ liftM KeyValue safeGet ------------------------------------------------------ -- The transaction we will execute over the state. insertKey :: Key -> Value -> Update KeyValue () insertKey key value = do KeyValue m <- State.get State.put (KeyValue (Map.insert key value m)) lookupKey :: Key -> Query KeyValue (Maybe Value) lookupKey key = do KeyValue m <- ask return (Map.lookup key m) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do acid <- openLocalState (KeyValue Map.empty) args <- getArgs case args of [key] -> do mbKey <- query acid (LookupKey key) case mbKey of Nothing -> putStrLn $ key ++ " has no associated value." Just value -> putStrLn $ key ++ " = " ++ value [key,val] -> do update acid (InsertKey key val) putStrLn "Done." _ -> do putStrLn "Usage:" putStrLn " key Lookup the value of 'key'." putStrLn " key value Set the value of 'key' to 'value'." closeAcidState acid ------------------------------------------------------ -- The gritty details. These things may be done with -- Template Haskell in the future. data InsertKey = InsertKey Key Value data LookupKey = LookupKey Key deriving instance Typeable InsertKey instance SafeCopy InsertKey where putCopy (InsertKey key value) = contain $ safePut key >> safePut value getCopy = contain $ InsertKey <$> safeGet <*> safeGet instance Method InsertKey where type MethodResult InsertKey = () type MethodState InsertKey = KeyValue instance UpdateEvent InsertKey deriving instance Typeable LookupKey instance SafeCopy LookupKey where putCopy (LookupKey key) = contain $ safePut key getCopy = contain $ LookupKey <$> safeGet instance Method LookupKey where type MethodResult LookupKey = Maybe Value type MethodState LookupKey = KeyValue instance QueryEvent LookupKey instance IsAcidic KeyValue where acidEvents = [ UpdateEvent (\(InsertKey key value) -> insertKey key value) safeCopyMethodSerialiser , QueryEvent (\(LookupKey key) -> lookupKey key) safeCopyMethodSerialiser ] acid-state-0.16.0.1/examples/Proxy.hs0000644000000000000000000000575313660647235015462 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Proxy (main) where import Data.Acid import Data.Acid.Advanced (scheduleUpdate) import Data.Acid.Remote import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy import System.Environment import System.IO import Data.Typeable ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data ProxyStressState = StressState !Int deriving (Typeable) $(deriveSafeCopy 0 'base ''ProxyStressState) ------------------------------------------------------ -- The transaction we will execute over the state. pokeState :: Update ProxyStressState () pokeState = do StressState i <- get put (StressState (i+1)) queryState :: Query ProxyStressState Int queryState = do StressState i <- ask return i clearState :: Update ProxyStressState () clearState = put $ StressState 0 $(makeAcidic ''ProxyStressState ['pokeState, 'queryState, 'clearState]) openLocal :: IO (AcidState ProxyStressState) openLocal = openLocalState (StressState 0) openRemote :: String -> IO (AcidState ProxyStressState) openRemote socket = openRemoteState skipAuthenticationPerform "localhost" port port = 6303 main :: IO () main = do args <- getArgs case args of ["server", socket] -> do acid <- openLocal acidServer skipAuthenticationCheck port acid ["proxy", from, to] -> do acid <- openRemote from acidServer skipAuthenticationCheck port acid ["query", socket] -> do acid <- openRemote socket n <- query acid QueryState putStrLn $ "State value: " ++ show n ["poke", socket] -> do acid <- openRemote socket putStr "Issuing 100k transactions... " hFlush stdout replicateM_ (100000-1) (scheduleUpdate acid PokeState) update acid PokeState putStrLn "Done" ["clear", socket] -> do acid <- openRemote socket update acid ClearState createCheckpoint acid ["checkpoint", socket] -> do acid <- openRemote socket createCheckpoint acid _ -> do putStrLn "Commands:" putStrLn " server socket Start a new server instance." putStrLn " proxy from to Pipe events between 'from' and 'to'." putStrLn " query socket Prints out the current state." putStrLn " poke socket Spawn 100k transactions." putStrLn " clear socket Reset the state and write a checkpoint." putStrLn " checkpoint socket Create a new checkpoint." acid-state-0.16.0.1/examples/errors/0000755000000000000000000000000013660647235015307 5ustar0000000000000000acid-state-0.16.0.1/examples/errors/Exceptions.hs0000644000000000000000000000722613660647235017773 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Exceptions (main, test) where import Data.Acid import Data.Acid.Local (createCheckpointAndClose) import Control.Monad.State import Data.SafeCopy import System.Directory import System.Environment import Data.Typeable import Control.Exception import Prelude hiding (catch) ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data MyState = MyState Integer deriving (Show, Typeable) $(deriveSafeCopy 0 'base ''MyState) ------------------------------------------------------ -- The transaction we will execute over the state. failEvent :: Update MyState () failEvent = pure $ error "fail!" errorEvent :: Update MyState () errorEvent = error "error!" stateError :: Update MyState () stateError = put (error "state error!") stateNestedError1 :: Update MyState () stateNestedError1 = put (MyState (error "nested state error (1)")) stateNestedError2 :: Integer -> Update MyState () stateNestedError2 n = put (MyState n) tick :: Update MyState Integer tick = do MyState n <- get put $ MyState (n+1) return n $(makeAcidic ''MyState [ 'failEvent , 'errorEvent , 'stateError , 'stateNestedError1 , 'stateNestedError2 , 'tick ]) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do acid <- openLocalStateFrom "state/Exceptions" (MyState 0) args <- getArgs case args of ["1"] -> update acid (undefined :: FailEvent) ["2"] -> update acid FailEvent ["3"] -> update acid ErrorEvent ["4"] -> update acid StateError ["5"] -> update acid StateNestedError1 ["6"] -> update acid (StateNestedError2 (error "nested state error (2)")) _ -> do putStrLn "Call with [123456] to test error scenarios." putStrLn "If the tick doesn't get stuck, everything is fine." do_tick acid `catch` \e -> do putStrLn $ "Caught exception: " ++ show (e:: SomeException) createCheckpointAndClose acid do_tick :: AcidState MyState -> IO () do_tick acid = do n <- update acid Tick putStrLn $ "Tick: " ++ show n test :: IO () test = do putStrLn "Exceptions test" exists <- doesDirectoryExist fp when exists $ removeDirectoryRecursive fp acid <- openLocalStateFrom fp (MyState 0) do_tick acid handle hdl $ update acid (undefined :: FailEvent) do_tick acid handle hdl $ update acid FailEvent do_tick acid handle hdl $ update acid ErrorEvent do_tick acid handle hdl $ update acid StateError do_tick acid -- We can't currently cope with an error being thrown during serialization of the state (see #38) -- handle hdl $ update acid StateNestedError1 do_tick acid handle hdl $ update acid (StateNestedError2 (error "nested state error (2)")) do_tick acid n <- update acid Tick unless (n == expected_n) $ error $ "Wrong tick value, expected " ++ show expected_n createCheckpointAndClose acid putStrLn "Exceptions done" where fp = "state/Exceptions" hdl e = putStrLn $ "Caught exception: " ++ show (e:: SomeException) expected_n = 7 acid-state-0.16.0.1/examples/errors/RemoveEvent.hs0000644000000000000000000000411413660647235020102 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module RemoveEvent (main, test) where import Data.Acid import Control.Monad.State import Data.SafeCopy import System.Directory import System.Environment import Data.List (isSuffixOf) import Data.Typeable import Control.Exception import Prelude hiding (catch) ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data FirstState = FirstState deriving (Show) data SecondState = SecondState deriving (Show) $(deriveSafeCopy 0 'base ''FirstState) $(deriveSafeCopy 0 'base ''SecondState) ------------------------------------------------------ -- The transaction we will execute over the state. firstEvent :: Update FirstState () firstEvent = return () $(makeAcidic ''FirstState ['firstEvent]) $(makeAcidic ''SecondState []) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do putStrLn "This example simulates what happens when you remove an event" putStrLn "that is required to replay the journal." putStrLn "Hopefully this program will fail with a readable error message." putStrLn "" firstAcid <- openLocalStateFrom fp FirstState update firstAcid FirstEvent closeAcidState firstAcid secondAcid <- openLocalStateFrom fp SecondState closeAcidState secondAcid error "If you see this message then something has gone wrong!" test :: IO () test = do putStrLn "RemoveEvent test" exists <- doesDirectoryExist fp when exists $ removeDirectoryRecursive fp handle hdl main putStrLn "RemoveEvent done" where hdl (ErrorCall msg) | "This method is required but not available: \"RemoveEvent.FirstEvent\". Did you perhaps remove it before creating a checkpoint?" `isSuffixOf` msg = putStrLn $ "Caught error: " ++ msg hdl e = throwIO e fp = "state/RemoveEvent" acid-state-0.16.0.1/examples/errors/ChangeVersion.hs0000644000000000000000000000451313660647235020401 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module ChangeVersion (main, test) where import Data.Acid import Control.Exception import Control.Monad.State import Data.SafeCopy import System.Directory import System.Environment ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data FirstState = FirstState String deriving (Show) data SecondState = SecondState Int deriving (Show) $(deriveSafeCopy 0 'base ''FirstState) $(deriveSafeCopy 1 'base ''SecondState) -- The version number difference is important here, as safecopy has no -- way to reliably notice if we change a type and fail to update its -- migration history. In some cases the serialised data will fail to -- parse (see the "ChangeState" example), but it depends on the types -- involved, and this will not always be the case. ------------------------------------------------------ -- The transaction we will execute over the state. $(makeAcidic ''FirstState []) $(makeAcidic ''SecondState []) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do putStrLn "This example simulates what happens when you modify your safecopy" putStrLn "version without specifying how to migrate from the old version to the new." putStrLn "Hopefully this program will fail with a readable error message." putStrLn "" firstAcid <- openLocalStateFrom fp (FirstState "first state") createCheckpoint firstAcid closeAcidState firstAcid secondAcid <- openLocalStateFrom fp (SecondState 42) closeAcidState secondAcid error "If you see this message then something has gone wrong!" test :: IO () test = do putStrLn "ChangeVersion test" exists <- doesDirectoryExist fp when exists $ removeDirectoryRecursive fp handle hdl main putStrLn "ChangeVersion done" where hdl (ErrorCall msg) | msg == "Could not parse saved checkpoint due to the following error: Failed reading: safecopy: ChangeVersion.SecondState: Cannot find getter associated with this version number: Version {unVersion = 0}\nEmpty call stack\n" = putStrLn $ "Caught error: " ++ msg hdl e = throwIO e fp = "state/ChangeVersion" acid-state-0.16.0.1/examples/errors/ChangeState.hs0000644000000000000000000000407113660647235020033 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module ChangeState (main, test) where import Data.Acid import Control.Exception import Control.Monad.State import Data.SafeCopy import System.Directory import System.Environment import Data.List (isSuffixOf) import qualified Data.Text as Text ------------------------------------------------------ -- The Haskell structure that we want to encapsulate data FirstState = FirstState String deriving (Show) data SecondState = SecondState Text.Text deriving (Show) $(deriveSafeCopy 0 'base ''FirstState) $(deriveSafeCopy 0 'base ''SecondState) ------------------------------------------------------ -- The transaction we will execute over the state. $(makeAcidic ''FirstState []) $(makeAcidic ''SecondState []) ------------------------------------------------------ -- This is how AcidState is used: main :: IO () main = do putStrLn "This example simulates what happens when you modify your state type" putStrLn "without telling AcidState how to migrate from the old version to the new." putStrLn "Hopefully this program will fail with a readable error message." putStrLn "" firstAcid <- openLocalStateFrom fp (FirstState "first state") createCheckpoint firstAcid closeAcidState firstAcid secondAcid <- openLocalStateFrom fp (SecondState (Text.pack "This initial value shouldn't be used")) closeAcidState secondAcid error "If you see this message then something has gone wrong!" test :: IO () test = do putStrLn "ChangeState test" exists <- doesDirectoryExist fp when exists $ removeDirectoryRecursive fp handle hdl main putStrLn "ChangeState done" where hdl (ErrorCall msg) | "Could not parse saved checkpoint due to the following error: too few bytes\nFrom:\tChangeState.SecondState:\n\tdemandInput\n\n" `isSuffixOf` msg = putStrLn $ "Caught error: " ++ msg hdl e = throwIO e fp = "state/ChangeState" acid-state-0.16.0.1/benchmarks/0000755000000000000000000000000013660647235014272 5ustar0000000000000000acid-state-0.16.0.1/benchmarks/loading/0000755000000000000000000000000013660647235015707 5ustar0000000000000000acid-state-0.16.0.1/benchmarks/loading/Benchmark.hs0000644000000000000000000001566613660647235020153 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} import Benchmark.Prelude import Criterion.Main import qualified Data.Acid as Acid import qualified Data.Acid.Memory as Memory import qualified Benchmark.FileSystem as FS import qualified Benchmark.Model as Model; import Benchmark.Model (Model) import qualified System.Random as Random main :: IO () main = defaultMain [benchmark defaultBenchmarkInterfaces [100,200,300,400]] benchmark :: [BenchmarkInterface] -> [Int] -> Benchmark benchmark bis sizes = env setupWorkingPath $ \ workingPath -> bgroup "" $ map (benchmarksGroup bis workingPath) sizes -- | An acid-state interface to be benchmarked. data BenchmarkInterface = forall m . BenchmarkInterface { benchName :: String -- ^ Name of the interface, for use in constructing benchmarks. , benchPersist :: Bool -- ^ Does this interface actually persist data to disk? If -- it doesn't, some benchmarks are not applicable. , benchOpen :: FS.FilePath -> IO (Acid.AcidState m) -- ^ Open an acid-state component with the given path. Note -- that the type of the state is encapsulated within -- 'BenchmarkInterface'. , benchUpdate :: Acid.AcidState m -> [[Int]] -> IO () -- ^ Execute an 'insert' update against the acid-state. , benchQuery :: Acid.AcidState m -> IO Int -- ^ Execute a 'sumUp' query against the state. } memoryBenchmarkInterface :: BenchmarkInterface memoryBenchmarkInterface = BenchmarkInterface { benchName = "Memory" , benchPersist = False , benchOpen = const $ Memory.openMemoryState mempty , benchUpdate = \ inst v -> Acid.update inst (Model.Insert v) , benchQuery = \ inst -> Acid.query inst Model.SumUp } localBenchmarkInterface :: BenchmarkInterface localBenchmarkInterface = BenchmarkInterface { benchName = "Local" , benchPersist = True , benchOpen = \ p -> Acid.openLocalStateFrom (FS.encodeString p) mempty , benchUpdate = \ inst v -> Acid.update inst (Model.Insert v) , benchQuery = \ inst -> Acid.query inst Model.SumUp } defaultBenchmarkInterfaces :: [BenchmarkInterface] defaultBenchmarkInterfaces = [memoryBenchmarkInterface, localBenchmarkInterface] setupWorkingPath :: IO FS.FilePath setupWorkingPath = do workingPath <- do workingPath <- FS.getTemporaryDirectory rndStr <- replicateM 16 $ Random.randomRIO ('a', 'z') return $ workingPath <> "acid-state" <> "benchmarks" <> "loading" <> FS.decodeString rndStr putStrLn $ "Working under the following temporary directory: " ++ FS.encodeString workingPath FS.removeTreeIfExists workingPath FS.createTree workingPath return workingPath benchmarksGroup :: [BenchmarkInterface] -> FS.FilePath -> Int -> Benchmark benchmarksGroup bis workingPath size = bgroup (show size) [ bgroup (benchName bi) $ initializeBenchmarksGroup bi workingPath' size : if benchPersist bi then [openCloseBenchmarksGroup bi workingPath' size] else [] | bi <- bis ] where workingPath' = workingPath <> FS.decodeString (show size) -- | The Initialize benchmarks measure how long it takes to open an -- empty 'AcidState' component, call 'initialize' to populate it with -- data, and optionally checkpoint before closing. initializeBenchmarksGroup :: BenchmarkInterface -> FS.FilePath -> Int -> Benchmark initializeBenchmarksGroup bi workingPath size = bgroup "Initialize" [ bench "Without checkpoint" $ perRunEnv (prepareInitialize bi workingPath) $ \ _ -> initializeClose bi workingPath size , bench "With checkpoint" $ perRunEnv (prepareInitialize bi workingPath) $ \ _ -> initializeCheckpointClose bi workingPath size ] prepareInitialize :: BenchmarkInterface -> FS.FilePath -> IO () prepareInitialize bi workingPath = when (benchPersist bi) $ do FS.removeTreeIfExists workingPath FS.createTree workingPath -- | The OpenClose benchmarks measure how long it takes to open an -- existing on-disk 'AcidState' component (either from a checkpoint or -- from a transaction log), optionally execute a query over the entire -- state, then close. These benchmarks are not applicable if the -- interface being benchmarked does not persist data. openCloseBenchmarksGroup :: BenchmarkInterface -> FS.FilePath -> Int -> Benchmark openCloseBenchmarksGroup bi workingPath size = env (prepareOpenCloseBenchmarksGroup bi workingPath size) $ \ ~(logsInstancePath, checkpointInstancePath) -> bgroup "OpenClose" [ bench "From Logs" $ nfIO $ openClose bi logsInstancePath , bench "From Checkpoint" $ nfIO $ openClose bi checkpointInstancePath , bench "From Logs (with query)" $ nfIO $ openQueryClose bi logsInstancePath , bench "From Checkpoint (with query)" $ nfIO $ openQueryClose bi checkpointInstancePath ] -- | Set up data on disk for the open/close benchmarks. This -- initializes an instance, creates a copy of it (for restoring from -- transaction logs), then checkpoints. prepareOpenCloseBenchmarksGroup :: BenchmarkInterface -> FS.FilePath -> Int -> IO (FS.FilePath, FS.FilePath) prepareOpenCloseBenchmarksGroup bi workingPath size = do putStrLn $ "Preparing instances for size " ++ show size let logsInstancePath = workingPath <> "logs-instance" checkpointInstancePath = workingPath <> "checkpoint-instance" FS.createTree logsInstancePath FS.createTree checkpointInstancePath putStrLn "Initializing" initialize bi checkpointInstancePath size $ \inst -> do putStrLn "Copying" FS.copy checkpointInstancePath logsInstancePath FS.removeFile $ logsInstancePath <> "open.lock" putStrLn "Checkpointing" Acid.createCheckpoint inst putStrLn "Closing" Acid.closeAcidState inst return (logsInstancePath, checkpointInstancePath) initialize :: BenchmarkInterface -> FS.FilePath -> Int -> (forall m . Acid.AcidState m -> IO r) -> IO r initialize BenchmarkInterface{..} p size k = do inst <- benchOpen p let values = replicate size $ replicate 100 $ replicate 100 1 mapM_ (benchUpdate inst) values k inst initializeClose :: BenchmarkInterface -> FS.FilePath -> Int -> IO () initializeClose bi p size = initialize bi p size Acid.closeAcidState initializeCheckpointClose :: BenchmarkInterface -> FS.FilePath -> Int -> IO () initializeCheckpointClose bi p size = initialize bi p size $ \ inst -> do Acid.createCheckpoint inst Acid.closeAcidState inst openClose :: BenchmarkInterface -> FS.FilePath -> IO () openClose BenchmarkInterface{..} p = benchOpen p >>= Acid.closeAcidState openQueryClose :: BenchmarkInterface -> FS.FilePath -> IO Int openQueryClose BenchmarkInterface{..} p = do inst <- benchOpen p n <- benchQuery inst Acid.closeAcidState inst return n acid-state-0.16.0.1/benchmarks/loading/Benchmark/0000755000000000000000000000000013660647235017601 5ustar0000000000000000acid-state-0.16.0.1/benchmarks/loading/Benchmark/Prelude.hs0000644000000000000000000000243313660647235021537 0ustar0000000000000000module Benchmark.Prelude ( module Prelude, module Control.Monad, module Control.Applicative, module Control.Arrow, module Data.Monoid, module Data.Foldable, module Data.Traversable, module Data.Maybe, module Data.List, module Data.Data, -- mtl module Control.Monad.State, module Control.Monad.Reader, -- exceptions module Control.Exception, module System.IO.Error, ) where import Prelude hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath) import Control.Monad hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) import Control.Applicative import Control.Arrow import Data.Monoid import Data.Foldable import Data.Traversable import Data.Maybe import Data.List hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') import Data.Data -- mtl import Control.Monad.State hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) import Control.Monad.Reader hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) -- exceptions import Control.Exception import System.IO.Error acid-state-0.16.0.1/benchmarks/loading/Benchmark/Model.hs0000644000000000000000000000047113660647235021177 0ustar0000000000000000module Benchmark.Model where import Benchmark.Prelude hiding (insert) import qualified Data.Acid as Acid type Model = [[[Int]]] insert :: [[Int]] -> Acid.Update Model () insert = modify . (:) sumUp :: Acid.Query Model Int sumUp = sum . map (sum . map sum) <$> ask Acid.makeAcidic ''Model ['insert, 'sumUp] acid-state-0.16.0.1/benchmarks/loading/Benchmark/FileSystem.hs0000644000000000000000000000263113660647235022223 0ustar0000000000000000module Benchmark.FileSystem ( copy, removeTreeIfExists, exists, getTemporaryDirectory, module Filesystem, module Filesystem.Path.CurrentOS ) where import Benchmark.Prelude hiding (stripPrefix, last) import Filesystem.Path.CurrentOS import Filesystem import qualified System.Directory as Directory import Debug.Trace import qualified Data.List as List removeTreeIfExists :: FilePath -> IO () removeTreeIfExists path = removeTree path `catch` \e -> case e of _ | isDoesNotExistError e -> return () | otherwise -> throwIO e exists :: FilePath -> IO Bool exists path = do isDir <- isDirectory path isFile <- isFile path return $ isDir || isFile getTemporaryDirectory :: IO FilePath getTemporaryDirectory = Directory.getTemporaryDirectory >>= return . decodeString copy :: FilePath -> FilePath -> IO () copy from to = do isDir <- isDirectory from if isDir then copyDirectory from to else copyFile from to copyDirectory :: FilePath -> FilePath -> IO () copyDirectory path path' = do members <- listDirectory path let members' = do member <- members let relative = fromMaybe (error "Unexpectedly empty member path") $ last member return $ path' <> relative sequence_ $ zipWith copy members members' last :: FilePath -> Maybe FilePath last p = case splitDirectories p of [] -> Nothing l -> Just $ List.last l acid-state-0.16.0.1/repair/0000755000000000000000000000000013660647235013437 5ustar0000000000000000acid-state-0.16.0.1/repair/Main.hs0000644000000000000000000000027413660647235014662 0ustar0000000000000000module Main where import Data.Acid.Repair import System.Directory main :: IO () main = do directory <- getCurrentDirectory repairEvents directory repairCheckpoints directory acid-state-0.16.0.1/src/0000755000000000000000000000000013660647235012744 5ustar0000000000000000acid-state-0.16.0.1/src/Data/0000755000000000000000000000000013660647235013615 5ustar0000000000000000acid-state-0.16.0.1/src/Data/Acid.hs0000644000000000000000000000151313660647235015011 0ustar0000000000000000----------------------------------------------------------------------------- {- | Module : Data.Acid Copyright : PublicDomain Maintainer : lemmih@gmail.com Portability : non-portable (uses GHC extensions) AcidState container using a transaction log on disk. To see how it all fits together, have a look at these example . -} module Data.Acid ( AcidState , openLocalState , openLocalStateFrom , closeAcidState , createCheckpoint , createArchive , update , query , EventResult , EventState , UpdateEvent , QueryEvent , Update , Query , IsAcidic , makeAcidic , liftQuery ) where import Data.Acid.Local import Data.Acid.Common import Data.Acid.Abstract import Data.Acid.TemplateHaskell acid-state-0.16.0.1/src/Data/Acid/0000755000000000000000000000000013660647235014455 5ustar0000000000000000acid-state-0.16.0.1/src/Data/Acid/Archive.hs0000644000000000000000000001134213660647235016373 0ustar0000000000000000{-# LANGUAGE DoAndIfThenElse #-} {- Format: |content length| crc16 | content | |8 bytes | 2 bytes | n bytes | -} module Data.Acid.Archive ( Entry , Entries(..) , putEntries , packEntries , readEntries , entriesToList , entriesToListNoFail , Archiver(..) , defaultArchiver ) where import Data.Acid.CRC import qualified Data.ByteString as Strict import qualified Data.ByteString.Lazy as Lazy import Data.ByteString.Builder import Data.Monoid import Data.Serialize.Get hiding (Result (..)) import qualified Data.Serialize.Get as Serialize -- | A bytestring that represents an entry in an archive. type Entry = Lazy.ByteString -- | Result of unpacking an archive. This is essentially a list of -- 'Entry', but may terminate in 'Fail' if the archive format is -- incorrect. data Entries = Done | Next Entry Entries | Fail String deriving (Show) -- | Convert 'Entries' to a normal list, calling 'error' if there was -- a failure in unpacking the archive. entriesToList :: Entries -> [Entry] entriesToList Done = [] entriesToList (Next entry next) = entry : entriesToList next entriesToList (Fail msg) = error $ "Data.Acid.Archive: " <> msg -- | Convert 'Entries' to a normal list, silently ignoring a failure -- to unpack the archive and instead returning a truncated list. entriesToListNoFail :: Entries -> [Entry] entriesToListNoFail Done = [] entriesToListNoFail (Next entry next) = entry : entriesToListNoFail next entriesToListNoFail Fail{} = [] -- | Interface for the lowest level of the serialisation layer, which -- handles packing lists of 'Entry' elements (essentially just -- bytestrings) into a single bytestring, perhaps with error-checking. -- -- Any @'Archiver'{'archiveWrite', 'archiveRead'}@ must satisfy the -- round-trip property: -- -- > forall xs . entriesToList (archiveRead (archiveWrite xs)) == xs -- -- Moreover, 'archiveWrite' must be a monoid homomorphism, so that -- concatenating archives is equivalent to concatenating the lists of -- entries that they represent: -- -- > archiveWrite [] == empty -- > forall xs ys . archiveWrite xs <> archiveWrite ys == archiveWrite (xs ++ ys) data Archiver = Archiver { archiveWrite :: [Entry] -> Lazy.ByteString -- ^ Pack a list of entries into a bytestring. , archiveRead :: Lazy.ByteString -> Entries -- ^ Unpack a bytestring as a list of 'Entries', including the -- possibility of failure if the format is invalid. } -- | Standard (and historically the only) implementation of the -- 'Archiver' interface. This represents each entry in the following -- format: -- -- > | entry length | crc16 | entry | -- > | 8 bytes | 2 bytes | n bytes | defaultArchiver :: Archiver defaultArchiver = Archiver packEntries readEntries putEntry :: Entry -> Builder putEntry content = word64LE contentLength !<> word16LE contentHash !<> lazyByteString content where contentLength = fromIntegral $ Lazy.length content contentHash = crc16 content a !<> b = let c = a <> b in c `seq` c putEntries :: [Entry] -> Builder putEntries = mconcat . map putEntry packEntries :: [Entry] -> Lazy.ByteString packEntries = toLazyByteString . putEntries readEntries :: Lazy.ByteString -> Entries readEntries bs = worker (Lazy.toChunks bs) where worker [] = Done worker (x:xs) = check (runGetPartial readEntry x) xs check result more = case result of Serialize.Done entry rest | Strict.null rest -> Next entry (worker more) | otherwise -> Next entry (worker (rest:more)) Serialize.Fail msg _ -> Fail msg Serialize.Partial cont -> case more of [] -> check (cont Strict.empty) [] (x:xs) -> check (cont x) xs readEntry :: Get Entry readEntry = do contentLength <- getWord64le contentChecksum <-getWord16le content <- getLazyByteString_fast (fromIntegral contentLength) if crc16 content /= contentChecksum then fail "Invalid hash" else return content -- | Read a lazy bytestring WITHOUT any copying or concatenation. getLazyByteString_fast :: Int -> Get Lazy.ByteString getLazyByteString_fast = worker 0 [] where worker counter acc n = do rem <- remaining if n > rem then do chunk <- getBytes rem _ <- ensure 1 worker (counter + rem) (chunk:acc) (n-rem) else do chunk <- getBytes n return $ Lazy.fromChunks (reverse $ chunk:acc) acid-state-0.16.0.1/src/Data/Acid/Common.hs0000644000000000000000000000514513660647235016246 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Acid.Common -- Copyright : PublicDomain -- -- Maintainer : lemmih@gmail.com -- Portability : non-portable (uses GHC extensions) -- -- Common structures used by the various backends (local, memory). -- module Data.Acid.Common where import Data.Acid.Core import Control.Monad.State import Control.Monad.Reader import Control.Applicative class IsAcidic st where acidEvents :: [Event st] -- ^ List of events capable of updating or querying the state. -- | Context monad for Update events. newtype Update st a = Update { unUpdate :: State st a } deriving (Monad, Functor, MonadState st) -- mtl pre-2.0 doesn't have these instances to newtype-derive, but they're -- simple enough. instance Applicative (Update st) where pure = return (<*>) = ap -- | Context monad for Query events. newtype Query st a = Query { unQuery :: Reader st a } deriving (Monad, Functor, MonadReader st) instance Applicative (Query st) where pure = return (<*>) = ap -- | Run a query in the Update Monad. liftQuery :: Query st a -> Update st a liftQuery query = do st <- get return (runReader (unQuery query) st) -- | Events return the same thing as Methods. The exact type of 'EventResult' -- depends on the event. type EventResult ev = MethodResult ev type EventState ev = MethodState ev -- | We distinguish between events that modify the state and those that do not. -- -- UpdateEvents are executed in a MonadState context and have to be serialized -- to disk before they are considered durable. -- -- QueryEvents are executed in a MonadReader context and obviously do not have -- to be serialized to disk. data Event st where UpdateEvent :: UpdateEvent ev => (ev -> Update (EventState ev) (EventResult ev)) -> MethodSerialiser ev -> Event (EventState ev) QueryEvent :: QueryEvent ev => (ev -> Query (EventState ev) (EventResult ev)) -> MethodSerialiser ev -> Event (EventState ev) -- | All UpdateEvents are also Methods. class Method ev => UpdateEvent ev -- | All QueryEvents are also Methods. class Method ev => QueryEvent ev eventsToMethods :: [Event st] -> [MethodContainer st] eventsToMethods = map worker where worker :: Event st -> MethodContainer st worker (UpdateEvent fn ms) = Method (unUpdate . fn) ms worker (QueryEvent fn ms) = Method (\ev -> do st <- get return (runReader (unQuery $ fn ev) st) ) ms acid-state-0.16.0.1/src/Data/Acid/TemplateHaskell.hs0000644000000000000000000005135513660647235020101 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, CPP, NamedFieldPuns #-} {- Holy crap this code is messy. -} module Data.Acid.TemplateHaskell where import Language.Haskell.TH import Language.Haskell.TH.Ppr import Language.Haskell.TH.ExpandSyns import Data.Acid.Core import Data.Acid.Common import Data.List ((\\), nub, delete) import Data.SafeCopy import Data.Typeable import Data.Char import Data.Monoid ((<>)) import Control.Applicative import Control.Monad import Control.Monad.State (MonadState) import Control.Monad.Reader (MonadReader) {-| Create the control structures required for acid states using Template Haskell. This code: @ myUpdate :: Argument -> Update State Result myUpdate arg = ... myQuery :: Argument -> Query State Result myQuery arg = ... $(makeAcidic ''State ['myUpdate, 'myQuery]) @ will make @State@ an instance of 'IsAcidic' and provide the following events: @ data MyUpdate = MyUpdate Argument data MyQuery = MyQuery Argument @ -} makeAcidic :: Name -> [Name] -> Q [Dec] makeAcidic = makeAcidicWithSerialiser safeCopySerialiserSpec -- | Specifies how to customise the 'IsAcidic' instance and event data -- type serialisation instances for a particular serialisation layer. data SerialiserSpec = SerialiserSpec { serialisationClassName :: Name -- ^ Class for serialisable types, e.g. @''Safecopy@. , methodSerialiserName :: Name -- ^ Name of the 'MethodSerialiser' to use in the list of -- events in the 'IsAcidic' instance. , makeEventSerialiser :: Name -> Type -> DecQ -- ^ Function to generate an instance of the class named by -- 'serialisationClassName', given the event name and its type. } -- | Default implementation of 'SerialiserSpec' that uses 'SafeCopy' -- for serialising events. safeCopySerialiserSpec :: SerialiserSpec safeCopySerialiserSpec = SerialiserSpec { serialisationClassName = ''SafeCopy , methodSerialiserName = 'safeCopyMethodSerialiser , makeEventSerialiser = makeSafeCopyInstance } -- | A variant on 'makeAcidic' that makes it possible to explicitly choose the -- serialisation implementation to be used for methods. makeAcidicWithSerialiser :: SerialiserSpec -> Name -> [Name] -> Q [Dec] makeAcidicWithSerialiser ss stateName eventNames = do stateInfo <- reify stateName case stateInfo of TyConI tycon ->case tycon of #if MIN_VERSION_template_haskell(2,11,0) DataD _cxt _name tyvars _kind constructors _derivs #else DataD _cxt _name tyvars constructors _derivs #endif -> makeAcidic' ss eventNames stateName tyvars constructors #if MIN_VERSION_template_haskell(2,11,0) NewtypeD _cxt _name tyvars _kind constructor _derivs #else NewtypeD _cxt _name tyvars constructor _derivs #endif -> makeAcidic' ss eventNames stateName tyvars [constructor] TySynD _name tyvars _ty -> makeAcidic' ss eventNames stateName tyvars [] _ -> error "Data.Acid.TemplateHaskell: Unsupported state type. Only 'data', 'newtype' and 'type' are supported." _ -> error "Data.Acid.TemplateHaskell: Given state is not a type." makeAcidic' :: SerialiserSpec -> [Name] -> Name -> [TyVarBndr] -> [Con] -> Q [Dec] makeAcidic' ss eventNames stateName tyvars constructors = do events <- sequence [ makeEvent ss eventName | eventName <- eventNames ] acidic <- makeIsAcidic ss eventNames stateName tyvars constructors return $ acidic : concat events -- | Given an event name (e.g. @'myUpdate@), produce a data type like -- -- > data MyUpdate = MyUpdate Argument -- -- along with the 'Method' class instance, 'Event' class instance and -- the instance of the appropriate serialisation class. -- -- However, if the event data type already exists, this will generate -- the serialisation instance only. This makes it possible to call -- 'makeAcidicWithSerialiser' multiple times on the same events but -- with different 'SerialiserSpec's, to support multiple serialisation -- backends. makeEvent :: SerialiserSpec -> Name -> Q [Dec] makeEvent ss eventName = do exists <- recover (return False) (reify (toStructName eventName) >> return True) eventType <- getEventType eventName if exists then do b <- makeEventSerialiser ss eventName eventType return [b] else do d <- makeEventDataType eventName eventType b <- makeEventSerialiser ss eventName eventType i <- makeMethodInstance eventName eventType e <- makeEventInstance eventName eventType return [d,b,i,e] getEventType :: Name -> Q Type getEventType eventName = do eventInfo <- reify eventName case eventInfo of #if MIN_VERSION_template_haskell(2,11,0) VarI _name eventType _decl #else VarI _name eventType _decl _fixity #endif -> expandSyns eventType _ -> error $ "Data.Acid.TemplateHaskell: Events must be functions: " ++ show eventName --instance (SafeCopy key, Typeable key, SafeCopy val, Typeable val) => IsAcidic State where -- acidEvents = [ UpdateEvent (\(MyUpdateEvent arg1 arg2 -> myUpdateEvent arg1 arg2) ] makeIsAcidic ss eventNames stateName tyvars constructors = do types <- mapM getEventType eventNames stateType' <- stateType let preds = [ serialisationClassName ss, ''Typeable ] ty = appT (conT ''IsAcidic) stateType handlers = zipWith (makeEventHandler ss) eventNames types cxtFromEvents = nub $ concat $ zipWith (eventCxts stateType' tyvars) eventNames types cxts' <- mkCxtFromTyVars preds tyvars cxtFromEvents instanceD (return cxts') ty [ valD (varP 'acidEvents) (normalB (listE handlers)) [] ] where stateType = foldl appT (conT stateName) (map varT (allTyVarBndrNames tyvars)) -- | This function analyses an event function and extracts any -- additional class contexts which need to be added to the IsAcidic -- instance. -- -- For example, if we have: -- -- > data State a = ... -- -- > setState :: (Ord a) => a -> UpdateEvent (State a) () -- -- Then we need to generate an IsAcidic instance like: -- -- > instance (SafeCopy a, Typeable a, Ord a) => IsAcidic (State a) -- -- Note that we can only add constraints for type variables which -- appear in the State type. If we tried to do this: -- -- > setState :: (Ord a, Ord b) => a -> b -> UpdateEvent (State a) () -- -- We will get an ambigious type variable when trying to create the -- 'IsAcidic' instance, because there is no way to figure out what -- type 'b' should be. -- -- The tricky part of this code is that we need to unify the type -- variables. -- -- Let's say the user writes their code using 'b' instead of 'a': -- -- > setState :: (Ord b) => b -> UpdateEvent (State b) () -- -- In the 'IsAcidic' instance, we are still going to use 'a'. So we -- need to rename the variables in the context to match. -- -- The contexts returned by this function will have the variables renamed. -- -- Additionally, if the event uses MonadReader or MonadState it might look -- like this: -- -- > setState :: (MonadState x m, IsFoo x) => m () -- -- In this case we have to rename 'x' to the actual state we're going to -- use. This is done by 'renameState'. eventCxts :: Type -- ^ State type -> [TyVarBndr] -- ^ type variables that will be used for the State type in the IsAcidic instance -> Name -- ^ 'Name' of the event -> Type -- ^ 'Type' of the event -> [Pred] -- ^ extra context to add to 'IsAcidic' instance eventCxts targetStateType targetTyVars eventName eventType = let TypeAnalysis { context = cxt, stateType } = analyseType eventName eventType -- find the type variable names that this event is using -- for the State type eventTyVars = findTyVars stateType -- create a lookup table table = zip eventTyVars (map tyVarBndrName targetTyVars) in map (unify table) -- rename the type variables (renameState stateType targetStateType cxt) where -- | rename the type variables in a Pred unify :: [(Name, Name)] -> Pred -> Pred #if MIN_VERSION_template_haskell(2,10,0) unify table p = rename p table p -- in 2.10.0: type Pred = Type #else unify table p@(ClassP n tys) = ClassP n (map (rename p table) tys) unify table p@(EqualP a b) = EqualP (rename p table a) (rename p table b) #endif -- | rename the type variables in a Type rename :: Pred -> [(Name, Name)] -> Type -> Type rename pred table t@(ForallT tyvarbndrs cxt typ) = -- this is probably wrong? I don't think acid-state can really handle this type anyway.. ForallT (map renameTyVar tyvarbndrs) (map (unify table) cxt) (rename pred table typ) where renameTyVar (PlainTV name) = PlainTV (renameName pred table name) renameTyVar (KindedTV name k) = KindedTV (renameName pred table name) k rename pred table (VarT n) = VarT $ renameName pred table n rename pred table (AppT a b) = AppT (rename pred table a) (rename pred table b) rename pred table (SigT a k) = SigT (rename pred table a) k rename _ _ typ = typ -- | rename a 'Name' renameName :: Pred -> [(Name, Name)] -> Name -> Name renameName pred table n = case lookup n table of Nothing -> error $ unlines [ "Data.Acid.TemplateHaskell: " , "" , show $ ppr_sig eventName eventType , "" , "can not be used as an UpdateEvent because the class context: " , "" , pprint pred , "" , "contains a type variable which is not found in the state type: " , "" , pprint targetStateType , "" , "You may be able to fix this by providing a type signature that fixes these type variable(s)" ] (Just n') -> n' -- | See the end of comment for 'eventCxts'. renameState :: Type -> Type -> Cxt -> Cxt renameState tfrom tto cxt = map renamePred cxt where #if MIN_VERSION_template_haskell(2,10,0) renamePred p = renameType p -- in 2.10.0: type Pred = Type #else renamePred (ClassP n tys) = ClassP n (map renameType tys) renamePred (EqualP a b) = EqualP (renameType a) (renameType b) #endif renameType n | n == tfrom = tto renameType (AppT a b) = AppT (renameType a) (renameType b) renameType (SigT a k) = SigT (renameType a) k renameType typ = typ -- UpdateEvent (\(MyUpdateEvent arg1 arg2) -> myUpdateEvent arg1 arg2) safeCopyMethodSerialiser makeEventHandler :: SerialiserSpec -> Name -> Type -> ExpQ makeEventHandler ss eventName eventType = do assertTyVarsOk vars <- replicateM (length args) (newName "arg") let lamClause = conP eventStructName [varP var | var <- vars ] conE constr `appE` lamE [lamClause] (foldl appE (varE eventName) (map varE vars)) `appE` varE (methodSerialiserName ss) where constr = if isUpdate then 'UpdateEvent else 'QueryEvent TypeAnalysis { tyvars, argumentTypes = args, stateType, isUpdate } = analyseType eventName eventType eventStructName = toStructName eventName stateTypeTyVars = findTyVars stateType tyVarNames = map tyVarBndrName tyvars assertTyVarsOk = case tyVarNames \\ stateTypeTyVars of [] -> return () ns -> error $ "Data.Acid.TemplateHaskell: " <> unlines [show $ ppr_sig eventName eventType , "" , "can not be used as an UpdateEvent because it contains the type variables: " , "" , pprint ns , "" , "which do not appear in the state type:" , "" , pprint stateType ] --data MyUpdateEvent = MyUpdateEvent Arg1 Arg2 -- deriving (Typeable) makeEventDataType :: Name -> Type -> DecQ makeEventDataType eventName eventType = do let con = normalC eventStructName [ strictType notStrict (return arg) | arg <- args ] #if MIN_VERSION_template_haskell(2,12,0) cxt = [derivClause Nothing [conT ''Typeable]] #elif MIN_VERSION_template_haskell(2,11,0) cxt = mapM conT [''Typeable] #else cxt = [''Typeable] #endif case args of #if MIN_VERSION_template_haskell(2,11,0) [_] -> newtypeD (return []) eventStructName tyvars Nothing con cxt _ -> dataD (return []) eventStructName tyvars Nothing [con] cxt #else [_] -> newtypeD (return []) eventStructName tyvars con cxt _ -> dataD (return []) eventStructName tyvars [con] cxt #endif where TypeAnalysis { tyvars, argumentTypes = args } = analyseType eventName eventType eventStructName = toStructName eventName -- instance (SafeCopy key, SafeCopy val) => SafeCopy (MyUpdateEvent key val) where -- put (MyUpdateEvent a b) = do put a; put b -- get = MyUpdateEvent <$> get <*> get makeSafeCopyInstance :: Name -> Type -> DecQ makeSafeCopyInstance eventName eventType = do let preds = [ ''SafeCopy ] ty = AppT (ConT ''SafeCopy) (foldl AppT (ConT eventStructName) (map VarT (allTyVarBndrNames tyvars))) getBase = appE (varE 'return) (conE eventStructName) getArgs = foldl (\a b -> infixE (Just a) (varE '(<*>)) (Just (varE 'safeGet))) getBase args contained val = varE 'contain `appE` val putVars <- replicateM (length args) (newName "arg") let putClause = conP eventStructName [varP var | var <- putVars ] putExp = doE $ [ noBindS $ appE (varE 'safePut) (varE var) | var <- putVars ] ++ [ noBindS $ appE (varE 'return) (tupE []) ] instanceD (mkCxtFromTyVars preds tyvars context) (return ty) [ funD 'putCopy [clause [putClause] (normalB (contained putExp)) []] , valD (varP 'getCopy) (normalB (contained getArgs)) [] , funD 'errorTypeName [clause [wildP] (normalB (litE (stringL (pprint ty)))) []] ] where TypeAnalysis { tyvars, context, argumentTypes = args } = analyseType eventName eventType eventStructName = toStructName eventName mkCxtFromTyVars preds tyvars extraContext = cxt $ [ classP classPred [varT tyvar] | tyvar <- allTyVarBndrNames tyvars, classPred <- preds ] ++ map return extraContext {- instance (Typeable key, Typeable val) => Method (MyUpdateEvent key val) where type MethodResult (MyUpdateEvent key val) = Return type MethodState (MyUpdateEvent key val) = State key val -} makeMethodInstance :: Name -> Type -> DecQ makeMethodInstance eventName eventType = do let preds = [ ''Typeable ] ty = AppT (ConT ''Method) (foldl AppT (ConT eventStructName) (map VarT (allTyVarBndrNames tyvars))) structType = foldl appT (conT eventStructName) (map varT (allTyVarBndrNames tyvars)) instanceContext = cxt $ [ classP classPred [varT tyvar] | tyvar <- allTyVarBndrNames tyvars , classPred <- preds ] ++ map return context instanceD instanceContext (return ty) #if MIN_VERSION_template_haskell(2,15,0) [ tySynInstD $ tySynEqn Nothing (conT ''MethodResult `appT` structType) (return resultType) , tySynInstD $ tySynEqn Nothing (conT ''MethodState `appT` structType) (return stateType) #elif __GLASGOW_HASKELL__ >= 707 [ tySynInstD ''MethodResult (tySynEqn [structType] (return resultType)) , tySynInstD ''MethodState (tySynEqn [structType] (return stateType)) #else [ tySynInstD ''MethodResult [structType] (return resultType) , tySynInstD ''MethodState [structType] (return stateType) #endif ] where TypeAnalysis { tyvars, context, stateType, resultType } = analyseType eventName eventType eventStructName = toStructName eventName --instance (Typeable key, Typeable val) => UpdateEvent (MyUpdateEvent key val) makeEventInstance :: Name -> Type -> DecQ makeEventInstance eventName eventType = do let preds = [ ''Typeable ] eventClass = if isUpdate then ''UpdateEvent else ''QueryEvent ty = AppT (ConT eventClass) (foldl AppT (ConT eventStructName) (map VarT (allTyVarBndrNames tyvars))) instanceD (cxt $ [ classP classPred [varT tyvar] | tyvar <- allTyVarBndrNames tyvars, classPred <- preds ] ++ map return context) (return ty) [] where TypeAnalysis { tyvars, context, isUpdate } = analyseType eventName eventType eventStructName = toStructName eventName data TypeAnalysis = TypeAnalysis { tyvars :: [TyVarBndr] , context :: Cxt , argumentTypes :: [Type] , stateType :: Type , resultType :: Type , isUpdate :: Bool } deriving (Eq, Show) analyseType :: Name -> Type -> TypeAnalysis analyseType eventName t = go [] [] [] t where #if MIN_VERSION_template_haskell(2,10,0) getMonadReader :: Cxt -> Name -> [(Type, Type)] getMonadReader cxt m = do constraint@(AppT (AppT (ConT c) x) m') <- cxt guard (c == ''MonadReader && m' == VarT m) return (constraint, x) getMonadState :: Cxt -> Name -> [(Type, Type)] getMonadState cxt m = do constraint@(AppT (AppT (ConT c) x) m') <- cxt guard (c == ''MonadState && m' == VarT m) return (constraint, x) #else getMonadReader :: Cxt -> Name -> [(Pred, Type)] getMonadReader cxt m = do constraint@(ClassP c [x, m']) <- cxt guard (c == ''MonadReader && m' == VarT m) return (constraint, x) getMonadState :: Cxt -> Name -> [(Pred, Type)] getMonadState cxt m = do constraint@(ClassP c [x, m']) <- cxt guard (c == ''MonadState && m' == VarT m) return (constraint, x) #endif -- a -> b go tyvars cxt args (AppT (AppT ArrowT a) b) = go tyvars cxt (args ++ [a]) b -- Update st res -- Query st res go tyvars context argumentTypes (AppT (AppT (ConT con) stateType) resultType) | con == ''Update = TypeAnalysis { tyvars, context, argumentTypes, stateType, resultType , isUpdate = True } | con == ''Query = TypeAnalysis { tyvars, context, argumentTypes, stateType, resultType , isUpdate = False } -- (...) => a go tyvars cxt args (ForallT tyvars2 cxt2 a) = go (tyvars ++ tyvars2) (cxt ++ cxt2) args a -- (MonadState state m) => ... -> m result -- (MonadReader state m) => ... -> m result go tyvars' cxt argumentTypes (AppT (VarT m) resultType) | [] <- queries, [(cx, stateType)] <- updates = TypeAnalysis { tyvars, argumentTypes , stateType, resultType , isUpdate = True , context = delete cx cxt } | [(cx, stateType)] <- queries, [] <- updates = TypeAnalysis { tyvars, argumentTypes , stateType, resultType , isUpdate = False , context = delete cx cxt } where queries = getMonadReader cxt m updates = getMonadState cxt m tyvars = filter ((/= m) . tyVarBndrName) tyvars' -- otherwise, fail go _ _ _ _ = error $ "Data.Acid.TemplateHaskell: Event has an invalid type signature: Not an Update, Query, MonadState, or MonadReader: " ++ show eventName -- | find the type variables -- | e.g. State a b ==> [a,b] findTyVars :: Type -> [Name] findTyVars (ForallT _ _ a) = findTyVars a findTyVars (VarT n) = [n] findTyVars (AppT a b) = findTyVars a ++ findTyVars b findTyVars (SigT a _) = findTyVars a findTyVars _ = [] -- | extract the 'Name' from a 'TyVarBndr' tyVarBndrName :: TyVarBndr -> Name tyVarBndrName (PlainTV n) = n tyVarBndrName (KindedTV n _) = n allTyVarBndrNames :: [TyVarBndr] -> [Name] allTyVarBndrNames tyvars = map tyVarBndrName tyvars -- | Convert the 'Name' of the event function into the name of the -- corresponding data constructor. toStructName :: Name -> Name toStructName eventName = mkName (structName (nameBase eventName)) where structName [] = [] structName (x:xs) = toUpper x : xs acid-state-0.16.0.1/src/Data/Acid/Memory.hs0000644000000000000000000001202613660647235016262 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Acid.Memory -- Copyright : PublicDomain -- -- Maintainer : lemmih@gmail.com -- Portability : non-portable (uses GHC extensions) -- -- AcidState container without a transaction log. Mostly used for testing. -- module Data.Acid.Memory ( openMemoryState ) where import Data.Acid.Core import Data.Acid.Common import Data.Acid.Abstract import Control.Concurrent ( newEmptyMVar, putMVar, MVar ) import Control.Monad.State ( runState ) import Data.ByteString.Lazy ( ByteString ) import Data.Typeable ( Typeable ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) {-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability) guarantees. [@Atomicity@] State changes are all-or-nothing. This is what you'd expect of any state variable in Haskell and AcidState doesn't change that. [@Consistency@] No event or set of events will break your data invariants. [@Isolation@] Transactions cannot interfere with each other even when issued in parallel. [@Durability@] Successful transaction are guaranteed to survive system failure (both hardware and software). -} data MemoryState st = MemoryState { localCore :: Core st , localCopy :: IORef st } deriving (Typeable) -- | Create an AcidState given an initial value. openMemoryState :: (IsAcidic st) => st -- ^ Initial state value. -> IO (AcidState st) openMemoryState initialState = do core <- mkCore (eventsToMethods acidEvents) initialState ref <- newIORef initialState return $ toAcidState MemoryState { localCore = core, localCopy = ref } -- | Issue an Update event and return immediately. The event is not durable -- before the MVar has been filled but the order of events is honored. -- The behavior in case of exceptions is exactly the same as for 'update'. -- -- If EventA is scheduled before EventB, EventA /will/ be executed before EventB: -- -- @ --do scheduleUpdate acid EventA -- scheduleUpdate acid EventB -- @ scheduleMemoryUpdate :: UpdateEvent event => MemoryState (EventState event) -> event -> IO (MVar (EventResult event)) scheduleMemoryUpdate acidState event = do mvar <- newEmptyMVar modifyCoreState_ (localCore acidState) $ \st -> do let !(result, !st') = runState hotMethod st writeIORef (localCopy acidState) st' putMVar mvar result return st' return mvar where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event scheduleMemoryColdUpdate :: MemoryState st -> Tagged ByteString -> IO (MVar ByteString) scheduleMemoryColdUpdate acidState event = do mvar <- newEmptyMVar modifyCoreState_ (localCore acidState) $ \st -> do let !(result, !st') = runState coldMethod st writeIORef (localCopy acidState) st' putMVar mvar result return st' return mvar where coldMethod = lookupColdMethod (localCore acidState) event -- | Issue a Query event and wait for its result. Events may be issued in parallel. memoryQuery :: QueryEvent event => MemoryState (EventState event) -> event -> IO (EventResult event) memoryQuery acidState event = do st <- readIORef (localCopy acidState) let (result, _st) = runState hotMethod st return result where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event memoryQueryCold :: MemoryState st -> Tagged ByteString -> IO ByteString memoryQueryCold acidState event = do st <- readIORef (localCopy acidState) let (result, _st) = runState coldMethod st return result where coldMethod = lookupColdMethod (localCore acidState) event -- | This is a nop with the memory backend. createMemoryCheckpoint :: MemoryState st -> IO () createMemoryCheckpoint acidState = return () -- | This is a nop with the memory backend. createMemoryArchive :: MemoryState st -> IO () createMemoryArchive acidState = return () -- | Close an AcidState and associated logs. -- Any subsequent usage of the AcidState will throw an exception. closeMemoryState :: MemoryState st -> IO () closeMemoryState acidState = closeCore (localCore acidState) toAcidState :: IsAcidic st => MemoryState st -> AcidState st toAcidState memory = AcidState { _scheduleUpdate = scheduleMemoryUpdate memory , scheduleColdUpdate = scheduleMemoryColdUpdate memory , _query = memoryQuery memory , queryCold = memoryQueryCold memory , createCheckpoint = createMemoryCheckpoint memory , createArchive = createMemoryArchive memory , closeAcidState = closeMemoryState memory , acidSubState = mkAnyState memory } acid-state-0.16.0.1/src/Data/Acid/Log.hs0000644000000000000000000003352713660647235015544 0ustar0000000000000000-- | A log is a stack of entries that supports efficient pushing of new entries -- and fetching of old. It can be considered an extendible array of entries. -- module Data.Acid.Log ( FileLog(..) , LogKey(..) , EntryId , openFileLog , closeFileLog , pushEntry , pushAction , ensureLeastEntryId , readEntriesFrom , rollbackTo , rollbackWhile , newestEntry , askCurrentEntryId , cutFileLog , archiveFileLog , findLogFiles ) where import Data.Acid.Archive (Archiver(..), Entries(..), entriesToList) import Data.Acid.Core import System.Directory import System.FilePath import System.IO import FileIO import Foreign.Ptr import Control.Monad import Control.Concurrent import Control.Concurrent.STM import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString as Strict import qualified Data.ByteString.Unsafe as Strict import Data.List import Data.Maybe import Data.Monoid ((<>)) import Text.Printf ( printf ) import Paths_acid_state ( version ) import Data.Version ( showVersion ) import Control.Exception ( handle, IOException ) type EntryId = Int data FileLog object = FileLog { logIdentifier :: LogKey object , logCurrent :: MVar FHandle -- Handle , logNextEntryId :: TVar EntryId , logQueue :: TVar ([Lazy.ByteString], [IO ()]) , logThreads :: [ThreadId] } data LogKey object = LogKey { logDirectory :: FilePath , logPrefix :: String , logSerialiser :: Serialiser object , logArchiver :: Archiver } formatLogFile :: String -> EntryId -> String formatLogFile = printf "%s-%010d.log" findLogFiles :: LogKey object -> IO [(EntryId, FilePath)] findLogFiles identifier = do createDirectoryIfMissing True (logDirectory identifier) files <- getDirectoryContents (logDirectory identifier) return [ (tid, logDirectory identifier file) | file <- files , logFile <- maybeToList (stripPrefix (logPrefix identifier ++ "-") file) , (tid, ".log") <- reads logFile ] saveVersionFile :: LogKey object -> IO () saveVersionFile key = do exist <- doesFileExist versionFile unless exist $ writeFile versionFile (showVersion version) where versionFile = logDirectory key logPrefix key <.> "version" openFileLog :: LogKey object -> IO (FileLog object) openFileLog identifier = do logFiles <- findLogFiles identifier saveVersionFile identifier currentState <- newEmptyMVar queue <- newTVarIO ([], []) nextEntryRef <- newTVarIO 0 tid1 <- myThreadId tid2 <- forkIO $ fileWriter (logArchiver identifier) currentState queue tid1 let fLog = FileLog { logIdentifier = identifier , logCurrent = currentState , logNextEntryId = nextEntryRef , logQueue = queue , logThreads = [tid2] } if null logFiles then do let currentEntryId = 0 handle <- open (logDirectory identifier formatLogFile (logPrefix identifier) currentEntryId) putMVar currentState handle else do let (lastFileEntryId, lastFilePath) = maximum logFiles entries <- readEntities (logArchiver identifier) lastFilePath let currentEntryId = lastFileEntryId + length entries atomically $ writeTVar nextEntryRef currentEntryId handle <- open (logDirectory identifier formatLogFile (logPrefix identifier) currentEntryId) putMVar currentState handle return fLog fileWriter :: Archiver -> MVar FHandle -> TVar ([Lazy.ByteString], [IO ()]) -> ThreadId -> IO () fileWriter archiver currentState queue parentTid = forever $ do (entries, actions) <- atomically $ do (entries, actions) <- readTVar queue when (null entries && null actions) retry writeTVar queue ([], []) return (reverse entries, reverse actions) handle (\e -> throwTo parentTid (e :: IOException)) $ withMVar currentState $ \fd -> do let arch = archiveWrite archiver entries writeToDisk fd (repack arch) sequence_ actions yield -- | Repack a lazy bytestring into larger blocks that can be efficiently written -- to disk. repack :: Lazy.ByteString -> [Strict.ByteString] repack = worker where worker bs | Lazy.null bs = [] | otherwise = Strict.concat (Lazy.toChunks (Lazy.take blockSize bs)) : worker (Lazy.drop blockSize bs) blockSize = 4*1024 writeToDisk :: FHandle -> [Strict.ByteString] -> IO () writeToDisk _ [] = return () writeToDisk handle xs = do mapM_ worker xs flush handle where worker bs = do let len = Strict.length bs count <- Strict.unsafeUseAsCString bs $ \ptr -> write handle (castPtr ptr) (fromIntegral len) when (fromIntegral count < len) $ worker (Strict.drop (fromIntegral count) bs) closeFileLog :: FileLog object -> IO () closeFileLog fLog = modifyMVar_ (logCurrent fLog) $ \handle -> do close handle _ <- forkIO $ forM_ (logThreads fLog) killThread return $ error "Data.Acid.Log: FileLog has been closed" readEntities :: Archiver -> FilePath -> IO [Lazy.ByteString] readEntities archiver path = do archive <- Lazy.readFile path return $ entriesToList (archiveRead archiver archive) ensureLeastEntryId :: FileLog object -> EntryId -> IO () ensureLeastEntryId fLog youngestEntry = do atomically $ do entryId <- readTVar (logNextEntryId fLog) writeTVar (logNextEntryId fLog) (max entryId youngestEntry) cutFileLog fLog return () -- | Read all durable entries younger than the given 'EntryId'. Note that -- entries written during or after this call won't be included in the returned -- list. readEntriesFrom :: FileLog object -> EntryId -> IO [object] readEntriesFrom fLog youngestEntry = do -- Cut the log so we can read written entries without interfering -- with the writing of new entries. entryCap <- cutFileLog fLog -- We're interested in these entries: youngestEntry <= x < entryCap. logFiles <- findLogFiles (logIdentifier fLog) let sorted = sort logFiles relevant = filterLogFiles (Just youngestEntry) (Just entryCap) sorted firstEntryId = case relevant of [] -> 0 ( logFile : _logFiles) -> rangeStart logFile -- XXX: Strict bytestrings are used due to a performance bug in -- cereal-0.3.5.2 and binary-0.7.1.0. The code should revert back -- to lazy bytestrings once the bug has been fixed. archive <- liftM Lazy.fromChunks $ mapM (Strict.readFile . snd) relevant let entries = entriesToList $ archiveRead (logArchiver identifier) archive return $ map (decode' identifier) $ take (entryCap - youngestEntry) -- Take events under the eventCap. $ drop (youngestEntry - firstEntryId) entries -- Drop entries that are too young. where rangeStart (firstEntryId, _path) = firstEntryId identifier = logIdentifier fLog -- | Obliterate log entries younger than or equal to the 'EntryId'. Very unsafe, -- can't be undone rollbackTo :: LogKey object -> EntryId -> IO () rollbackTo identifier youngestEntry = do logFiles <- findLogFiles identifier let sorted = sort logFiles loop [] = return () loop ((rangeStart, path) : xs) | rangeStart >= youngestEntry = removeFile path >> loop xs | otherwise = do archive <- Strict.readFile path pathHandle <- openFile path WriteMode let entries = entriesToList $ archiveRead (logArchiver identifier) (Lazy.fromChunks [archive]) entriesToKeep = take (youngestEntry - rangeStart + 1) entries lengthToKeep = Lazy.length (archiveWrite (logArchiver identifier) entriesToKeep) hSetFileSize pathHandle (fromIntegral lengthToKeep) hClose pathHandle loop (reverse sorted) -- | Obliterate log entries as long as the filter function returns @True@. rollbackWhile :: LogKey object -> (object -> Bool) -- ^ the filter function -> IO () rollbackWhile identifier filterFn = do logFiles <- findLogFiles identifier let sorted = sort logFiles loop [] = return () loop ((_rangeStart, path) : xs) = do archive <- Strict.readFile path let entries = entriesToList $ archiveRead (logArchiver identifier) (Lazy.fromChunks [archive]) entriesToSkip = takeWhile (filterFn . decode' identifier) $ reverse entries skip_size = Lazy.length (archiveWrite (logArchiver identifier) entriesToSkip) orig_size = fromIntegral $ Strict.length archive new_size = orig_size - skip_size if new_size == 0 then do removeFile path; loop xs else do pathHandle <- openFile path WriteMode hSetFileSize pathHandle (fromIntegral new_size) hClose pathHandle loop (reverse sorted) -- | Filter out log files that are outside the min_entry/max_entry range. -- -- minEntryId <= x < maxEntryId filterLogFiles :: Maybe EntryId -- ^ minEntryId -> Maybe EntryId -- ^ maxEntryId -> [(EntryId, FilePath)] -> [(EntryId, FilePath)] filterLogFiles minEntryIdMb maxEntryIdMb logFiles = worker logFiles where worker [] = [] worker [ logFile ] | ltMaxEntryId (rangeStart logFile) -- If the logfile starts before our maxEntryId then we're intersted. = [ logFile ] | otherwise = [] worker ( left : right : xs) | ltMinEntryId (rangeStart right) -- If 'right' starts before our minEntryId then we can discard 'left'. = worker (right : xs) | ltMaxEntryId (rangeStart left) -- If 'left' starts before our maxEntryId then we're interested. = left : worker (right : xs) | otherwise -- If 'left' starts after our maxEntryId then we're done. = [] ltMinEntryId = case minEntryIdMb of Nothing -> const False Just minEntryId -> (<= minEntryId) ltMaxEntryId = case maxEntryIdMb of Nothing -> const True Just maxEntryId -> (< maxEntryId) rangeStart (firstEntryId, _path) = firstEntryId -- | Move all log files that do not contain entries equal or higher than the -- given entryId into an @Archive/@ directory. archiveFileLog :: FileLog object -> EntryId -> IO () archiveFileLog fLog entryId = do logFiles <- findLogFiles (logIdentifier fLog) let sorted = sort logFiles relevant = filterLogFiles Nothing (Just entryId) sorted \\ filterLogFiles (Just entryId) (Just (entryId+1)) sorted createDirectoryIfMissing True archiveDir forM_ relevant $ \(_startEntry, logFilePath) -> renameFile logFilePath (archiveDir takeFileName logFilePath) where archiveDir = logDirectory (logIdentifier fLog) "Archive" getNextDurableEntryId :: FileLog object -> IO EntryId getNextDurableEntryId fLog = atomically $ do (entries, _) <- readTVar (logQueue fLog) next <- readTVar (logNextEntryId fLog) return (next - length entries) cutFileLog :: FileLog object -> IO EntryId cutFileLog fLog = do mvar <- newEmptyMVar let action = do currentEntryId <- getNextDurableEntryId fLog modifyMVar_ (logCurrent fLog) $ \old -> do close old open (logDirectory key formatLogFile (logPrefix key) currentEntryId) putMVar mvar currentEntryId pushAction fLog action takeMVar mvar where key = logIdentifier fLog -- | Finds the newest entry in the log. Doesn't work on open logs. Do not use -- after the log has been opened. -- -- Implementation: -- -- - Search the newest log files first. -- - Once a file containing at least one valid entry is found, return the last -- entry in that file. newestEntry :: LogKey object -> IO (Maybe object) newestEntry identifier = do logFiles <- findLogFiles identifier let sorted = reverse $ sort logFiles (_eventIds, files) = unzip sorted worker files where worker [] = return Nothing worker (logFile:logFiles) = do -- XXX: Strict bytestrings are used due to a performance bug in -- cereal-0.3.5.2 and binary-0.7.1.0. The code should revert back -- to lazy bytestrings once the bug has been fixed. archive <- fmap Lazy.fromStrict $ Strict.readFile logFile case archiveRead (logArchiver identifier) archive of Done -> worker logFiles Next entry next -> return $ Just (decode' identifier (lastEntry entry next)) Fail msg -> error $ "Data.Acid.Log: " <> msg lastEntry entry Done = entry lastEntry entry (Fail msg) = error $ "Data.Acid.Log: " <> msg lastEntry _ (Next entry next) = lastEntry entry next -- | Schedule a new log entry. This call does not block. The given IO action -- runs once the object is durable. The IO action blocks the serialization of -- events so it should be swift. pushEntry :: FileLog object -> object -> IO () -> IO () pushEntry fLog object finally = atomically $ do tid <- readTVar (logNextEntryId fLog) writeTVar (logNextEntryId fLog) $! tid+1 (entries, actions) <- readTVar (logQueue fLog) writeTVar (logQueue fLog) ( encoded : entries, finally : actions ) where encoded = Lazy.fromChunks [ Strict.copy $ Lazy.toStrict $ serialiserEncode (logSerialiser (logIdentifier fLog)) object ] -- | The given IO action is executed once all previous entries are durable. pushAction :: FileLog object -> IO () -> IO () pushAction fLog finally = atomically $ do (entries, actions) <- readTVar (logQueue fLog) writeTVar (logQueue fLog) (entries, finally : actions) askCurrentEntryId :: FileLog object -> IO EntryId askCurrentEntryId fLog = atomically $ readTVar (logNextEntryId fLog) -- FIXME: Check for unused input. decode' :: LogKey object -> Lazy.ByteString -> object decode' s inp = case serialiserDecode (logSerialiser s) inp of Left msg -> error $ "Data.Acid.Log: " <> msg Right val -> val acid-state-0.16.0.1/src/Data/Acid/CRC.hs0000644000000000000000000000574313660647235015431 0ustar0000000000000000{- CRC16 checksum inspired by http://hackage.haskell.org/package/crc16-table As of 2011-04-13, this module is about 20x faster than crc16-table. -} module Data.Acid.CRC ( crc16 ) where import Data.Word ( Word16 ) import Data.Array.Unboxed ( UArray, listArray ) import Data.Array.Base ( unsafeAt ) import Data.Bits ( Bits(..) ) import qualified Data.ByteString.Lazy as Lazy ( ByteString, foldl' ) tableList :: [Word16] tableList = [0x00000,0x01189,0x02312,0x0329B,0x04624,0x057AD,0x06536,0x074BF, 0x08C48,0x09DC1,0x0AF5A,0x0BED3,0x0CA6C,0x0DBE5,0x0E97E,0x0F8F7, 0x01081,0x00108,0x03393,0x0221A,0x056A5,0x0472C,0x075B7,0x0643E, 0x09CC9,0x08D40,0x0BFDB,0x0AE52,0x0DAED,0x0CB64,0x0F9FF,0x0E876, 0x02102,0x0308B,0x00210,0x01399,0x06726,0x076AF,0x04434,0x055BD, 0x0AD4A,0x0BCC3,0x08E58,0x09FD1,0x0EB6E,0x0FAE7,0x0C87C,0x0D9F5, 0x03183,0x0200A,0x01291,0x00318,0x077A7,0x0662E,0x054B5,0x0453C, 0x0BDCB,0x0AC42,0x09ED9,0x08F50,0x0FBEF,0x0EA66,0x0D8FD,0x0C974, 0x04204,0x0538D,0x06116,0x0709F,0x00420,0x015A9,0x02732,0x036BB, 0x0CE4C,0x0DFC5,0x0ED5E,0x0FCD7,0x08868,0x099E1,0x0AB7A,0x0BAF3, 0x05285,0x0430C,0x07197,0x0601E,0x014A1,0x00528,0x037B3,0x0263A, 0x0DECD,0x0CF44,0x0FDDF,0x0EC56,0x098E9,0x08960,0x0BBFB,0x0AA72, 0x06306,0x0728F,0x04014,0x0519D,0x02522,0x034AB,0x00630,0x017B9, 0x0EF4E,0x0FEC7,0x0CC5C,0x0DDD5,0x0A96A,0x0B8E3,0x08A78,0x09BF1, 0x07387,0x0620E,0x05095,0x0411C,0x035A3,0x0242A,0x016B1,0x00738, 0x0FFCF,0x0EE46,0x0DCDD,0x0CD54,0x0B9EB,0x0A862,0x09AF9,0x08B70, 0x08408,0x09581,0x0A71A,0x0B693,0x0C22C,0x0D3A5,0x0E13E,0x0F0B7, 0x00840,0x019C9,0x02B52,0x03ADB,0x04E64,0x05FED,0x06D76,0x07CFF, 0x09489,0x08500,0x0B79B,0x0A612,0x0D2AD,0x0C324,0x0F1BF,0x0E036, 0x018C1,0x00948,0x03BD3,0x02A5A,0x05EE5,0x04F6C,0x07DF7,0x06C7E, 0x0A50A,0x0B483,0x08618,0x09791,0x0E32E,0x0F2A7,0x0C03C,0x0D1B5, 0x02942,0x038CB,0x00A50,0x01BD9,0x06F66,0x07EEF,0x04C74,0x05DFD, 0x0B58B,0x0A402,0x09699,0x08710,0x0F3AF,0x0E226,0x0D0BD,0x0C134, 0x039C3,0x0284A,0x01AD1,0x00B58,0x07FE7,0x06E6E,0x05CF5,0x04D7C, 0x0C60C,0x0D785,0x0E51E,0x0F497,0x08028,0x091A1,0x0A33A,0x0B2B3, 0x04A44,0x05BCD,0x06956,0x078DF,0x00C60,0x01DE9,0x02F72,0x03EFB, 0x0D68D,0x0C704,0x0F59F,0x0E416,0x090A9,0x08120,0x0B3BB,0x0A232, 0x05AC5,0x04B4C,0x079D7,0x0685E,0x01CE1,0x00D68,0x03FF3,0x02E7A, 0x0E70E,0x0F687,0x0C41C,0x0D595,0x0A12A,0x0B0A3,0x08238,0x093B1, 0x06B46,0x07ACF,0x04854,0x059DD,0x02D62,0x03CEB,0x00E70,0x01FF9, 0x0F78F,0x0E606,0x0D49D,0x0C514,0x0B1AB,0x0A022,0x092B9,0x08330, 0x07BC7,0x06A4E,0x058D5,0x0495C,0x03DE3,0x02C6A,0x01EF1,0x00F78] table :: UArray Word16 Word16 table = listArray (0,255) tableList crc16 :: Lazy.ByteString -> Word16 crc16 = table `seq` complement . Lazy.foldl' worker 0xFFFF where worker acc x = (acc `shiftR` 8) `xor` (table `unsafeAt` idx) where idx = fromIntegral ((acc `xor` fromIntegral x) .&. 0xFF) acid-state-0.16.0.1/src/Data/Acid/Advanced.hs0000644000000000000000000000114513660647235016517 0ustar0000000000000000----------------------------------------------------------------------------- {- | Module : Data.Acid.Advanced Copyright : PublicDomain Maintainer : lemmih@gmail.com Portability : non-portable (uses GHC extensions) Home of the more specialized functions. -} module Data.Acid.Advanced ( scheduleUpdate , groupUpdates , update' , query' , Method(..) , IsAcidic(..) , Event(..) , safeCopySerialiser , safeCopyMethodSerialiser , defaultArchiver ) where import Data.Acid.Abstract import Data.Acid.Archive import Data.Acid.Core import Data.Acid.Common acid-state-0.16.0.1/src/Data/Acid/Abstract.hs0000644000000000000000000001361613660647235016563 0ustar0000000000000000{-# LANGUAGE RankNTypes, TypeFamilies, GADTs, CPP #-} module Data.Acid.Abstract ( AcidState(..) , scheduleUpdate , groupUpdates , update , update' , query , query' , mkAnyState , downcast ) where import Data.Acid.Common import Data.Acid.Core import Control.Concurrent ( MVar, takeMVar ) import Data.ByteString.Lazy ( ByteString ) import Control.Monad ( void ) import Control.Monad.Trans ( MonadIO(liftIO) ) #if __GLASGOW_HASKELL__ >= 707 import Data.Typeable ( Typeable, gcast, typeOf ) #else import Data.Typeable ( Typeable1, gcast1, typeOf1 ) #endif data AnyState st where #if __GLASGOW_HASKELL__ >= 707 AnyState :: Typeable sub_st => sub_st st -> AnyState st #else AnyState :: Typeable1 sub_st => sub_st st -> AnyState st #endif -- Haddock doesn't get the types right on its own. {-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability) guarantees. [@Atomicity@] State changes are all-or-nothing. This is what you'd expect of any state variable in Haskell and AcidState doesn't change that. [@Consistency@] No event or set of events will break your data invariants. [@Isolation@] Transactions cannot interfere with each other even when issued in parallel. [@Durability@] Successful transaction are guaranteed to survive unexpected system shutdowns (both those caused by hardware and software). -} data AcidState st = AcidState { _scheduleUpdate :: forall event. (UpdateEvent event, EventState event ~ st) => event -> IO (MVar (EventResult event)) , scheduleColdUpdate :: Tagged ByteString -> IO (MVar ByteString) , _query :: forall event. (QueryEvent event, EventState event ~ st) => event -> IO (EventResult event) , queryCold :: Tagged ByteString -> IO ByteString , -- | Take a snapshot of the state and save it to disk. Creating checkpoints -- makes it faster to resume AcidStates and you're free to create them as -- often or seldom as fits your needs. Transactions can run concurrently -- with this call. -- -- This call will not return until the operation has succeeded. createCheckpoint :: IO () -- | Move all log files that are no longer necessary for state restoration into the 'Archive' -- folder in the state directory. This folder can then be backed up or thrown out as you see fit. -- Reverting to a state before the last checkpoint will not be possible if the 'Archive' folder -- has been thrown out. -- -- This method is idempotent and does not block the normal operation of the AcidState. , createArchive :: IO () , -- | Close an AcidState and associated resources. -- Any subsequent usage of the AcidState will throw an exception. closeAcidState :: IO () , acidSubState :: AnyState st } -- | Issue an Update event and return immediately. The event is not durable -- before the MVar has been filled but the order of events is honored. -- The behavior in case of exceptions is exactly the same as for 'update'. -- -- If EventA is scheduled before EventB, EventA /will/ be executed before EventB: -- -- @ --do scheduleUpdate acid EventA -- scheduleUpdate acid EventB -- @ scheduleUpdate :: UpdateEvent event => AcidState (EventState event) -> event -> IO (MVar (EventResult event)) scheduleUpdate = _scheduleUpdate -- Redirection to make Haddock happy. -- | Schedule multiple Update events and wait for them to be durable, but -- throw away their results. This is useful for importing existing -- datasets into an AcidState. groupUpdates :: UpdateEvent event => AcidState (EventState event) -> [event] -> IO () groupUpdates acidState events = go events where go [] = return () go [x] = void $ update acidState x go (x:xs) = scheduleUpdate acidState x >> go xs -- | Issue an Update event and wait for its result. Once this call returns, you are -- guaranteed that the changes to the state are durable. Events may be issued in -- parallel. -- -- It's a run-time error to issue events that aren't supported by the AcidState. update :: UpdateEvent event => AcidState (EventState event) -> event -> IO (EventResult event) update acidState event = takeMVar =<< scheduleUpdate acidState event -- | Same as 'update' but lifted into any monad capable of doing IO. update' :: (UpdateEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event) update' acidState event = liftIO (update acidState event) -- | Issue a Query event and wait for its result. Events may be issued in parallel. query :: QueryEvent event => AcidState (EventState event) -> event -> IO (EventResult event) query = _query -- Redirection to make Haddock happy. -- | Same as 'query' but lifted into any monad capable of doing IO. query' :: (QueryEvent event, MonadIO m) => AcidState (EventState event) -> event -> m (EventResult event) query' acidState event = liftIO (query acidState event) #if __GLASGOW_HASKELL__ >= 707 mkAnyState :: Typeable sub_st => sub_st st -> AnyState st #else mkAnyState :: Typeable1 sub_st => sub_st st -> AnyState st #endif mkAnyState = AnyState #if __GLASGOW_HASKELL__ >= 707 downcast :: (Typeable sub, Typeable st) => AcidState st -> sub st downcast AcidState{acidSubState = AnyState sub} = r where r = case gcast (Just sub) of Just (Just x) -> x _ -> error $ "Data.Acid.Abstract: Invalid subtype cast: " ++ show (typeOf sub) ++ " -> " ++ show (typeOf r) #else downcast :: Typeable1 sub => AcidState st -> sub st downcast AcidState{acidSubState = AnyState sub} = r where r = case gcast1 (Just sub) of Just (Just x) -> x _ -> error $ "Data.Acid.Abstract: Invalid subtype cast: " ++ show (typeOf1 sub) ++ " -> " ++ show (typeOf1 r) #endif acid-state-0.16.0.1/src/Data/Acid/Repair.hs0000644000000000000000000001260213660647235016234 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module Data.Acid.Repair ( repairFile , repairEvents , repairCheckpoints ) where import qualified Data.Acid.Archive as Archive import Data.Acid.Local (mkEventsLogKey, mkCheckpointsLogKey) import Data.Acid.Log (LogKey) import qualified Data.Acid.Log as Log import qualified Data.ByteString.Lazy as Lazy import Data.List import System.Directory import System.FilePath.Posix import System.IO (hClose, openTempFile) repairEntries :: Lazy.ByteString -> Lazy.ByteString repairEntries = Archive.packEntries . Archive.entriesToListNoFail . Archive.readEntries -- | @'repairFile' path@ will truncate the entries in @file@ until there are -- only valid entries (if a corrupted entry is found, then the rest of the file -- is truncated). -- -- The old file will be copied to @path.bak@ (or @path.bak.1@, etc… if the file -- already exists). -- -- 'repairFile' tries very hard to avoid leaving files in an inconsistent state: -- the truncated file is written in a temporary file, which is then moved into -- place, similarly copies are performed with moves instead. Still this is not -- fully atomic: there are two consecutive moves, so 'repairFile' may, in case -- of crash, yield a state where the @path.bak@ file is there but no @path@ is -- there anymore, this would require manual intervention. repairFile :: FilePath -> IO () repairFile fp = do broken <- Lazy.readFile fp let repaired = repairEntries broken (tmp, temph) <- openTempFile (takeDirectory fp) (takeFileName fp) -- We use `openTempFile`, here, rather than `findNext` because we want to -- make extra-sure that we are not overriding an important file. hClose temph -- Closing immediately to benefit from the bracket guarantees of -- `writeFile`. A more elegant solution would be to use a `withTempFile` -- function, such as that from package `temporary`. Lazy.writeFile tmp repaired dropFile fp renameFile tmp fp -- Repairs the files corresponding to the given 'LogKey'. It implements the -- logic described in 'repairEvents'. repairLogs :: LogKey object -> IO () repairLogs identifier = do logFiles <- Log.findLogFiles identifier let sorted = sort logFiles (_eventIds, files) = unzip sorted broken_files <- mapM needsRepair files -- We're doing a second deserialisation of the files here (see -- 'needsRepair'). It would be better, computation-time-wise to make as -- single pass and let `repairEntries`, for instance, return whether a fix -- is needed. But it's a lot of complication and requires loading the -- entire base in memory, rather than streaming files one-by-one. So it's -- better to just do the second pass. repair $ map snd $ dropWhile (\(b,_) -> not b) $ zip broken_files files where repair [] = return () repair (file:rest) = do mapM_ dropFile (reverse rest) repairFile file -- Moves (atomically) a file `path` to `path.bak` (or `path.bak.1`, etc… if the -- file already exists). dropFile :: FilePath -> IO () dropFile fp = do bak <- findNext (fp ++ ".bak") -- We're using `findNext` rather than `openTempFile`, here, because we -- want predictable names renameFile fp bak -- | Repairs the WAL files with the following strategy: -- -- * Let `f` be the oldest corrupted file. -- * All files older than `f` is left untouched -- * `f` is repaired with `repairFile` -- * Old files younger than `f` is dropped (and saved to `path.bak`, or -- `path.bak.1`, etc…) -- -- In other words, all the log entries after the first corrupted entry is -- dropped. The reasoning is that newer entries are likely not to make sense -- after some entries have been removed from the log. This strategy guarantees a -- consistent state, albeit a potentially old one. repairEvents :: FilePath -- ^ Directory in which the events files can be found. -> IO () repairEvents directory = repairLogs (mkEventsLogKey directory noserialisation) where noserialisation = error "Repair.repairEvents: the serialisation layer shouldn't be forced" -- | Repairs the checkpoints file using the following strategy: -- -- * Every checkpoints file is repaired with `repairFile` -- -- Checkpoints are mostly independent. Contrary to 'repairEvents', dropping a -- checkpoint doesn't affect the consistency of later checkpoints. repairCheckpoints :: FilePath -- ^ Directory in which the checkpoints files can be found. -> IO () repairCheckpoints directory = do let checkpointLogKey = mkCheckpointsLogKey directory noserialisation checkpointFiles <- Log.findLogFiles checkpointLogKey let (_eventIds, files) = unzip checkpointFiles mapM_ repairFile files where noserialisation = error "Repair.repairCheckpoints: the serialisation layer shouldn't be forced" needsRepair :: FilePath -> IO Bool needsRepair fp = do contents <- Lazy.readFile fp let entries = Archive.readEntries contents return $ entriesNeedRepair entries where entriesNeedRepair Archive.Fail{} = True entriesNeedRepair Archive.Done = False entriesNeedRepair (Archive.Next _ rest) = entriesNeedRepair rest findNext :: FilePath -> IO (FilePath) findNext fp = go 0 where go n = let next = fileWithSuffix fp n in doesFileExist next >>= \case False -> return next True -> go (n+1) fileWithSuffix :: FilePath -> Int -> FilePath fileWithSuffix fp i = if i == 0 then fp else fp ++ "." ++ show i acid-state-0.16.0.1/src/Data/Acid/Core.hs0000644000000000000000000002630513660647235015707 0ustar0000000000000000{-# LANGUAGE CPP, GADTs, DeriveDataTypeable, TypeFamilies, FlexibleContexts, BangPatterns, DefaultSignatures, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Acid.Core -- Copyright : PublicDomain -- -- Maintainer : lemmih@gmail.com -- Portability : non-portable (uses GHC extensions) -- -- Low-level controls for transaction-based state changes. This module defines -- structures and tools for running state modifiers indexed either by an Method -- or a serialized Method. This module should rarely be used directly although -- the 'Method' class is needed when defining events manually. -- -- The term \'Event\' is loosely used for transactions with ACID guarantees. -- \'Method\' is loosely used for state operations without ACID guarantees -- module Data.Acid.Core ( Core(coreMethods) , Method(..) , MethodContainer(..) , Tagged , mkCore , closeCore , closeCore' , modifyCoreState , modifyCoreState_ , withCoreState , lookupHotMethod , lookupHotMethodAndSerialiser , lookupColdMethod , runHotMethod , runColdMethod , MethodMap , mkMethodMap , Serialiser(..) , safeCopySerialiser , MethodSerialiser(..) , safeCopyMethodSerialiser , encodeMethod , decodeMethod , encodeResult , decodeResult ) where import Control.Concurrent ( MVar, newMVar, withMVar , modifyMVar, modifyMVar_ ) import Control.Monad ( liftM ) import Control.Monad.State ( State, runState ) import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.ByteString.Lazy as Lazy ( ByteString ) import Data.ByteString.Lazy.Char8 as Lazy ( pack, unpack ) import Data.Serialize ( runPutLazy, runGetLazy ) import Data.SafeCopy ( SafeCopy, safeGet, safePut ) import Data.Typeable ( Typeable, TypeRep, typeRepTyCon, typeOf ) import Unsafe.Coerce ( unsafeCoerce ) #if MIN_VERSION_base(4,5,0) import Data.Typeable ( tyConModule ) #else import Data.Typeable.Internal ( tyConModule ) #endif #if MIN_VERSION_base(4,4,0) -- in base >= 4.4 the Show instance for TypeRep no longer provides a -- fully qualified name. But we have old data around that expects the -- FQN. So we will recreate the old naming system for newer versions -- of base. We could do something better, but happstack-state is -- end-of-life anyway. showQualifiedTypeRep :: TypeRep -> String showQualifiedTypeRep tr = tyConModule con ++ "." ++ show tr where con = typeRepTyCon tr #else showQualifiedTypeRep :: TypeRep -> String showQualifiedTypeRep tr = show tr #endif -- | Interface for (de)serialising values of type @a@. -- -- A @'Serialiser' { 'serialiserEncode', 'serialiserDecode' }@ must -- satisfy the round-trip property: -- -- > forall x . serialiserDecode (serialiserEncode x) == Right x data Serialiser a = Serialiser { serialiserEncode :: a -> Lazy.ByteString -- ^ Serialise a value to a bytestring. , serialiserDecode :: Lazy.ByteString -> Either String a -- ^ Deserialise a value, generating a string error message -- on failure. } -- | Default implementation of 'Serialiser' interface using 'SafeCopy'. safeCopySerialiser :: SafeCopy a => Serialiser a safeCopySerialiser = Serialiser (runPutLazy . safePut) (runGetLazy safeGet) -- | Interface for (de)serialising a method, namely 'Serialiser's for -- its arguments type and its result type. data MethodSerialiser method = MethodSerialiser { methodSerialiser :: Serialiser method , resultSerialiser :: Serialiser (MethodResult method) } -- | Default implementation of 'MethodSerialiser' interface using 'SafeCopy'. safeCopyMethodSerialiser :: (SafeCopy method, SafeCopy (MethodResult method)) => MethodSerialiser method safeCopyMethodSerialiser = MethodSerialiser safeCopySerialiser safeCopySerialiser -- | Encode the arguments of a method using the given serialisation strategy. encodeMethod :: MethodSerialiser method -> method -> ByteString encodeMethod ms = serialiserEncode (methodSerialiser ms) -- | Decode the arguments of a method using the given serialisation strategy. decodeMethod :: MethodSerialiser method -> ByteString -> Either String method decodeMethod ms = serialiserDecode (methodSerialiser ms) -- | Encode the result of a method using the given serialisation strategy. encodeResult :: MethodSerialiser method -> MethodResult method -> ByteString encodeResult ms = serialiserEncode (resultSerialiser ms) -- | Decode the result of a method using the given serialisation strategy. decodeResult :: MethodSerialiser method -> ByteString -> Either String (MethodResult method) decodeResult ms = serialiserDecode (resultSerialiser ms) -- | The basic Method class. Each Method has an indexed result type -- and a unique tag. class Method ev where type MethodResult ev type MethodState ev methodTag :: ev -> Tag default methodTag :: Typeable ev => ev -> Tag methodTag ev = Lazy.pack (showQualifiedTypeRep (typeOf ev)) -- | The control structure at the very center of acid-state. -- This module provides access to a mutable state through -- methods. No efforts towards durability, checkpointing or -- sharding happens at this level. -- Important things to keep in mind in this module: -- * We don't distinguish between updates and queries. -- * We allow direct access to the core state as well -- as through events. data Core st = Core { coreState :: MVar st , coreMethods :: MethodMap st } -- | Construct a new Core using an initial state and a list of Methods. mkCore :: [MethodContainer st] -- ^ List of methods capable of modifying the state. -> st -- ^ Initial state value. -> IO (Core st) mkCore methods initialValue = do mvar <- newMVar initialValue return Core{ coreState = mvar , coreMethods = mkMethodMap methods } -- | Mark Core as closed. Any subsequent use will throw an exception. closeCore :: Core st -> IO () closeCore core = closeCore' core (\_st -> return ()) -- | Access the state and then mark the Core as closed. Any subsequent use -- will throw an exception. closeCore' :: Core st -> (st -> IO ()) -> IO () closeCore' core action = modifyMVar_ (coreState core) $ \st -> do action st return errorMsg where errorMsg = error "Data.Acid.Core: Access failure: Core closed." -- | Modify the state component. The resulting state is ensured to be in -- WHNF. modifyCoreState :: Core st -> (st -> IO (st, a)) -> IO a modifyCoreState core action = modifyMVar (coreState core) $ \st -> do (!st', a) <- action st return (st', a) -- | Modify the state component. The resulting state is ensured to be in -- WHNF. modifyCoreState_ :: Core st -> (st -> IO st) -> IO () modifyCoreState_ core action = modifyMVar_ (coreState core) $ \st -> do !st' <- action st return st' -- | Access the state component. withCoreState :: Core st -> (st -> IO a) -> IO a withCoreState core = withMVar (coreState core) -- | Execute a method as given by a type identifier and an encoded string. -- The exact format of the encoded string depends on the type identifier. -- Results are encoded and type tagged before they're handed back out. -- This function is used when running events from a log-file or from another -- server. Events that originate locally are most likely executed with -- the faster 'runHotMethod'. runColdMethod :: Core st -> Tagged Lazy.ByteString -> IO Lazy.ByteString runColdMethod core taggedMethod = modifyCoreState core $ \st -> do let (a, st') = runState (lookupColdMethod core taggedMethod) st return ( st', a) -- | Find the state action that corresponds to a tagged and serialized method. lookupColdMethod :: Core st -> Tagged Lazy.ByteString -> State st Lazy.ByteString lookupColdMethod core (storedMethodTag, methodContent) = case Map.lookup storedMethodTag (coreMethods core) of Nothing -> missingMethod storedMethodTag Just (Method method ms) -> liftM (encodeResult ms) (method (lazyDecode ms methodContent)) lazyDecode :: MethodSerialiser method -> Lazy.ByteString -> method lazyDecode ms inp = case decodeMethod ms inp of Left msg -> error $ "Data.Acid.Core: " <> msg Right val -> val missingMethod :: Tag -> a missingMethod tag = error $ "Data.Acid.Core: " <> msg where msg = "This method is required but not available: " ++ show (Lazy.unpack tag) ++ ". Did you perhaps remove it before creating a checkpoint?" -- | Apply an in-memory method to the state. runHotMethod :: Method method => Core (MethodState method) -> method -> IO (MethodResult method) runHotMethod core method = modifyCoreState core $ \st -> do let (a, st') = runState (lookupHotMethod (coreMethods core) method) st return ( st', a) -- | Find the state action that corresponds to an in-memory method. lookupHotMethod :: Method method => MethodMap (MethodState method) -> method -> State (MethodState method) (MethodResult method) lookupHotMethod methodMap method = fst (lookupHotMethodAndSerialiser methodMap method) -- | Find the state action and serialiser that correspond to an -- in-memory method. lookupHotMethodAndSerialiser :: Method method => MethodMap (MethodState method) -> method -> (State (MethodState method) (MethodResult method), MethodSerialiser method) lookupHotMethodAndSerialiser methodMap method = case Map.lookup (methodTag method) methodMap of Nothing -> missingMethod (methodTag method) Just (Method methodHandler ms) -> -- If the methodTag doesn't index the right methodHandler then we're in deep -- trouble. Luckly, it would take deliberate malevolence for that to happen. (unsafeCoerce methodHandler method, unsafeCoerce ms) -- | Method tags must be unique and are most commonly generated automatically. type Tag = Lazy.ByteString type Tagged a = (Tag, a) type MethodBody method = method -> State (MethodState method) (MethodResult method) -- | Method container structure that hides the exact type of the method. data MethodContainer st where Method :: (Method method) => MethodBody method -> MethodSerialiser method -> MethodContainer (MethodState method) -- | Collection of Methods indexed by a Tag. type MethodMap st = Map.Map Tag (MethodContainer st) -- | Construct a 'MethodMap' from a list of Methods using their associated tag. mkMethodMap :: [MethodContainer st] -> MethodMap st mkMethodMap methods = Map.fromList [ (methodType method, method) | method <- methods ] where -- A little bit of ugliness is required to access the methodTags. methodType :: MethodContainer st -> Tag methodType m = case m of Method fn _ -> let ev :: (ev -> State st res) -> ev ev _ = undefined in methodTag (ev fn) acid-state-0.16.0.1/src/Data/Acid/Local.hs0000644000000000000000000005410013660647235016043 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, BangPatterns, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Acid.Local -- Copyright : PublicDomain -- -- Maintainer : lemmih@gmail.com -- Portability : non-portable (uses GHC extensions) -- -- AcidState container using a transaction log on disk. The term \'Event\' is -- loosely used for transactions with ACID guarantees. \'Method\' is loosely -- used for state operations without ACID guarantees (see "Data.Acid.Core"). -- module Data.Acid.Local ( openLocalState , openLocalStateFrom , openLocalStateWithSerialiser , prepareLocalState , prepareLocalStateFrom , prepareLocalStateWithSerialiser , defaultStateDirectory , scheduleLocalUpdate' , scheduleLocalColdUpdate' , createCheckpointAndClose , LocalState(..) , Checkpoint(..) , SerialisationLayer(..) , defaultSerialisationLayer , mkEventsLogKey , mkCheckpointsLogKey ) where import Data.Acid.Archive import Data.Acid.Log as Log import Data.Acid.Core import Data.Acid.Common import Data.Acid.Abstract import Control.Concurrent ( newEmptyMVar, putMVar, takeMVar, MVar ) import Control.Exception ( onException, evaluate, Exception, throwIO ) import Control.Monad.State ( runState ) import Control.Monad ( join ) import Control.Applicative ( (<$>), (<*>) ) import Data.ByteString.Lazy ( ByteString ) import qualified Data.ByteString.Lazy as Lazy ( length ) import Data.Serialize ( runPutLazy, runGetLazy ) import Data.SafeCopy ( SafeCopy(..), safeGet, safePut , primitive, contain ) import Data.Typeable ( Typeable, typeOf ) import Data.IORef import System.FilePath ( (), takeDirectory ) import System.FileLock import System.Directory ( createDirectoryIfMissing ) {-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability) guarantees. [@Atomicity@] State changes are all-or-nothing. This is what you'd expect of any state variable in Haskell and AcidState doesn't change that. [@Consistency@] No event or set of events will break your data invariants. [@Isolation@] Transactions cannot interfere with each other even when issued in parallel. [@Durability@] Successful transaction are guaranteed to survive system failure (both hardware and software). -} data LocalState st = LocalState { localCore :: Core st , localCopy :: IORef st , localEvents :: FileLog (Tagged ByteString) , localCheckpoints :: FileLog (Checkpoint st) , localLock :: FileLock } deriving (Typeable) newtype StateIsLocked = StateIsLocked FilePath deriving (Show, Typeable) instance Exception StateIsLocked -- | Issue an Update event and return immediately. The event is not durable -- before the MVar has been filled but the order of events is honored. -- The behavior in case of exceptions is exactly the same as for 'update'. -- -- If EventA is scheduled before EventB, EventA /will/ be executed before EventB: -- -- @ --do scheduleUpdate acid EventA -- scheduleUpdate acid EventB -- @ scheduleLocalUpdate :: UpdateEvent event => LocalState (EventState event) -> event -> IO (MVar (EventResult event)) scheduleLocalUpdate acidState event = do mvar <- newEmptyMVar let encoded = encodeMethod ms event -- It is important that we encode the event now so that we can catch -- any exceptions (see nestedStateError in examples/errors/Exceptions.hs) evaluate (Lazy.length encoded) modifyCoreState_ (localCore acidState) $ \st -> do let !(result, !st') = runState hotMethod st -- Schedule the log entry. Very important that it happens when 'localCore' is locked -- to ensure that events are logged in the same order that they are executed. pushEntry (localEvents acidState) (methodTag event, encoded) $ do writeIORef (localCopy acidState) st' putMVar mvar result return st' return mvar where (hotMethod, ms) = lookupHotMethodAndSerialiser (coreMethods (localCore acidState)) event -- | Same as scheduleLocalUpdate but does not immediately change the localCopy -- and return the result mvar - returns an IO action to do this instead. Take -- care to run actions of multiple Updates in the correct order as otherwise -- Queries will operate on outdated state. scheduleLocalUpdate' :: UpdateEvent event => LocalState (EventState event) -> event -> MVar (EventResult event) -> IO (IO ()) scheduleLocalUpdate' acidState event mvar = do let encoded = encodeMethod ms event -- It is important that we encode the event now so that we can catch -- any exceptions (see nestedStateError in examples/errors/Exceptions.hs) evaluate (Lazy.length encoded) act <- modifyCoreState (localCore acidState) $ \st -> do let !(result, !st') = runState hotMethod st -- Schedule the log entry. Very important that it happens when 'localCore' is locked -- to ensure that events are logged in the same order that they are executed. pushEntry (localEvents acidState) (methodTag event, encoded) $ return () let action = do writeIORef (localCopy acidState) st' putMVar mvar result return (st', action) -- this is the action to update state for queries and release the -- result into the supplied mvar return act where (hotMethod, ms) = lookupHotMethodAndSerialiser (coreMethods (localCore acidState)) event scheduleLocalColdUpdate :: LocalState st -> Tagged ByteString -> IO (MVar ByteString) scheduleLocalColdUpdate acidState event = do mvar <- newEmptyMVar modifyCoreState_ (localCore acidState) $ \st -> do let !(result, !st') = runState coldMethod st -- Schedule the log entry. Very important that it happens when 'localCore' is locked -- to ensure that events are logged in the same order that they are executed. pushEntry (localEvents acidState) event $ do writeIORef (localCopy acidState) st' putMVar mvar result return st' return mvar where coldMethod = lookupColdMethod (localCore acidState) event -- | Same as scheduleLocalColdUpdate but does not immediately change the -- localCopy and return the result mvar - returns an IO action to do this -- instead. Take care to run actions of multiple Updates in the correct order as -- otherwise Queries will operate on outdated state. scheduleLocalColdUpdate' :: LocalState st -> Tagged ByteString -> MVar ByteString -> IO (IO ()) scheduleLocalColdUpdate' acidState event mvar = do act <- modifyCoreState (localCore acidState) $ \st -> do let !(result, !st') = runState coldMethod st -- Schedule the log entry. Very important that it happens when 'localCore' is locked -- to ensure that events are logged in the same order that they are executed. pushEntry (localEvents acidState) event $ return () let action = do writeIORef (localCopy acidState) st' putMVar mvar result return (st', action) return act where coldMethod = lookupColdMethod (localCore acidState) event -- | Issue a Query event and wait for its result. Events may be issued in parallel. localQuery :: QueryEvent event => LocalState (EventState event) -> event -> IO (EventResult event) localQuery acidState event = do st <- readIORef (localCopy acidState) let (result, _st) = runState hotMethod st return result where hotMethod = lookupHotMethod (coreMethods (localCore acidState)) event -- Whoa, a buttload of refactoring is needed here. 2011-11-02 localQueryCold :: LocalState st -> Tagged ByteString -> IO ByteString localQueryCold acidState event = do st <- readIORef (localCopy acidState) let (result, _st) = runState coldMethod st return result where coldMethod = lookupColdMethod (localCore acidState) event -- | Take a snapshot of the state and save it to disk. Creating checkpoints -- makes it faster to resume AcidStates and you're free to create them as -- often or seldom as fits your needs. Transactions can run concurrently -- with this call. -- -- This call will not return until the operation has succeeded. createLocalCheckpoint :: IsAcidic st => LocalState st -> IO () createLocalCheckpoint acidState = do cutFileLog (localEvents acidState) mvar <- newEmptyMVar withCoreState (localCore acidState) $ \st -> do eventId <- askCurrentEntryId (localEvents acidState) pushAction (localEvents acidState) $ pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ()) takeMVar mvar -- | Save a snapshot to disk and close the AcidState as a single atomic -- action. This is useful when you want to make sure that no events -- are saved to disk after a checkpoint. createCheckpointAndClose :: (IsAcidic st, Typeable st) => AcidState st -> IO () createCheckpointAndClose abstract_state = do mvar <- newEmptyMVar closeCore' (localCore acidState) $ \st -> do eventId <- askCurrentEntryId (localEvents acidState) pushAction (localEvents acidState) $ pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ()) takeMVar mvar closeFileLog (localEvents acidState) closeFileLog (localCheckpoints acidState) unlockFile (localLock acidState) where acidState = downcast abstract_state data Checkpoint s = Checkpoint EntryId s -- | Previous versions of @acid-state@ had -- -- > data Checkpoint = Checkpoint EntryId ByteString -- -- where the 'ByteString' is the @safecopy@-serialization of the -- original checkpoint data. Thus we give a 'SafeCopy' instance that -- is backwards-compatible with this by making nested calls to -- 'safePut' and 'safeGet'. -- -- Note that if the inner data cannot be deserialised, 'getCopy' will -- not report an error immediately but will return a 'Checkpoint' -- whose payload is an error thunk. This means consumers can skip -- deserialising intermediate checkpoint data when they care only -- about the last checkpoint in a file. However, they must be sure to -- force the returned data promptly. instance SafeCopy s => SafeCopy (Checkpoint s) where kind = primitive putCopy (Checkpoint eventEntryId content) = contain $ do safePut eventEntryId safePut (runPutLazy (safePut content)) getCopy = contain $ Checkpoint <$> safeGet <*> (fromNested <$> safeGet) where fromNested b = case runGetLazy safeGet b of Left msg -> checkpointRestoreError msg Right v -> v errorTypeName s = "Checkpoint " ++ errorTypeName s -- | Create an AcidState given an initial value. -- -- This will create or resume a log found in the \"state\/[typeOf state]\/\" directory. openLocalState :: (Typeable st, IsAcidic st, SafeCopy st) => st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> IO (AcidState st) openLocalState initialState = openLocalStateFrom (defaultStateDirectory initialState) initialState -- | Create an AcidState given an initial value. -- -- This will create or resume a log found in the \"state\/[typeOf state]\/\" directory. -- The most recent checkpoint will be loaded immediately but the AcidState will not be opened -- until the returned function is executed. prepareLocalState :: (Typeable st, IsAcidic st, SafeCopy st) => st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> IO (IO (AcidState st)) prepareLocalState initialState = prepareLocalStateFrom (defaultStateDirectory initialState) initialState -- | Directory to load the state from unless otherwise specified, -- namely \"state\/[typeOf state]\/\". defaultStateDirectory :: Typeable st => st -> FilePath defaultStateDirectory initialState = "state" show (typeOf initialState) -- | Create an AcidState given a log directory and an initial value. -- -- This will create or resume a log found in @directory@. -- Running two AcidState's from the same directory is an error -- but will not result in dataloss. openLocalStateFrom :: (IsAcidic st, SafeCopy st) => FilePath -- ^ Location of the checkpoint and transaction files. -> st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> IO (AcidState st) openLocalStateFrom directory initialState = openLocalStateWithSerialiser directory initialState defaultSerialisationLayer -- | Create an AcidState given a log directory, an initial value and a serialisation layer. -- -- This will create or resume a log found in @directory@. -- Running two AcidState's from the same directory is an error -- but will not result in dataloss. openLocalStateWithSerialiser :: (IsAcidic st) => FilePath -- ^ Location of the checkpoint and transaction files. -> st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> SerialisationLayer st -- ^ Serialisation layer to use for checkpoints, events and archives. -> IO (AcidState st) openLocalStateWithSerialiser directory initialState serialisationLayer = join $ resumeLocalStateFrom directory initialState False serialisationLayer -- | Create an AcidState given a log directory and an initial value. -- -- This will create or resume a log found in @directory@. -- The most recent checkpoint will be loaded immediately but the AcidState will not be opened -- until the returned function is executed. prepareLocalStateFrom :: (IsAcidic st, SafeCopy st) => FilePath -- ^ Location of the checkpoint and transaction files. -> st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> IO (IO (AcidState st)) prepareLocalStateFrom directory initialState = prepareLocalStateWithSerialiser directory initialState defaultSerialisationLayer -- | Create an AcidState given a log directory, an initial value and a serialisation layer. -- -- This will create or resume a log found in @directory@. -- The most recent checkpoint will be loaded immediately but the AcidState will not be opened -- until the returned function is executed. prepareLocalStateWithSerialiser :: (IsAcidic st) => FilePath -- ^ Location of the checkpoint and transaction files. -> st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> SerialisationLayer st -- ^ Serialisation layer to use for checkpoints, events and archives. -> IO (IO (AcidState st)) prepareLocalStateWithSerialiser directory initialState serialisationLayer = resumeLocalStateFrom directory initialState True serialisationLayer data SerialisationLayer st = SerialisationLayer { checkpointSerialiser :: Serialiser (Checkpoint st) -- ^ Serialisation strategy for checkpoints. -- -- Use 'safeCopySerialiser' for the backwards-compatible -- implementation using "Data.SafeCopy". , eventSerialiser :: Serialiser (Tagged ByteString) -- ^ Serialisation strategy for events. -- -- Use 'safeCopySerialiser' for the backwards-compatible -- implementation using "Data.SafeCopy". , archiver :: Archiver -- ^ Serialisation strategy for archive log files. -- -- Use 'defaultArchiver' for the backwards-compatible -- implementation using "Data.Serialize". } -- | Standard (and historically the only) serialisation layer, using -- 'safeCopySerialiser' and 'defaultArchiver'. defaultSerialisationLayer :: SafeCopy st => SerialisationLayer st defaultSerialisationLayer = SerialisationLayer safeCopySerialiser safeCopySerialiser defaultArchiver mkEventsLogKey :: FilePath -> SerialisationLayer object -> LogKey (Tagged ByteString) mkEventsLogKey directory serialisationLayer = LogKey { logDirectory = directory , logPrefix = "events" , logSerialiser = eventSerialiser serialisationLayer , logArchiver = archiver serialisationLayer } mkCheckpointsLogKey :: FilePath -> SerialisationLayer object -> LogKey (Checkpoint object) mkCheckpointsLogKey directory serialisationLayer = LogKey { logDirectory = directory , logPrefix = "checkpoints" , logSerialiser = checkpointSerialiser serialisationLayer , logArchiver = archiver serialisationLayer } resumeLocalStateFrom :: (IsAcidic st) => FilePath -- ^ Location of the checkpoint and transaction files. -> st -- ^ Initial state value. This value is only used if no checkpoint is -- found. -> Bool -- ^ True => load checkpoint before acquiring the lock. -> SerialisationLayer st -- ^ Serialisation layer to use for checkpoints, events and archives. -> IO (IO (AcidState st)) resumeLocalStateFrom directory initialState delayLocking serialisationLayer = case delayLocking of True -> do (n, st) <- loadCheckpoint return $ do lock <- maybeLockFile lockFile replayEvents lock n st False -> do lock <- maybeLockFile lockFile (n, st) <- loadCheckpoint `onException` unlockFile lock return $ do replayEvents lock n st where lockFile = directory "open.lock" eventsLogKey = mkEventsLogKey directory serialisationLayer checkpointsLogKey = mkCheckpointsLogKey directory serialisationLayer loadCheckpoint = do mbLastCheckpoint <- Log.newestEntry checkpointsLogKey case mbLastCheckpoint of Nothing -> return (0, initialState) Just (Checkpoint eventCutOff !val) -> -- N.B. We must be strict in val so that we force any -- lurking deserialisation error immediately. return (eventCutOff, val) replayEvents lock n st = do core <- mkCore (eventsToMethods acidEvents) st eventsLog <- openFileLog eventsLogKey events <- readEntriesFrom eventsLog n mapM_ (runColdMethod core) events ensureLeastEntryId eventsLog n checkpointsLog <- openFileLog checkpointsLogKey stateCopy <- newIORef undefined withCoreState core (writeIORef stateCopy) return $ toAcidState LocalState { localCore = core , localCopy = stateCopy , localEvents = eventsLog , localCheckpoints = checkpointsLog , localLock = lock } maybeLockFile path = do createDirectoryIfMissing True (takeDirectory path) maybe (throwIO (StateIsLocked path)) return =<< tryLockFile path Exclusive checkpointRestoreError msg = error $ "Could not parse saved checkpoint due to the following error: " ++ msg -- | Close an AcidState and associated logs. -- Any subsequent usage of the AcidState will throw an exception. closeLocalState :: LocalState st -> IO () closeLocalState acidState = do closeCore (localCore acidState) closeFileLog (localEvents acidState) closeFileLog (localCheckpoints acidState) unlockFile (localLock acidState) createLocalArchive :: LocalState st -> IO () createLocalArchive state = do -- We need to look at the last checkpoint saved to disk. Since checkpoints can be written -- in parallel with this call, we can't guarantee that the checkpoint we get really is the -- last one but that's alright. currentCheckpointId <- cutFileLog (localCheckpoints state) -- 'currentCheckpointId' is the ID of the next checkpoint that will be written to disk. -- 'currentCheckpointId-1' must then be the ID of a checkpoint on disk (or -1, of course). let durableCheckpointId = currentCheckpointId-1 checkpoints <- readEntriesFrom (localCheckpoints state) durableCheckpointId case checkpoints of [] -> return () (Checkpoint entryId _content : _) -> do -- 'entryId' is the lowest entryId that didn't contribute to the checkpoint. -- 'archiveFileLog' moves all files that are lower than this entryId to the archive. archiveFileLog (localEvents state) entryId -- In the same style as above, we archive all log files that came before the log file -- which contains our checkpoint. archiveFileLog (localCheckpoints state) durableCheckpointId toAcidState :: IsAcidic st => LocalState st -> AcidState st toAcidState local = AcidState { _scheduleUpdate = scheduleLocalUpdate local , scheduleColdUpdate = scheduleLocalColdUpdate local , _query = localQuery local , queryCold = localQueryCold local , createCheckpoint = createLocalCheckpoint local , createArchive = createLocalArchive local , closeAcidState = closeLocalState local , acidSubState = mkAnyState local } acid-state-0.16.0.1/src/Data/Acid/Remote.hs0000644000000000000000000006445713660647235016264 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, RankNTypes, RecordWildCards, ScopedTypeVariables #-} ----------------------------------------------------------------------------- {- | Module : Data.Acid.Remote Copyright : PublicDomain Maintainer : lemmih@gmail.com Portability : non-portable (uses GHC extensions) This module provides the ability perform 'update' and 'query' calls from a remote process. On the server-side you: 1. open your 'AcidState' normally 2. then use 'acidServer' to share the state On the client-side you: 1. use 'openRemoteState' to connect to the remote state 2. use the returned 'AcidState' like any other 'AcidState' handle 'openRemoteState' and 'acidServer' communicate over an unencrypted socket. If you need an encrypted connection, see @acid-state-tls@. On Unix®-like systems you can use 'SockAddrUnix' to create a socket file for local communication between the client and server. Access can be controlled by setting the permissions of the parent directory containing the socket file. It is also possible to perform some simple authentication using 'sharedSecretCheck' and 'sharedSecretPerform'. Keep in mind that secrets will be sent in plain-text if you do not use @acid-state-tls@. If you are using a 'SockAddrUnix' additional authentication may not be required, so you can use 'skipAuthenticationCheck' and 'skipAuthenticationPerform'. Working with a remote 'AcidState' is nearly identical to working with a local 'AcidState' with a few important differences. The connection to the remote 'AcidState' can be lost. The client will automatically attempt to reconnect every second. Because 'query' events do not affect the state, an aborted 'query' will be retried automatically after the server is reconnected. If the connection was lost during an 'update' event, the event will not be retried. Instead 'RemoteConnectionError' will be raised. This is because it is impossible for the client to know if the aborted update completed on the server-side or not. When using a local 'AcidState', an update event in one thread does not block query events taking place in other threads. With a remote connection, all queries and requests are channeled over a single connection. As a result, updates and queries are performed in the order they are executed and do block each other. In the rare case where this is an issue, you could create one remote connection per thread. When working with local state, a query or update which returns the whole state is not usually a problem due to memory sharing. The update/query event basically just needs to return a pointer to the data already in memory. But, when working remotely, the entire result will be serialized and sent to the remote client. Hence, it is good practice to create queries and updates that will only return the required data. This module is designed to be extenible. You can easily add your own authentication methods by creating a suitable pair of functions and passing them to 'acidServer' and 'openRemoteState'. It is also possible to create alternative communication layers using 'CommChannel', 'process', and 'processRemoteState'. -} module Data.Acid.Remote ( -- * Server/Client acidServer , acidServerSockAddr , acidServer' , openRemoteState , openRemoteStateSockAddr -- * Authentication , skipAuthenticationCheck , skipAuthenticationPerform , sharedSecretCheck , sharedSecretPerform -- * Exception type , AcidRemoteException(..) -- * Low-Level functions needed to implement additional communication channels , CommChannel(..) , process , processRemoteState ) where import Prelude hiding ( catch ) import Control.Concurrent.STM ( atomically ) import Control.Concurrent.STM.TMVar ( newEmptyTMVar, readTMVar, takeTMVar, tryTakeTMVar, putTMVar ) import Control.Concurrent.STM.TQueue import Control.Exception ( AsyncException(ThreadKilled) , Exception(fromException), IOException, Handler(..) , SomeException, catch, catches, throw, bracketOnError ) import Control.Exception ( throwIO, finally ) import Control.Monad ( forever, liftM, join, when ) import Control.Concurrent ( ThreadId, forkIO, threadDelay, killThread, myThreadId ) import Control.Concurrent.MVar ( MVar, newEmptyMVar, putMVar, takeMVar ) import Control.Concurrent.Chan ( newChan, readChan, writeChan ) import Data.Acid.Abstract import Data.Acid.Core import Data.Acid.Common import Data.Monoid ((<>)) import qualified Data.ByteString as Strict import Data.ByteString.Char8 ( pack ) import qualified Data.ByteString.Lazy as Lazy import Data.IORef ( newIORef, readIORef, writeIORef ) import Data.Serialize import Data.Set ( Set, member ) import Data.Typeable ( Typeable ) import GHC.IO.Exception ( IOErrorType(..) ) import Network.BSD ( PortNumber, getProtocolNumber, getHostByName, hostAddress ) import Network.Socket import Network.Socket.ByteString as NSB ( recv, sendAll ) import System.Directory ( removeFile ) import System.IO ( Handle, hPrint, hFlush, hClose, stderr, IOMode(..) ) import System.IO.Error ( ioeGetErrorType, isFullError, isDoesNotExistError ) debugStrLn :: String -> IO () debugStrLn s = do -- putStrLn s -- uncomment to enable debugging return () -- | 'CommChannel' is a record containing the IO functions we need for communication between the server and client. -- -- We abstract this out of the core processing function so that we can easily add support for SSL/TLS and Unit testing. data CommChannel = CommChannel { ccPut :: Strict.ByteString -> IO () , ccGetSome :: Int -> IO (Strict.ByteString) , ccClose :: IO () } data AcidRemoteException = RemoteConnectionError | AcidStateClosed | SerializeError String | AuthenticationError String deriving (Eq, Show, Typeable) instance Exception AcidRemoteException -- | create a 'CommChannel' from a 'Handle'. The 'Handle' should be -- some two-way communication channel, such as a socket -- connection. Passing in a 'Handle' to a normal is file is unlikely -- to do anything useful. handleToCommChannel :: Handle -> CommChannel handleToCommChannel handle = CommChannel { ccPut = \bs -> Strict.hPut handle bs >> hFlush handle , ccGetSome = Strict.hGetSome handle , ccClose = hClose handle } {- | create a 'CommChannel' from a 'Socket'. The 'Socket' should be an accepted socket, not a listen socket. -} socketToCommChannel :: Socket -> CommChannel socketToCommChannel socket = CommChannel { ccPut = sendAll socket , ccGetSome = NSB.recv socket , ccClose = close socket } {- | skip server-side authentication checking entirely. -} skipAuthenticationCheck :: CommChannel -> IO Bool skipAuthenticationCheck _ = return True {- | skip client-side authentication entirely. -} skipAuthenticationPerform :: CommChannel -> IO () skipAuthenticationPerform _ = return () {- | check that the client knows a shared secret. The function takes a 'Set' of shared secrets. If a client knows any of them, it is considered to be trusted. The shared secret is any 'ByteString' of your choice. If you give each client a different shared secret then you can revoke access individually. see also: 'sharedSecretPerform' -} sharedSecretCheck :: Set Strict.ByteString -- ^ set of shared secrets -> (CommChannel -> IO Bool) sharedSecretCheck secrets cc = do bs <- ccGetSome cc 1024 if member bs secrets then do ccPut cc (pack "OK") return True else do ccPut cc (pack "FAIL") return False -- | attempt to authenticate with the server using a shared secret. sharedSecretPerform :: Strict.ByteString -- ^ shared secret -> (CommChannel -> IO ()) sharedSecretPerform pw cc = do ccPut cc pw r <- ccGetSome cc 1024 if r == (pack "OK") then return () else throwIO (AuthenticationError "shared secret authentication failed.") {- | Accept connections on @sockAddr@ and handle requests using the given 'AcidState'. This call doesn't return. see also: 'acidServer', 'openRemoteState' and 'sharedSecretCheck'. -} acidServerSockAddr :: (CommChannel -> IO Bool) -- ^ check authentication, see 'sharedSecretPerform' -> SockAddr -- ^ SockAddr to listen on -> AcidState st -- ^ state to serve -> IO () acidServerSockAddr checkAuth sockAddr acidState = do listenSocket <- listenOn sockAddr (acidServer' checkAuth listenSocket acidState) `finally` (cleanup listenSocket) where cleanup socket = do close socket #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) case sockAddr of (SockAddrUnix path) -> removeFile path _ -> pure () #endif {- | Accept connections on @port@ and handle requests using the given 'AcidState'. This call doesn't return. see also: 'acidServerSockAddr', 'openRemoteState' and 'sharedSecretCheck'. -} acidServer :: (CommChannel -> IO Bool) -- ^ check authentication, see 'sharedSecretPerform' -> PortNumber -- ^ Port to listen on -> AcidState st -- ^ state to serve -> IO () acidServer checkAuth port acidState = acidServerSockAddr checkAuth (SockAddrInet port 0) acidState listenOn :: SockAddr -> IO Socket listenOn sockAddr = do #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) proto <- case sockAddr of (SockAddrUnix {}) -> pure 0 _ -> getProtocolNumber "tcp" #else proto <- getProtocolNumber "tcp" #endif bracketOnError (socket af Stream proto) close (\sock -> do setSocketOption sock ReuseAddr 1 bind sock sockAddr listen sock maxListenQueue return sock ) where af = case sockAddr of (SockAddrInet {}) -> AF_INET (SockAddrInet6 {}) -> AF_INET6 #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) (SockAddrUnix {}) -> AF_UNIX #endif {- | Works the same way as 'acidServer', but uses pre-binded socket @listenSocket@. Can be useful when fine-tuning of socket binding parameters is needed (for example, listening on a particular network interface, IPv4/IPv6 options). -} acidServer' :: (CommChannel -> IO Bool) -- ^ check authentication, see 'sharedSecretPerform' -> Socket -- ^ binded socket to accept connections from -> AcidState st -- ^ state to serve -> IO () acidServer' checkAuth listenSocket acidState = do let loop = forever $ do (socket, _sockAddr) <- accept listenSocket let commChannel = socketToCommChannel socket forkIO $ do authorized <- checkAuth commChannel when authorized $ process commChannel acidState ccClose commChannel -- FIXME: `finally` ? infi = loop `catchSome` logError >> infi infi where logError :: (Show e) => e -> IO () logError e = hPrint stderr e isResourceVanishedError :: IOException -> Bool isResourceVanishedError = isResourceVanishedType . ioeGetErrorType isResourceVanishedType :: IOErrorType -> Bool isResourceVanishedType ResourceVanished = True isResourceVanishedType _ = False catchSome :: IO () -> (Show e => e -> IO ()) -> IO () catchSome op _h = op `catches` [ Handler $ \(e :: IOException) -> if isFullError e || isDoesNotExistError e || isResourceVanishedError e then return () -- h (toException e) -- we could log the exception, but there could be thousands of them else throw e ] data Command = RunQuery (Tagged Lazy.ByteString) | RunUpdate (Tagged Lazy.ByteString) | CreateCheckpoint | CreateArchive instance Serialize Command where put cmd = case cmd of RunQuery query -> do putWord8 0; put query RunUpdate update -> do putWord8 1; put update CreateCheckpoint -> putWord8 2 CreateArchive -> putWord8 3 get = do tag <- getWord8 case tag of 0 -> liftM RunQuery get 1 -> liftM RunUpdate get 2 -> return CreateCheckpoint 3 -> return CreateArchive _ -> error $ "Data.Acid.Remote: Serialize.get for Command, invalid tag: " ++ show tag data Response = Result Lazy.ByteString | Acknowledgement | ConnectionError instance Serialize Response where put resp = case resp of Result result -> do putWord8 0; put result Acknowledgement -> putWord8 1 ConnectionError -> putWord8 2 get = do tag <- getWord8 case tag of 0 -> liftM Result get 1 -> return Acknowledgement 2 -> return ConnectionError _ -> error $ "Data.Acid.Remote: Serialize.get for Response, invalid tag: " ++ show tag {- | Server inner-loop This function is generally only needed if you are adding a new communication channel. -} process :: CommChannel -- ^ a connected, authenticated communication channel -> AcidState st -- ^ state to share -> IO () process CommChannel{..} acidState = do chan <- newChan forkIO $ forever $ do response <- join (readChan chan) ccPut (encode response) worker chan (runGetPartial get Strict.empty) where worker chan inp = case inp of Fail msg _ -> throwIO (SerializeError msg) Partial cont -> do bs <- ccGetSome 1024 if Strict.null bs then return () else worker chan (cont bs) Done cmd rest -> do processCommand chan cmd; worker chan (runGetPartial get rest) processCommand chan cmd = case cmd of RunQuery query -> do result <- queryCold acidState query writeChan chan (return $ Result result) RunUpdate update -> do result <- scheduleColdUpdate acidState update writeChan chan (liftM Result $ takeMVar result) CreateCheckpoint -> do createCheckpoint acidState writeChan chan (return Acknowledgement) CreateArchive -> do createArchive acidState writeChan chan (return Acknowledgement) data RemoteState st = RemoteState (Command -> IO (MVar Response)) (IO ()) deriving (Typeable) {- | Connect to an acid-state server which is sharing an 'AcidState'. -} openRemoteState :: IsAcidic st => (CommChannel -> IO ()) -- ^ authentication function, see 'sharedSecretPerform' -> HostName -- ^ remote host to connect to -> PortNumber -- ^ remote port to connect to -> IO (AcidState st) openRemoteState performAuthorization host port = do he <- getHostByName host openRemoteStateSockAddr performAuthorization (SockAddrInet port (hostAddress he)) {- | Connect to an acid-state server which is sharing an 'AcidState'. -} openRemoteStateSockAddr :: IsAcidic st => (CommChannel -> IO ()) -- ^ authentication function, see 'sharedSecretPerform' -> SockAddr -- ^ remote SockAddr to connect to -> IO (AcidState st) openRemoteStateSockAddr performAuthorization sockAddr = withSocketsDo $ do processRemoteState reconnect where af :: Family af = case sockAddr of (SockAddrInet {}) -> AF_INET (SockAddrInet6 {}) -> AF_INET6 #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) (SockAddrUnix {}) -> AF_UNIX #endif -- | reconnect reconnect :: IO CommChannel reconnect = (do debugStrLn "Reconnecting." #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) proto <- case sockAddr of (SockAddrUnix {}) -> pure 0 _ -> getProtocolNumber "tcp" #else proto <- getProtocolNumber "tcp" #endif handle <- bracketOnError (socket af Stream proto) close -- only done if there's an error (\sock -> do connect sock sockAddr socketToHandle sock ReadWriteMode ) let cc = handleToCommChannel handle performAuthorization cc debugStrLn "Reconnected." return cc ) `catch` ((\_ -> threadDelay 1000000 >> reconnect) :: IOError -> IO CommChannel) {- | Client inner-loop This function is generally only needed if you are adding a new communication channel. -} processRemoteState :: IsAcidic st => IO CommChannel -- ^ (re-)connect function -> IO (AcidState st) processRemoteState reconnect = do cmdQueue <- atomically newTQueue ccTMV <- atomically newEmptyTMVar isClosed <- newIORef False let actor :: Command -> IO (MVar Response) actor command = do debugStrLn "actor: begin." readIORef isClosed >>= flip when (throwIO AcidStateClosed) ref <- newEmptyMVar atomically $ writeTQueue cmdQueue (command, ref) debugStrLn "actor: end." return ref expireQueue listenQueue = do mCallback <- atomically $ tryReadTQueue listenQueue case mCallback of Nothing -> return () (Just callback) -> do callback ConnectionError expireQueue listenQueue handleReconnect :: SomeException -> IO () handleReconnect e = case fromException e of (Just ThreadKilled) -> do debugStrLn "handleReconnect: ThreadKilled. Not attempting to reconnect." return () _ -> do debugStrLn $ "handleReconnect begin." tmv <- atomically $ tryTakeTMVar ccTMV case tmv of Nothing -> do debugStrLn $ "handleReconnect: error handling already in progress." debugStrLn $ "handleReconnect end." return () (Just (oldCC, oldListenQueue, oldListenerTID)) -> do thisTID <- myThreadId when (thisTID /= oldListenerTID) (killThread oldListenerTID) ccClose oldCC expireQueue oldListenQueue cc <- reconnect listenQueue <- atomically $ newTQueue listenerTID <- forkIO $ listener cc listenQueue atomically $ putTMVar ccTMV (cc, listenQueue, listenerTID) debugStrLn $ "handleReconnect end." return () listener :: CommChannel -> TQueue (Response -> IO ()) -> IO () listener cc listenQueue = getResponse Strict.empty `catch` handleReconnect where getResponse leftover = do debugStrLn $ "listener: listening for Response." let go inp = case inp of Fail msg _ -> error $ "Data.Acid.Remote: " <> msg Partial cont -> do debugStrLn $ "listener: ccGetSome" bs <- ccGetSome cc 1024 go (cont bs) Done resp rest -> do debugStrLn $ "listener: getting callback" callback <- atomically $ readTQueue listenQueue debugStrLn $ "listener: passing Response to callback" callback (resp :: Response) return rest rest <- go (runGetPartial get leftover) -- `catch` (\e -> do handleReconnect e -- throwIO e -- ) getResponse rest actorThread :: IO () actorThread = forever $ do debugStrLn "actorThread: waiting for something to do." (cc, cmd) <- atomically $ do (cmd, ref) <- readTQueue cmdQueue (cc, listenQueue, _) <- readTMVar ccTMV writeTQueue listenQueue (putMVar ref) return (cc, cmd) debugStrLn "actorThread: sending command." ccPut cc (encode cmd) `catch` handleReconnect debugStrLn "actorThread: sent." return () shutdown :: ThreadId -> IO () shutdown actorTID = do debugStrLn "shutdown: update isClosed IORef to True." writeIORef isClosed True debugStrLn "shutdown: killing actor thread." killThread actorTID debugStrLn "shutdown: taking ccTMV." (cc, listenQueue, listenerTID) <- atomically $ takeTMVar ccTMV -- FIXME: or should this by tryTakeTMVar debugStrLn "shutdown: killing listener thread." killThread listenerTID debugStrLn "shutdown: expiring listen queue." expireQueue listenQueue debugStrLn "shutdown: closing connection." ccClose cc return () cc <- reconnect listenQueue <- atomically $ newTQueue actorTID <- forkIO $ actorThread listenerTID <- forkIO $ listener cc listenQueue atomically $ putTMVar ccTMV (cc, listenQueue, listenerTID) return (toAcidState $ RemoteState actor (shutdown actorTID)) remoteQuery :: QueryEvent event => RemoteState (EventState event) -> MethodMap (EventState event) -> event -> IO (EventResult event) remoteQuery acidState mmap event = do let encoded = encodeMethod ms event resp <- remoteQueryCold acidState (methodTag event, encoded) return (case decodeResult ms resp of Left msg -> error $ "Data.Acid.Remote: " <> msg Right result -> result) where (_, ms) = lookupHotMethodAndSerialiser mmap event remoteQueryCold :: RemoteState st -> Tagged Lazy.ByteString -> IO Lazy.ByteString remoteQueryCold rs@(RemoteState fn _shutdown) event = do resp <- takeMVar =<< fn (RunQuery event) case resp of (Result result) -> return result ConnectionError -> do debugStrLn "retrying query event." remoteQueryCold rs event Acknowledgement -> error "Data.Acid.Remote: remoteQueryCold got Acknowledgement. That should never happen." scheduleRemoteUpdate :: UpdateEvent event => RemoteState (EventState event) -> MethodMap (EventState event) -> event -> IO (MVar (EventResult event)) scheduleRemoteUpdate (RemoteState fn _shutdown) mmap event = do let encoded = encodeMethod ms event parsed <- newEmptyMVar respRef <- fn (RunUpdate (methodTag event, encoded)) forkIO $ do Result resp <- takeMVar respRef putMVar parsed (case decodeResult ms resp of Left msg -> error $ "Data.Acid.Remote: " <> msg Right result -> result) return parsed where (_, ms) = lookupHotMethodAndSerialiser mmap event scheduleRemoteColdUpdate :: RemoteState st -> Tagged Lazy.ByteString -> IO (MVar Lazy.ByteString) scheduleRemoteColdUpdate (RemoteState fn _shutdown) event = do parsed <- newEmptyMVar respRef <- fn (RunUpdate event) forkIO $ do Result resp <- takeMVar respRef putMVar parsed resp return parsed closeRemoteState :: RemoteState st -> IO () closeRemoteState (RemoteState _fn shutdown) = shutdown createRemoteCheckpoint :: RemoteState st -> IO () createRemoteCheckpoint (RemoteState fn _shutdown) = do Acknowledgement <- takeMVar =<< fn CreateCheckpoint return () createRemoteArchive :: RemoteState st -> IO () createRemoteArchive (RemoteState fn _shutdown) = do Acknowledgement <- takeMVar =<< fn CreateArchive return () toAcidState :: forall st . IsAcidic st => RemoteState st -> AcidState st toAcidState remote = AcidState { _scheduleUpdate = scheduleRemoteUpdate remote mmap , scheduleColdUpdate = scheduleRemoteColdUpdate remote , _query = remoteQuery remote mmap , queryCold = remoteQueryCold remote , createCheckpoint = createRemoteCheckpoint remote , createArchive = createRemoteArchive remote , closeAcidState = closeRemoteState remote , acidSubState = mkAnyState remote } where mmap :: MethodMap st mmap = mkMethodMap (eventsToMethods acidEvents) acid-state-0.16.0.1/src/Data/Acid/Memory/0000755000000000000000000000000013660647235015725 5ustar0000000000000000acid-state-0.16.0.1/src/Data/Acid/Memory/Pure.hs0000644000000000000000000000641513660647235017202 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Acid.Memory.Pure -- Copyright : PublicDomain -- -- Maintainer : lemmih@gmail.com -- Portability : non-portable (uses GHC extensions) -- -- AcidState container without a transaction log. Mostly used for testing. -- module Data.Acid.Memory.Pure ( IsAcidic(..) , AcidState , Event(..) , EventResult , EventState , UpdateEvent , QueryEvent , Update , Query , openAcidState , update , update_ , query , liftQuery , runUpdate , runQuery ) where import Data.Acid.Core import Data.Acid.Common import Control.Monad.State import Control.Monad.Reader {-| State container offering full ACID (Atomicity, Consistency, Isolation and Durability) guarantees. [@Atomicity@] State changes are all-or-nothing. This is what you'd expect of any state variable in Haskell and AcidState doesn't change that. [@Consistency@] No event or set of events will break your data invariants. [@Isolation@] Transactions cannot interfere with each other even when issued in parallel. [@Durability@] Successful transaction are guaranteed to survive system failure (both hardware and software). -} data AcidState st = AcidState { localMethods :: MethodMap st , localState :: st } -- | Issue an Update event and wait for its result. Once this call returns, you are -- guaranteed that the changes to the state are durable. Events may be issued in -- parallel. -- -- It's a run-time error to issue events that aren't supported by the AcidState. update :: UpdateEvent event => AcidState (EventState event) -> event -> ( AcidState (EventState event) , EventResult event) update acidState event = case runState hotMethod (localState acidState) of !(result, !newState) -> ( acidState { localState = newState } , result ) where hotMethod = lookupHotMethod (localMethods acidState) event -- | Same as 'update' but ignoring the event result. update_ :: UpdateEvent event => AcidState (EventState event) -> event -> AcidState (EventState event) update_ acidState event = fst (update acidState event) -- | Issue a Query event and wait for its result. query :: QueryEvent event => AcidState (EventState event) -> event -> EventResult event query acidState event = case runState hotMethod (localState acidState) of !(result, !_st) -> result where hotMethod = lookupHotMethod (localMethods acidState) event -- | Create an AcidState given an initial value. openAcidState :: IsAcidic st => st -- ^ Initial state value. -> AcidState st openAcidState initialState = AcidState { localMethods = mkMethodMap (eventsToMethods acidEvents) , localState = initialState } -- | Execute the 'Update' monad in a pure environment. runUpdate :: Update s r -> s -> (r, s) runUpdate update = runState $ unUpdate update -- | Execute the 'Query' monad in a pure environment. runQuery :: Query s r -> s -> r runQuery query = runReader $ unQuery query