mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
8c45e317e6
commit
708d9464c7
|
@ -1,5 +1,6 @@
|
||||||
module HBS2.Git.Client.Export (export) where
|
module HBS2.Git.Client.Export (export) where
|
||||||
|
|
||||||
|
|
||||||
import HBS2.Git.Client.Prelude hiding (info)
|
import HBS2.Git.Client.Prelude hiding (info)
|
||||||
import HBS2.Git.Client.App.Types
|
import HBS2.Git.Client.App.Types
|
||||||
import HBS2.Git.Client.Config
|
import HBS2.Git.Client.Config
|
||||||
|
@ -14,6 +15,9 @@ import HBS2.Git.Data.GK
|
||||||
|
|
||||||
import HBS2.Git.Local.CLI
|
import HBS2.Git.Local.CLI
|
||||||
|
|
||||||
|
import HBS2.KeyMan.Keys.Direct
|
||||||
|
|
||||||
|
import HBS2.OrDie
|
||||||
import HBS2.Storage.Operations.ByteString
|
import HBS2.Storage.Operations.ByteString
|
||||||
import HBS2.System.Dir
|
import HBS2.System.Dir
|
||||||
|
|
||||||
|
@ -148,11 +152,7 @@ export :: (GitPerks m, MonadReader GitEnv m, GroupKeyOperations m)
|
||||||
=> LWWRefKey HBS2Basic
|
=> LWWRefKey HBS2Basic
|
||||||
-> [(GitRef,Maybe GitHash)]
|
-> [(GitRef,Maybe GitHash)]
|
||||||
-> m ()
|
-> m ()
|
||||||
export lww refs = do
|
export key refs = do
|
||||||
|
|
||||||
puk <- error "FIXME: puk"
|
|
||||||
|
|
||||||
subscribeRefLog puk
|
|
||||||
|
|
||||||
git <- asks _gitPath
|
git <- asks _gitPath
|
||||||
sto <- asks _storage
|
sto <- asks _storage
|
||||||
|
@ -160,6 +160,14 @@ export lww refs = do
|
||||||
reflog <- asks _refLogAPI
|
reflog <- asks _refLogAPI
|
||||||
ip <- asks _progress
|
ip <- asks _progress
|
||||||
|
|
||||||
|
LWWBlockData{..} <- waitOrInitLWWRef
|
||||||
|
|
||||||
|
debug $ red $ pretty $ AsBase58 lwwRefLogPubKey
|
||||||
|
|
||||||
|
puk <- error $ show $ "FIXME: puk" <+> pretty (AsBase58 lwwRefLogPubKey)
|
||||||
|
|
||||||
|
subscribeRefLog puk
|
||||||
|
|
||||||
myrefs <- refsForExport refs
|
myrefs <- refsForExport refs
|
||||||
|
|
||||||
let myrefsKey = L.sortOn fst myrefs & serialise & hashObject @HbSync & HashRef
|
let myrefsKey = L.sortOn fst myrefs & serialise & hashObject @HbSync & HashRef
|
||||||
|
@ -251,6 +259,30 @@ export lww refs = do
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
||||||
|
findSK pk = liftIO $ runKeymanClient $ runMaybeT do
|
||||||
|
creds <- lift (loadCredentials pk) >>= toMPlus
|
||||||
|
pure (view peerSignSk creds)
|
||||||
|
|
||||||
|
waitOrInitLWWRef = do
|
||||||
|
sto <- asks _storage
|
||||||
|
new <- asks _gitExportType <&> (== ExportNew)
|
||||||
|
|
||||||
|
flip fix 3 $ \next n -> do
|
||||||
|
blk <- readLWWBlock sto key
|
||||||
|
|
||||||
|
case blk of
|
||||||
|
Just x -> pure x
|
||||||
|
|
||||||
|
Nothing | new && n > 0 -> do
|
||||||
|
_ <- runExceptT (initLWWRef sto Nothing findSK key)
|
||||||
|
>>= either ( throwIO . userError . show ) pure
|
||||||
|
|
||||||
|
next (pred n)
|
||||||
|
|
||||||
|
| otherwise -> do
|
||||||
|
-- FIXME: detailed-error-description
|
||||||
|
orThrowUser "lwwref not available" Nothing
|
||||||
|
|
||||||
|
|
||||||
notInTx Nothing _ = pure True
|
notInTx Nothing _ = pure True
|
||||||
notInTx (Just tx0) obj = not <$> isObjectInTx tx0 obj
|
notInTx (Just tx0) obj = not <$> isObjectInTx tx0 obj
|
||||||
|
|
|
@ -71,6 +71,7 @@ readLWWBlock :: forall e s m . ( MonadIO m
|
||||||
, s ~ Encryption e
|
, s ~ Encryption e
|
||||||
, ForLWWRefProto e
|
, ForLWWRefProto e
|
||||||
, IsRefPubKey s
|
, IsRefPubKey s
|
||||||
|
, e ~ L4Proto
|
||||||
)
|
)
|
||||||
=> AnyStorage
|
=> AnyStorage
|
||||||
-> LWWRefKey s
|
-> LWWRefKey s
|
||||||
|
@ -88,13 +89,14 @@ readLWWBlock sto k = runMaybeT do
|
||||||
>>= toMPlus
|
>>= toMPlus
|
||||||
<&> lwwBlockData
|
<&> lwwBlockData
|
||||||
|
|
||||||
initLWWRef :: forall s e m . ( MonadIO m
|
initLWWRef :: forall e s m . ( MonadIO m
|
||||||
, MonadError LWWBlockOpError m
|
, MonadError LWWBlockOpError m
|
||||||
, IsRefPubKey s
|
, IsRefPubKey s
|
||||||
, ForSignedBox e
|
, ForSignedBox e
|
||||||
, HasDerivedKey s 'Sign Word64 m
|
, HasDerivedKey s 'Sign Word64 m
|
||||||
, s ~ Encryption e
|
, s ~ Encryption e
|
||||||
, Signatures s
|
, Signatures s
|
||||||
|
, e ~ L4Proto
|
||||||
)
|
)
|
||||||
=> AnyStorage
|
=> AnyStorage
|
||||||
-> Maybe Word64
|
-> Maybe Word64
|
||||||
|
|
Loading…
Reference in New Issue