diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2019-11-09 21:28:12 +0100 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2019-11-09 21:28:12 +0100 |
| commit | 9c31e863dd9dd5fc60ecae79b5d0fc8d09024fad (patch) | |
| tree | b6e8c7cbf079da0f498fca0a17e9290e4dbb9e19 /src/Storage.hs | |
| parent | 2169f1030cded87e6ab38b4ae8293e7f147b5e96 (diff) | |
Storage: do not export unsafe storeObject
Diffstat (limited to 'src/Storage.hs')
| -rw-r--r-- | src/Storage.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/src/Storage.hs b/src/Storage.hs index d29056f..ec5da48 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -170,7 +170,7 @@ copyRef' st ref'@(Ref _ dgst) = refFromDigest st dgst >>= \case Just ref -> retu Nothing -> doCopy where doCopy = do mbobj' <- ioLoadObject ref' mbobj <- sequence $ copyObject' st <$> mbobj' - sequence $ storeObject st <$> join mbobj + sequence $ unsafeStoreObject st <$> join mbobj copyObject' :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => Storage' c' -> Object' c -> IO (c (Object' c')) copyObject' _ (Blob bs) = return $ return $ Blob bs @@ -227,11 +227,14 @@ serializeObject = \case in BL.fromChunks [BC.pack "rec ", BC.pack (show $ BL.length cnt), BC.singleton '\n'] `BL.append` cnt ZeroObject -> BL.empty -storeObject :: Storage' c -> Object' c -> IO (Ref' c) -storeObject storage = \case +unsafeStoreObject :: Storage' c -> Object' c -> IO (Ref' c) +unsafeStoreObject storage = \case ZeroObject -> return $ zeroRef storage obj -> unsafeStoreRawBytes storage $ serializeObject obj +storeObject :: PartialStorage -> PartialObject -> IO PartialRef +storeObject = unsafeStoreObject + storeRawBytes :: PartialStorage -> BL.ByteString -> IO PartialRef storeRawBytes = unsafeStoreRawBytes @@ -417,7 +420,7 @@ class Storable a where load' :: Load a store :: StorageCompleteness c => Storage' c -> a -> IO (Ref' c) - store st = storeObject st <=< evalStore st . store' + store st = unsafeStoreObject st <=< evalStore st . store' load :: Ref -> a load ref = let Load f = load' in either (error {- TODO throw -} . ((BC.unpack (showRef ref) ++ ": ")++)) id $ f ref $ lazyLoadObject ref @@ -450,7 +453,7 @@ instance Storable Object where load' = Load $ const return - store st = storeObject st <=< copyObject st + store st = unsafeStoreObject st <=< copyObject st load = lazyLoadObject instance Storable ByteString where |