sigil convenience functions

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)

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