diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/lib/RON/Storage.hs b/lib/RON/Storage.hs --- a/lib/RON/Storage.hs +++ b/lib/RON/Storage.hs @@ -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 diff --git a/lib/RON/Storage/Backend.hs b/lib/RON/Storage/Backend.hs --- a/lib/RON/Storage/Backend.hs +++ b/lib/RON/Storage/Backend.hs @@ -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 diff --git a/lib/RON/Storage/Test.hs b/lib/RON/Storage/Test.hs --- a/lib/RON/Storage/Test.hs +++ b/lib/RON/Storage/Test.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} diff --git a/ron-storage.cabal b/ron-storage.cabal --- a/ron-storage.cabal +++ b/ron-storage.cabal @@ -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