diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs b/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs index 5ec3954e..bb7fee11 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs @@ -79,37 +79,55 @@ sigilEntries = do _ -> throwIO $ BadFormException @c nil - entry $ bindMatch "hbs2:sigil:create:from-keyring" $ \syn -> do + brief "create sigil from keyring" $ + desc [qc| - args <- case syn of - [ StringLike s ] -> pure (fmap snd . headMay, s) - [ StringLike p, StringLike s ] -> pure ( findKey p, s) - [ LitIntVal n, StringLike s ] -> pure ( L.lookup n, s) +;; creates from keyring, uses first encryption key if found - _ -> throwIO $ BadFormException @C nil +hbs2:sigil:create:from-keyring KEYRING-FILE - let lbs = BS8.pack (snd args) +;; creates from keyring, uses n-th encryption key if found, N starts from 1 - cred <- pure (parseCredentials @'HBS2Basic (AsCredFile lbs)) - `orDie` "bad keyring data" +hbs2:sigil:create:from-keyring KEYRING-FILE N - let es = zip [0..] - [ p | KeyringEntry p _ _ - <- view peerKeyring cred - ] +;; creates from keyring, uses encryption key wit prefix S if found - enc <- pure (fst args es) - `orDie` "key not found" +hbs2:sigil:create:from-keyring KEYRING-FILE S - sigil <- pure (makeSigilFromCredentials @'HBS2Basic cred enc Nothing Nothing) - `orDie` "can't create a sigil" + |] + $ entry $ bindMatch "hbs2:sigil:create:from-keyring" $ \syn -> do - pure $ mkStr (show $ pretty $ AsBase58 sigil) + let readKeyring fn = liftIO (BS8.readFile fn) <&> parseCredentials @'HBS2Basic . AsCredFile - where - findKey s xs = headMay [ k - | e@(_,k) <- xs - , L.isPrefixOf s (show $ pretty (AsBase58 k)) - ] + (cred, KeyringEntry enc _ _) <- case syn of + [ StringLike fn ] -> do + s <- readKeyring fn >>= orThrowUser "malformed keyring file" + kr <- headMay (view peerKeyring s) & orThrowUser "encryption key missed" + pure (s,kr) + [ StringLike fn, LitIntVal n ] -> do + + s <- readKeyring fn >>= orThrowUser "malformed keyring file" + kr <- headMay (drop (fromIntegral (max 0 (n-1))) (view peerKeyring s)) + & orThrowUser "encryption key not found" + pure (s,kr) + + [ StringLike fn, StringLike p ] -> do + + s <- readKeyring fn >>= orThrowUser "malformed keyring file" + kr <- findKey p (view peerKeyring s) & orThrowUser "encryption key not found" + pure (s,kr) + + _ -> throwIO $ BadFormException @c nil + + sigil <- pure (makeSigilFromCredentials @'HBS2Basic cred enc Nothing Nothing) + `orDie` "can't create a sigil" + + pure $ mkStr (show $ pretty $ AsBase58 sigil) + + where + findKey s xs = headMay [ e + | e@(KeyringEntry k _ _) <- xs + , L.isPrefixOf s (show $ pretty (AsBase58 k)) + ] diff --git a/hbs2-peer/app/MailboxProtoWorker.hs b/hbs2-peer/app/MailboxProtoWorker.hs index f6b1ad09..4ad57f9f 100644 --- a/hbs2-peer/app/MailboxProtoWorker.hs +++ b/hbs2-peer/app/MailboxProtoWorker.hs @@ -261,12 +261,19 @@ instance ( s ~ Encryption e, e ~ L4Proto pure $ Right r - mailboxAcceptStatus me@MailboxProtoWorker{..} ref who MailBoxStatusPayload{..} = do + mailboxAcceptStatus me@MailboxProtoWorker{..} ref who s2@MailBoxStatusPayload{..} = do -- TODO: implement-policy-first -- итак, мы не можем двигаться, пока не будет реализована policy. + flip runContT pure $ callCC \stop -> do + s0 <- runMaybeT do + MailBoxStatusPayload{..} <- mailboxGetStatus me ref + >>= toMPlus + >>= toMPlus + toMPlus mbsMailboxHash + now <- liftIO $ getPOSIXTime <&> round mdbe <- readTVarIO mailboxDB @@ -283,17 +290,18 @@ instance ( s ~ Encryption e, e ~ L4Proto <+> "from" <+> pretty (AsBase58 who) - let downloadStatus v = do maybe1 mbsMailboxHash (okay ()) $ \h -> do - startDownloadStuff me h - -- one download per version per hash - let downKey = HashRef $ hashObject (serialise (v,h)) - atomically $ modifyTVar inMailboxDownloadQ (HM.insert downKey (MailboxDownload ref h now v False)) + when (s0 /= Just h) do + startDownloadStuff me h + -- one download per version per hash + let downKey = HashRef $ hashObject (serialise (v,h)) + atomically $ modifyTVar inMailboxDownloadQ (HM.insert downKey (MailboxDownload ref h now v False)) okay () case mbsMailboxPolicy of Nothing -> downloadStatus Nothing + Just newPolicy -> do -- TODO: handle-invalid-policy-error @@ -775,4 +783,11 @@ instance ForMailbox s => FromField (MailboxRefKey s) where instance FromField MailboxType where fromField w = fromField @String w <&> fromString @MailboxType +-- TODO: test-multiple-recipients + +-- TODO: implement-basic-policy + +-- TODO: test-basic-policy + + diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs index c5d4e49d..695ac2b2 100644 --- a/hbs2-peer/app/PeerTypes.hs +++ b/hbs2-peer/app/PeerTypes.hs @@ -312,9 +312,6 @@ addDownload :: forall e m . ( DownloadConstr e m addDownload mbh h = do - -- FIXME: remove-shit - debug $ "addDownload" <+> pretty h - tinq <- asks (view blockInQ) checkQ <- asks (view blockCheckQ) dirty <- asks (view blockInDirty)