From 8846bfdc7e1ed431b074c2b239a3a1b96af5c0cd Mon Sep 17 00:00:00 2001 From: voidlizard Date: Mon, 7 Oct 2024 06:22:35 +0300 Subject: [PATCH] sigil convenience functions --- hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs | 62 ++++++++++++++----- .../lib/HBS2/Net/Auth/Credentials/Sigil.hs | 55 +++++++++++++++- 2 files changed, 100 insertions(+), 17 deletions(-) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs b/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs index 81ca6b46..8201388f 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs +++ b/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs @@ -1,20 +1,24 @@ +{-# OPTIONS_GHC -Wno-name-shadowing #-} module HBS2.CLI.Run.Sigil where import HBS2.CLI.Prelude import HBS2.CLI.Run.Internal +import HBS2.Data.Types.Refs import HBS2.Base58 +import HBS2.Storage import HBS2.Data.Types.SignedBox import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Credentials.Sigil import Data.List qualified as L import Data.ByteString.Char8 qualified as BS8 -import Data.Text qualified as Text +import Data.ByteString.Lazy qualified as LBS import Lens.Micro.Platform -sigilEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m () +sigilEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m, HasStorage m) + => MakeDictM c m () sigilEntries = do entry $ bindMatch "hbs2:sigil:sign-pubkey" $ \case @@ -30,23 +34,53 @@ sigilEntries = do _ -> throwIO $ BadFormException @C nil - entry $ bindMatch "hbs2:sigil:parse" $ \case - [StringLike s] -> do + brief "parses sigil" + $ args [ arg "sigil" "string" ] + $ examples [qc|hbs2:sigil:parse [str:read-file some.sigil]|] + $ entry $ bindMatch "hbs2:sigil:parse" $ \case + [StringLike s] -> do - let bs = BS8.pack s - sigil <- pure (parseSerialisableFromBase58 @(Sigil 'HBS2Basic) bs) - `orDie` "parse sigil failed" + let bs = BS8.pack s + sigil <- pure (parseSerialisableFromBase58 @(Sigil 'HBS2Basic) bs) + `orDie` "parse sigil failed" - (_,sd) <- pure (unboxSignedBox0 @(SigilData 'HBS2Basic) (sigilData sigil)) - `orDie` "signature check failed" + (_,sd) <- pure (unboxSignedBox0 @(SigilData 'HBS2Basic) (sigilData sigil)) + `orDie` "signature check failed" - pure (parseTop $ show $ parens ("sigil" <> line <> indent 2 (vcat $ [pretty sigil, pretty sd]))) - `orDie` "bad sigil" - <&> head + pure (parseTop $ show $ parens ("sigil" <> line <> indent 2 (vcat $ [pretty sigil, pretty sd]))) + `orDie` "bad sigil" + <&> head - _ -> throwIO $ BadFormException @C nil + _ -> throwIO $ BadFormException @C nil - entry $ bindMatch "hbs2:sigil:create-from-keyring" $ \syn -> do + + brief "loads sigil from hbs2 store as base58 string" + $ args [arg "hash" "string" ] + $ returns "sigil" "string" + $ entry $ bindMatch "hbs2:sigil:load:base58" $ \case + [HashLike key] -> lift do + sto <- getStorage + warn $ pretty key + r <- loadSigil @HBS2Basic sto key >>= orThrowUser "no sigil found" + pure $ mkStr @c ( show $ pretty $ AsBase58 r ) + + _ -> throwIO $ BadFormException @c nil + + brief "stores sigil to hbs2 store" + $ args [arg "string" "file" ] + $ returns "string" "hash" + $ entry $ bindMatch "hbs2:sigil:store:file" $ \case + [StringLike fn] -> lift do + sto <- getStorage + lbs <- liftIO (LBS.readFile fn) + sigil <- decodeSigil @HBS2Basic lbs & orThrowUser "invalid sigil file" + href <- storeSigil sto sigil + pure $ mkStr ( show $ pretty href ) + + _ -> throwIO $ BadFormException @c nil + + + entry $ bindMatch "hbs2:sigil:create:from-keyring" $ \syn -> do args <- case syn of [ StringLike s ] -> pure (fmap snd . headMay, s) diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs index d7838f0b..ed90fcbf 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs @@ -6,17 +6,26 @@ import HBS2.Base58 import HBS2.Data.Types.Refs import HBS2.Data.Types.SignedBox import HBS2.Net.Proto.Types -import Data.List.Split (chunksOf) +import HBS2.Storage import HBS2.Net.Auth.Credentials +import HBS2.Data.Detect +import HBS2.Storage.Operations.ByteString import Codec.Serialise -import Crypto.Saltine.Class qualified as Crypto -import Crypto.Saltine.Class (IsEncoding(..)) +import Control.Applicative ((<|>)) import Control.Monad.Identity import Control.Monad.Trans.Maybe +import Control.Monad.Except +import Crypto.Saltine.Class (IsEncoding(..)) +import Crypto.Saltine.Class qualified as Crypto +import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as B8 import Data.ByteString.Lazy.Char8 qualified as LBS +import Data.ByteString.Lazy (ByteString) +import Data.Coerce +import Data.List.Split (chunksOf) import Data.Maybe +import Data.Either import Lens.Micro.Platform @@ -81,6 +90,46 @@ instance ForPrettySigil s => Pretty (Sigil s) where where psk = dquotes (pretty (AsBase58 (sigilSignPk s))) + +storeSigil :: forall s m . (ForSigil s, MonadIO m) + => AnyStorage + -> Sigil s + -> m (Maybe HashRef) +storeSigil sto s = do + putBlock sto (serialise s) <&> fmap HashRef + + +loadSigil :: forall s m . (ForSigil s, MonadIO m) + => AnyStorage + -> HashRef + -> m (Maybe (Sigil s)) +loadSigil sto href = runMaybeT do + + lbs0 <- getBlock sto ha + >>= toMPlus + + case tryDetect (coerce href) lbs0 of + Blob _ -> decodeSigil lbs0 & toMPlus + Merkle{} -> readFromTree + MerkleAnn{} -> readFromTree + + _ -> mzero + + where + ha = coerce href + + readFromTree = do + runExceptT (readFromMerkle sto (SimpleKey ha)) + >>= toMPlus + <&> decodeSigil + >>= toMPlus + +decodeSigil :: forall s . ForSigil s => ByteString -> Maybe (Sigil s) +decodeSigil lbs = do + deserialiseOrFail @(Sigil s) lbs & either (const Nothing) Just + <|> + parseSerialisableFromBase58 @(Sigil s) (LBS.toStrict lbs) + -- Nothing, если ключ отсутствует в Credentials makeSigilFromCredentials :: forall s . ForSigil s => PeerCredentials s