ron-storage 0.8 → 0.9
raw patch · 5 files changed
+165/−132 lines, 5 files
Files
- CHANGELOG.md +18/−4
- lib/RON/Storage.hs +56/−46
- lib/RON/Storage/Backend.hs +90/−80
- lib/RON/Storage/Test.hs +0/−1
- ron-storage.cabal +1/−1
CHANGELOG.md view
@@ -7,6 +7,19 @@ ## [Unreleased] +## [0.9] - 2019-08-10+### Added+- Type alias Payload = [Atom]++### Changed+- `modify` now pops result of action (to use with `getObject`, for instance).+- Renamed `ObjectState` to `ObjectFrame`+- Renamed `Document.value` to `objectFrame`++### Removed+- Concept of chunk version in RON protocol,+ types `StateChunk` and `WireReducedChunk`.+ ## [0.8] - 2019-07-26 ### Added - Module `RON.Storage.Rocks`@@ -120,10 +133,11 @@ - RON-Schema - RON-Schema TemplateHaskell code generator -[Unreleased]: https://github.com/ff-notes/ron/compare/v0.8...HEAD-[0.8]: https://github.com/ff-notes/ron/compare/v0.7...v0.8-[0.7]: https://github.com/ff-notes/ron/compare/v0.6...v0.7-[0.6]: https://github.com/ff-notes/ron/compare/v0.5...v0.6+[Unreleased]: https://github.com/ff-notes/ron/compare/ron-storage-0.9...HEAD+[0.9]: https://github.com/ff-notes/ron/compare/ron-storage-0.8...ron-storage-0.9+[0.8]: https://github.com/ff-notes/ron/compare/ron-storage-0.7...ron-storage-0.8+[0.7]: https://github.com/ff-notes/ron/compare/ron-storage-0.6...ron-storage-0.7+[0.6]: https://github.com/ff-notes/ron/compare/v0.5...ron-storage-0.6 [0.5]: https://github.com/ff-notes/ron/compare/v0.4...v0.5 [0.4]: https://github.com/ff-notes/ron/compare/v0.3...v0.4 [0.3]: https://github.com/ff-notes/ron/compare/v0.2...v0.3
lib/RON/Storage.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE TupleSections #-} -- | RON Storage interface. For usage, see "RON.Storage.FS".-module RON.Storage (- Collection (..),+module RON.Storage+ ( Collection (..), CollectionDocId (..), CollectionName, DocId,@@ -13,22 +13,27 @@ decodeDocId, docIdFromUuid, loadDocument,- modify,-) where--import RON.Prelude+ modify+ )+where import qualified Data.Text as Text--import RON.Data (ObjectStateT, execObjectState, reduceObject)-import RON.Error (Error (Error), errorContext, throwErrorString)-import RON.Storage.Backend (Collection (..), CollectionName,- DocId (DocId), Document (Document),- IsTouched (IsTouched), MonadStorage,- createVersion, decodeDocId,- getDocumentVersions, isTouched,- readVersion, value, versions)-import RON.Types (ObjectState, UUID)+import RON.Data (ObjectStateT, reduceObject, runObjectState)+import RON.Error (Error (Error), errorContext, throwErrorString)+import RON.Prelude+import RON.Storage.Backend+ ( Collection (..),+ CollectionName,+ DocId (DocId),+ Document (Document, isTouched, objectFrame, versions),+ IsTouched (IsTouched),+ MonadStorage,+ createVersion,+ decodeDocId,+ getDocumentVersions,+ readVersion+ )+import RON.Types (ObjectFrame, UUID) import qualified RON.UUID as UUID data CollectionDocId = forall a. Collection a => CollectionDocId (DocId a)@@ -38,36 +43,40 @@ loadDocument docid = loadRetry (3 :: Int) where loadRetry n- | n > 0 = do- versions0 <- getDocumentVersions docid- case versions0 of- [] ->- throwErrorString $- "Document with id " ++ show docid ++ " has not found."- v:vs -> do- let versions = v :| vs- let wrapDoc (value, isTouched) =- Document{value, versions, isTouched}- readResults <-- errorContext ("document " <> show docid) $- for versions $ \ver ->- try $- errorContext ("version " <> Text.pack ver) $- readVersion docid ver- liftEither $ wrapDoc <$> vsconcat readResults- | otherwise = throwError "Maximum retries exceeded"+ | n > 0 =+ do+ versions0 <- getDocumentVersions docid+ case versions0 of+ [] ->+ throwErrorString+ $ "Document with id "+ ++ show docid+ ++ " has not found."+ v : vs -> do+ let versions = v :| vs+ let wrapDoc (objectFrame, isTouched) =+ Document {objectFrame, versions, isTouched}+ readResults <-+ errorContext ("document " <> show docid)+ $ for versions $ \ver ->+ try+ $ errorContext ("version " <> Text.pack ver)+ $ readVersion docid ver+ liftEither $ wrapDoc <$> vsconcat readResults+ | otherwise = throwError "Maximum retries exceeded" -- | Validation-like version of 'sconcat'. vsconcat- :: NonEmpty (Either Error (ObjectState a, IsTouched))- -> Either Error (ObjectState a, IsTouched)+ :: NonEmpty (Either Error (ObjectFrame a, IsTouched))+ -> Either Error (ObjectFrame a, IsTouched) vsconcat = foldr1 vappend where- vappend (Left e1) (Left e2) = Left $ Error "vappend" [e1, e2]- vappend e1@(Left _ ) (Right _ ) = e1- vappend (Right _ ) e2@(Left _ ) = e2- vappend (Right r1) (Right r2) =- (, IsTouched (t1 || t2)) <$> reduceObject a1 a2 where+ vappend (Left e1) (Left e2) = Left $ Error "vappend" [e1, e2]+ vappend e1@(Left _) (Right _) = e1+ vappend (Right _) e2@(Left _) = e2+ vappend (Right r1) (Right r2) =+ (,IsTouched (t1 || t2)) <$> reduceObject a1 a2+ where (a1, IsTouched t1) = r1 (a2, IsTouched t2) = r2 @@ -76,14 +85,15 @@ -- | Load document, apply changes and put it back to storage modify- :: (Collection a, MonadStorage m) => DocId a -> ObjectStateT a m () -> m ()+ :: (Collection a, MonadStorage m) => DocId a -> ObjectStateT a m b -> m b modify docid f = do- oldDoc <- loadDocument docid- value' <- execObjectState (value oldDoc) f- createVersion (Just (docid, oldDoc)) value'+ oldDoc <- loadDocument docid+ (b, objectFrame') <- runObjectState (objectFrame oldDoc) f+ createVersion (Just (docid, oldDoc)) objectFrame'+ pure b -- | Create document assuming it doesn't exist yet.-createDocument :: (Collection a, MonadStorage m) => ObjectState a -> m ()+createDocument :: (Collection a, MonadStorage m) => ObjectFrame a -> m () createDocument = createVersion Nothing docIdFromUuid :: UUID -> DocId a
lib/RON/Storage/Backend.hs view
@@ -6,8 +6,8 @@ {-# LANGUAGE TypeApplications #-} -- | RON Storage details. Use of this module only to implement a backend.-module RON.Storage.Backend (- Collection (..),+module RON.Storage.Backend+ ( Collection (..), CollectionName, DocId (..), Document (..),@@ -16,23 +16,22 @@ MonadStorage (..), createVersion, decodeDocId,- readVersion,-) where--import RON.Prelude+ readVersion+ )+where import qualified Data.ByteString.Lazy.Char8 as BSLC-import Data.String (fromString)-import System.FilePath ((</>))-import qualified Text.Show (show)--import RON.Data (ReplicatedAsObject)-import RON.Error (MonadE, liftMaybe, throwErrorString)-import RON.Event (ReplicaClock, getEventUuid)-import RON.Text (parseStateFrame, serializeStateFrame)-import RON.Types (ObjectState (ObjectState, frame, uuid), UUID)-import RON.Util (ByteStringL)+import Data.String (fromString)+import RON.Data (ReplicatedAsObject)+import RON.Error (MonadE, liftMaybe, throwErrorString)+import RON.Event (ReplicaClock, getEventUuid)+import RON.Prelude+import RON.Text (parseStateFrame, serializeStateFrame)+import RON.Types (ObjectFrame (ObjectFrame, frame, uuid), UUID) import qualified RON.UUID as UUID+import RON.Util (ByteStringL)+import System.FilePath ((</>))+import qualified Text.Show (show) -- | Document version identifier (file name) type DocVersion = FilePath@@ -40,11 +39,12 @@ -- | Document identifier (directory name), -- should be a RON-Base32-encoded RON-UUID. newtype DocId a = DocId FilePath- deriving (Eq, Ord)+ deriving (Eq, Ord) instance Collection a => Show (DocId a) where- show (DocId file) = collectionName @a </> file + show (DocId file) = collectionName @a </> file+ -- | Collection (directory name) type CollectionName = FilePath @@ -52,96 +52,106 @@ -- Collection instance. class (ReplicatedAsObject a, Typeable a) => Collection a where - collectionName :: CollectionName+ collectionName :: CollectionName - -- | Called when RON parser fails.- fallbackParse :: MonadE m => UUID -> ByteStringL -> m (ObjectState a)- fallbackParse _ _ = throwError "no fallback parser implemented"+ -- | Called when RON parser fails.+ fallbackParse :: MonadE m => UUID -> ByteStringL -> m (ObjectFrame a)+ fallbackParse _ _ = throwError "no fallback parser implemented" -- | Storage backend interface class (ReplicaClock m, MonadE m) => MonadStorage m where- getCollections :: m [CollectionName] - -- | Must return @[]@ for non-existent collection- getDocuments :: Collection a => m [DocId a]+ getCollections :: m [CollectionName] - -- | Must return @[]@ for non-existent document- getDocumentVersions :: Collection a => DocId a -> m [DocVersion]+ -- | Must return @[]@ for non-existent collection+ getDocuments :: Collection a => m [DocId a] - -- | Must create collection and document if not exist- saveVersionContent- :: Collection a => DocId a -> DocVersion -> ByteStringL -> m ()+ -- | Must return @[]@ for non-existent document+ getDocumentVersions :: Collection a => DocId a -> m [DocVersion] - loadVersionContent :: Collection a => DocId a -> DocVersion -> m ByteStringL+ -- | Must create collection and document if not exist+ saveVersionContent+ :: Collection a => DocId a -> DocVersion -> ByteStringL -> m () - deleteVersion :: Collection a => DocId a -> DocVersion -> m ()+ loadVersionContent :: Collection a => DocId a -> DocVersion -> m ByteStringL - changeDocId :: Collection a => DocId a -> DocId a -> m ()+ deleteVersion :: Collection a => DocId a -> DocVersion -> m () + changeDocId :: Collection a => DocId a -> DocId a -> m ()+ -- | Try decode UUID from a file name decodeDocId- :: DocId a- -> Maybe (Bool, UUID) -- ^ Bool = is document id a valid UUID encoding+ :: DocId a+ -> Maybe (Bool, UUID) -- ^ Bool = is document id a valid UUID encoding decodeDocId (DocId file) = do- uuid <- UUID.decodeBase32 file- pure (UUID.encodeBase32 uuid == file, uuid)+ uuid <- UUID.decodeBase32 file+ pure (UUID.encodeBase32 uuid == file, uuid) -- | Load document version as an object readVersion- :: MonadStorage m- => Collection a => DocId a -> DocVersion -> m (ObjectState a, IsTouched)+ :: MonadStorage m+ => Collection a+ => DocId a+ -> DocVersion+ -> m (ObjectFrame a, IsTouched) readVersion docid version = do- (isObjectIdValid, uuid) <-- liftMaybe ("Bad Base32 UUID " <> show docid) $- decodeDocId docid- unless isObjectIdValid $- throwErrorString $ "Not a Base32 UUID " ++ show docid- contents <- loadVersionContent docid version- case parseStateFrame contents of- Right frame ->- pure (ObjectState{uuid, frame}, IsTouched False)- Left ronError ->- do object <- fallbackParse uuid contents- pure (object, IsTouched True)- `catchError` \fallbackError ->- throwError $ case BSLC.head contents of- '{' -> fallbackError- _ -> fromString ronError+ (isObjectIdValid, uuid) <-+ liftMaybe ("Bad Base32 UUID " <> show docid)+ $ decodeDocId docid+ unless isObjectIdValid+ $ throwErrorString+ $ "Not a Base32 UUID "+ ++ show docid+ contents <- loadVersionContent docid version+ case parseStateFrame contents of+ Right frame ->+ pure (ObjectFrame {uuid, frame}, IsTouched False)+ Left ronError ->+ do+ object <- fallbackParse uuid contents+ pure (object, IsTouched True)+ `catchError` \fallbackError ->+ throwError $ case BSLC.head contents of+ '{' -> fallbackError+ _ -> fromString ronError -- | A thing (e.g. document) was fixed during loading. -- It it was fixed during loading it must be saved to the storage. newtype IsTouched = IsTouched Bool- deriving Show+ deriving (Show) -- | Result of DB reading, loaded document with information about its versions-data Document a = Document- { value :: ObjectState a- -- ^ Merged value.- , versions :: NonEmpty DocVersion- , isTouched :: IsTouched- }- deriving Show+data Document a+ = Document+ { objectFrame :: ObjectFrame a,+ versions :: NonEmpty DocVersion,+ isTouched :: IsTouched+ }+ deriving (Show) -- | Create new version of an object/document. -- If the document doesn't exist yet, it will be created. createVersion- :: forall a m- . (Collection a, MonadStorage m)- => Maybe (DocId a, Document a)- -- ^ 'Just', if document exists already; 'Nothing' otherwise.- -> ObjectState a- -> m ()+ :: forall a m. (Collection a, MonadStorage m)+ => Maybe (DocId a, Document a)+ -- ^ 'Just', if document exists already; 'Nothing' otherwise.+ -> ObjectFrame a+ -> m () createVersion mDoc newObj = case mDoc of- Nothing -> save (DocId @a $ UUID.encodeBase32 uuid) []- Just (docid, oldDoc) -> do- let Document{value = oldObj, versions, isTouched = IsTouched isTouched}- = oldDoc- when (newObj /= oldObj || length versions /= 1 || isTouched) $- save docid $ toList versions+ Nothing -> save (DocId @a $ UUID.encodeBase32 uuid) []+ Just (docid, oldDoc) -> do+ let Document+ { objectFrame = oldObj,+ versions,+ isTouched = IsTouched isTouched+ } =+ oldDoc+ when (newObj /= oldObj || length versions /= 1 || isTouched)+ $ save docid+ $ toList versions where- ObjectState{uuid, frame} = newObj-+ ObjectFrame {uuid, frame} = newObj save docid oldVersions = do- newVersion <- UUID.encodeBase32 <$> getEventUuid- saveVersionContent docid newVersion (serializeStateFrame frame)- for_ oldVersions $ deleteVersion docid+ newVersion <- UUID.encodeBase32 <$> getEventUuid+ saveVersionContent docid newVersion (serializeStateFrame frame)+ for_ oldVersions $ deleteVersion docid
lib/RON/Storage/Test.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}
ron-storage.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: ron-storage-version: 0.8+version: 0.9 bug-reports: https://github.com/ff-notes/ron/issues category: Distributed Systems, Protocol, Database