From 773d363eb429c915b6e0ee80b89073b098d8f184 Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Wed, 5 Oct 2022 10:14:09 -0600 Subject: [PATCH 1/4] wip --- bitcoin.cabal | 4 ++-- package.yaml | 2 +- src/Bitcoin/Crypto/Signature.hs | 23 +++++++---------------- stack.yaml | 1 + stack.yaml.lock | 7 +++++++ 5 files changed, 18 insertions(+), 19 deletions(-) diff --git a/bitcoin.cabal b/bitcoin.cabal index 2087ffb9..2fa3eea2 100644 --- a/bitcoin.cabal +++ b/bitcoin.cabal @@ -113,12 +113,12 @@ library , entropy >=0.4.1.5 , hashable >=1.3.0.0 , hspec >=2.7.1 + , libsecp256k1 >=0.1.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 , safe >=0.3.18 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 @@ -171,12 +171,12 @@ test-suite spec , hspec >=2.7.1 , lens >=4.18.1 , lens-aeson >=1.1 + , libsecp256k1 >=0.1.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 , safe >=0.3.18 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 diff --git a/package.yaml b/package.yaml index 769060e9..197db133 100644 --- a/package.yaml +++ b/package.yaml @@ -40,7 +40,7 @@ dependencies: - split >= 0.2.3.3 - safe >= 0.3.18 - scientific >= 0.3.6.2 - - secp256k1-haskell >= 0.4.0 + - libsecp256k1 >= 0.1.0 - string-conversions >= 0.4.0.1 - text >= 1.2.3.0 - time >= 1.9.3 diff --git a/src/Bitcoin/Crypto/Signature.hs b/src/Bitcoin/Crypto/Signature.hs index 8fec1102..97a83d69 100644 --- a/src/Bitcoin/Crypto/Signature.hs +++ b/src/Bitcoin/Crypto/Signature.hs @@ -14,7 +14,6 @@ module Bitcoin.Crypto.Signature ( verifyHashSig, isCanonicalHalfOrder, decodeStrictSig, - exportSig, ) where import Bitcoin.Crypto.Hash @@ -31,28 +30,20 @@ import Data.Serialize (Serialize (..)) import Numeric (showHex) --- | Convert 256-bit hash into a 'Msg' for signing or verification. -hashToMsg :: Hash256 -> Msg -hashToMsg = - fromMaybe e . msg . runPutS . serialize - where - e = error "Could not convert 32-byte hash to secp256k1 message" - - -- | Sign a 256-bit hash using secp256k1 elliptic curve. -signHash :: SecKey -> Hash256 -> Sig -signHash k = signMsg k . hashToMsg +signHash :: SecKey -> Hash256 -> Signature +signHash k = ecdsaSign k . fromShort . getHash256 -- | Verify an ECDSA signature for a 256-bit hash. -verifyHashSig :: Hash256 -> Sig -> PubKey -> Bool +verifyHashSig :: Hash256 -> Signature -> PubKeyXY -> Bool verifyHashSig h s p = verifySig p norm (hashToMsg h) where norm = fromMaybe s (normalizeSig s) -- | Deserialize an ECDSA signature as commonly encoded in Bitcoin. -getSig :: MonadGet m => m Sig +getSig :: MonadGet m => m Signature getSig = do l <- lookAhead $ do @@ -72,17 +63,17 @@ getSig = do -- | Serialize an ECDSA signature for Bitcoin use. -putSig :: MonadPut m => Sig -> m () +putSig :: MonadPut m => Signature -> m () putSig s = putByteString $ exportSig s -- | Is canonical half order. -isCanonicalHalfOrder :: Sig -> Bool +isCanonicalHalfOrder :: Signature -> Bool isCanonicalHalfOrder = isNothing . normalizeSig -- | Decode signature strictly. -decodeStrictSig :: ByteString -> Maybe Sig +decodeStrictSig :: ByteString -> Maybe Signature decodeStrictSig bs = do g <- importSig bs -- diff --git a/stack.yaml b/stack.yaml index 5f3db2d3..2ad925db 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,3 +6,4 @@ nix: - pkg-config extra-deps: - fourmolu-0.8.2.0 + - libsecp256k1-0.1.0 diff --git a/stack.yaml.lock b/stack.yaml.lock index 64fdfd07..d9ce229b 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -11,6 +11,13 @@ packages: size: 143718 original: hackage: fourmolu-0.8.2.0 +- completed: + hackage: libsecp256k1-0.1.0@sha256:c8de65c640e2e36b14947db00366228d550881640f5e61f496aeb2249966039c,1898 + pantry-tree: + size: 901 + sha256: 9713733dbf509b8af64449ea9b4b3d1ee518cb1e7e61c03a8a9297fa29c3b274 + original: + hackage: libsecp256k1-0.1.0 snapshots: - completed: sha256: 1ecad1f0bd2c27de88dbff6572446cfdf647c615d58a7e2e2085c6b7dfc04176 From c0fb08ac46199cebb490f3dd347d6c8d51699fee Mon Sep 17 00:00:00 2001 From: Tochi Obudulu Date: Sun, 27 Nov 2022 14:37:14 +0000 Subject: [PATCH 2/4] Build haskell-bitcoin/libsecp256k1-haskell with haskell-bitcoin/bitcoin --- .gitignore | 1 + bitcoin.cabal | 2 +- src/Bitcoin/Crypto/Signature.hs | 19 +++++++------- src/Bitcoin/Keys/Common.hs | 34 ++++++++++++------------ src/Bitcoin/Keys/Extended.hs | 26 +++++++++--------- src/Bitcoin/Script/SigHash.hs | 3 ++- src/Bitcoin/Transaction/Builder.hs | 4 +-- src/Bitcoin/Transaction/Builder/Sign.hs | 6 ++--- src/Bitcoin/Transaction/Partial.hs | 10 ++++--- src/Bitcoin/Transaction/Taproot.hs | 20 +++++++------- src/Bitcoin/Util/Arbitrary/Keys.hs | 15 +++++++++-- stack.yaml | 3 ++- stack.yaml.lock | 12 ++++++--- test/Bitcoin/Crypto/SignatureSpec.hs | 35 +++++++++++++------------ test/Bitcoin/Keys/ExtendedSpec.hs | 8 +++--- test/Bitcoin/KeysSpec.hs | 10 +++---- test/Bitcoin/ScriptSpec.hs | 2 +- test/Bitcoin/Transaction/PartialSpec.hs | 6 ++--- test/Bitcoin/Transaction/TaprootSpec.hs | 6 ++--- 19 files changed, 123 insertions(+), 99 deletions(-) diff --git a/.gitignore b/.gitignore index fb6f9d11..f81f76f5 100644 --- a/.gitignore +++ b/.gitignore @@ -22,3 +22,4 @@ cabal.project.local~ .ghc.environment.* TAGS tags +.vscode diff --git a/bitcoin.cabal b/bitcoin.cabal index 2fa3eea2..e062aab0 100644 --- a/bitcoin.cabal +++ b/bitcoin.cabal @@ -211,12 +211,12 @@ benchmark benchmark , entropy >=0.4.1.5 , hashable >=1.3.0.0 , hspec >=2.7.1 + , libsecp256k1 >=0.1.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 , safe >=0.3.18 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 diff --git a/src/Bitcoin/Crypto/Signature.hs b/src/Bitcoin/Crypto/Signature.hs index 97a83d69..07c06581 100644 --- a/src/Bitcoin/Crypto/Signature.hs +++ b/src/Bitcoin/Crypto/Signature.hs @@ -22,6 +22,7 @@ import Crypto.Secp256k1 import Data.Binary (Binary (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.ByteString.Short (fromShort) import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial @@ -31,15 +32,15 @@ import Numeric (showHex) -- | Sign a 256-bit hash using secp256k1 elliptic curve. -signHash :: SecKey -> Hash256 -> Signature +signHash :: SecKey -> Hash256 -> Maybe Signature signHash k = ecdsaSign k . fromShort . getHash256 -- | Verify an ECDSA signature for a 256-bit hash. verifyHashSig :: Hash256 -> Signature -> PubKeyXY -> Bool -verifyHashSig h s p = verifySig p norm (hashToMsg h) +verifyHashSig h s p = ecdsaVerify (fromShort $ getHash256 h) p norm where - norm = fromMaybe s (normalizeSig s) + norm = fromMaybe s (normalizeSignature s) -- | Deserialize an ECDSA signature as commonly encoded in Bitcoin. @@ -64,23 +65,23 @@ getSig = do -- | Serialize an ECDSA signature for Bitcoin use. putSig :: MonadPut m => Signature -> m () -putSig s = putByteString $ exportSig s +putSig s = putByteString $ exportSignatureDer s -- | Is canonical half order. isCanonicalHalfOrder :: Signature -> Bool -isCanonicalHalfOrder = isNothing . normalizeSig +isCanonicalHalfOrder = isNothing . normalizeSignature -- | Decode signature strictly. decodeStrictSig :: ByteString -> Maybe Signature decodeStrictSig bs = do - g <- importSig bs + g <- importSignatureDer bs -- -- 4.1.4.1 (r and s can not be zero) - let compact = exportCompactSig g + let compact = exportSignatureCompact g let zero = BS.replicate 32 0 - guard $ BS.take 32 (getCompactSig compact) /= zero - guard $ BS.take 32 (BS.drop 32 (getCompactSig compact)) /= zero + guard $ BS.take 32 compact /= zero + guard $ BS.take 32 (BS.drop 32 compact) /= zero guard $ isCanonicalHalfOrder g return g diff --git a/src/Bitcoin/Keys/Common.hs b/src/Bitcoin/Keys/Common.hs index 5aa9f5e0..d6862e70 100644 --- a/src/Bitcoin/Keys/Common.hs +++ b/src/Bitcoin/Keys/Common.hs @@ -15,16 +15,16 @@ module Bitcoin.Keys.Common ( -- * Public & Private Keys PubKeyI (..), SecKeyI (..), - exportPubKey, - importPubKey, + exportPubKeyXY, + importPubKeyXY, wrapPubKey, derivePubKeyI, wrapSecKey, fromMiniKey, tweakPubKey, tweakSecKey, - getSecKey, - secKey, + exportSecKey, + importSecKey, -- ** Private Key Wallet Import Format (WIF) fromWif, @@ -55,7 +55,7 @@ import GHC.Generics (Generic) -- | Elliptic curve public key type with expected serialized compression flag. data PubKeyI = PubKeyI - { pubKeyPoint :: !PubKey + { pubKeyPoint :: !PubKeyXY , pubKeyCompressed :: !Bool } deriving (Generic, Eq, Show, Read, Hashable, NFData) @@ -84,14 +84,14 @@ instance Serial PubKeyI where c = do bs <- getByteString 33 maybe (fail "Could not decode public key") return $ - PubKeyI <$> importPubKey bs <*> pure True + PubKeyI <$> importPubKeyXY bs <*> pure True u = do bs <- getByteString 65 maybe (fail "Could not decode public key") return $ - PubKeyI <$> importPubKey bs <*> pure False + PubKeyI <$> importPubKeyXY bs <*> pure False - serialize pk = putByteString $ exportPubKey (pubKeyCompressed pk) (pubKeyPoint pk) + serialize pk = putByteString $ exportPubKeyXY (pubKeyCompressed pk) (pubKeyPoint pk) instance Serialize PubKeyI where @@ -105,7 +105,7 @@ instance Binary PubKeyI where -- | Wrap a public key from secp256k1 library adding information about compression. -wrapPubKey :: Bool -> PubKey -> PubKeyI +wrapPubKey :: Bool -> PubKeyXY -> PubKeyI wrapPubKey c p = PubKeyI p c @@ -116,8 +116,8 @@ derivePubKeyI (SecKeyI d c) = PubKeyI (derivePubKey d) c -- | Tweak a public key. -tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey -tweakPubKey p h = tweakAddPubKey p =<< tweak (runPutS (serialize h)) +tweakPubKey :: PubKeyXY -> Hash256 -> Maybe PubKeyXY +tweakPubKey p h = pubKeyTweakAdd p =<< importTweak (runPutS (serialize h)) -- | Elliptic curve private key type with expected public key compression @@ -138,14 +138,14 @@ wrapSecKey c d = SecKeyI d c -- | Tweak a private key. tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey -tweakSecKey key h = tweakAddSecKey key =<< tweak (runPutS (serialize h)) +tweakSecKey key h = secKeyTweakAdd key =<< importTweak (runPutS (serialize h)) -- | Decode Casascius mini private keys (22 or 30 characters). fromMiniKey :: ByteString -> Maybe SecKeyI fromMiniKey bs = do guard checkShortKey - wrapSecKey False <$> secKey (runPutS (serialize (sha256 bs))) + wrapSecKey False <$> importSecKey (runPutS (serialize (sha256 bs))) where checkHash = runPutS $ serialize $ sha256 $ bs `BS.append` "?" checkShortKey = BS.length bs `elem` [22, 30] && BS.head checkHash == 0x00 @@ -159,11 +159,11 @@ fromWif net wif = do guard (BS.head bs == getSecretPrefix net) case BS.length bs of -- Uncompressed format - 33 -> wrapSecKey False <$> secKey (BS.tail bs) + 33 -> wrapSecKey False <$> importSecKey (BS.tail bs) -- Compressed format 34 -> do guard $ BS.last bs == 0x01 - wrapSecKey True <$> secKey (BS.tail $ BS.init bs) + wrapSecKey True <$> importSecKey (BS.tail $ BS.init bs) -- Bad length _ -> Nothing @@ -173,5 +173,5 @@ toWif :: Network -> SecKeyI -> Base58 toWif net (SecKeyI k c) = encodeBase58Check . BS.cons (getSecretPrefix net) $ if c - then getSecKey k `BS.snoc` 0x01 - else getSecKey k + then exportSecKey k `BS.snoc` 0x01 + else exportSecKey k diff --git a/src/Bitcoin/Keys/Extended.hs b/src/Bitcoin/Keys/Extended.hs index 53172dd1..6f0f999d 100644 --- a/src/Bitcoin/Keys/Extended.hs +++ b/src/Bitcoin/Keys/Extended.hs @@ -205,7 +205,7 @@ data XPubKey = XPubKey -- ^ derivation index , xPubChain :: !ChainCode -- ^ chain code - , xPubKey :: !PubKey + , xPubKey :: !PubKeyXY -- ^ public key of this node } deriving (Generic, Eq, Show, Read, NFData, Hashable) @@ -244,7 +244,7 @@ makeXPrvKey bs = XPrvKey 0 (Fingerprint 0) 0 c k where (p, c) = split512 $ hmac512 "Bitcoin seed" bs - k = fromMaybe err (secKey (runPutS (serialize p))) + k = fromMaybe err (importSecKey (runPutS (serialize p))) err = throw $ DerivationException "Invalid seed" @@ -277,7 +277,7 @@ prvSubKey xkey child | otherwise = error "Invalid child derivation index" where pK = xPubKey $ deriveXPubKey xkey - m = B.append (exportPubKey True pK) (runPutS (serialize child)) + m = B.append (exportPubKeyXY True pK) (runPutS (serialize child)) (a, c) = split512 $ hmac512 (runPutS $ serialize $ xPrvChain xkey) m k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a err = throw $ DerivationException "Invalid prvSubKey derivation" @@ -297,7 +297,7 @@ pubSubKey xKey child XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK | otherwise = error "Invalid child derivation index" where - m = B.append (exportPubKey True (xPubKey xKey)) (runPutS $ serialize child) + m = B.append (exportPubKeyXY True (xPubKey xKey)) (runPutS $ serialize child) (a, c) = split512 $ hmac512 (runPutS $ serialize $ xPubChain xKey) m pK = fromMaybe err $ tweakPubKey (xPubKey xKey) a err = throw $ DerivationException "Invalid pubSubKey derivation" @@ -359,7 +359,7 @@ xPrvID = xPubID . deriveXPubKey -- | Computes the key identifier of an extended public key. xPubID :: XPubKey -> Hash160 -xPubID = ripemd160 . runPutS . serialize . sha256 . exportPubKey True . xPubKey +xPubID = ripemd160 . runPutS . serialize . sha256 . exportPubKeyXY True . xPubKey -- | Computes the key fingerprint of an extended private key. @@ -477,7 +477,7 @@ hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex -- | Derive a standard address from an extended public key and an index. -deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey) +deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY) deriveAddr k i = (xPubAddr key, xPubKey key) where @@ -485,7 +485,7 @@ deriveAddr k i = -- | Derive a SegWit P2WPKH address from an extended public key and an index. -deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey) +deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY) deriveWitnessAddr k i = (xPubWitnessAddr key, xPubKey key) where @@ -494,7 +494,7 @@ deriveWitnessAddr k i = -- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended -- public key and an index. -deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey) +deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY) deriveCompatWitnessAddr k i = (xPubCompatWitnessAddr key, xPubKey key) where @@ -503,7 +503,7 @@ deriveCompatWitnessAddr k i = -- | Cyclic list of all addresses derived from a public key starting from an -- offset index. -deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] +deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] deriveAddrs k = map f . cycleIndex where @@ -512,7 +512,7 @@ deriveAddrs k = -- | Cyclic list of all SegWit P2WPKH addresses derived from a public key -- starting from an offset index. -deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] +deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] deriveWitnessAddrs k = map f . cycleIndex where @@ -521,7 +521,7 @@ deriveWitnessAddrs k = -- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses -- derived from a public key starting from an offset index. -deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] +deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] deriveCompatWitnessAddrs k = map f . cycleIndex where @@ -1026,14 +1026,14 @@ applyPath path key = {- Helpers for derivation paths and addresses -} -- | Derive an address from a given parent path. -derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey) +derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKeyXY) derivePathAddr key path = deriveAddr (derivePubPath path key) -- | Cyclic list of all addresses derived from a given parent path and starting -- from the given offset index. derivePathAddrs :: - XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)] + XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] derivePathAddrs key path = deriveAddrs (derivePubPath path key) diff --git a/src/Bitcoin/Script/SigHash.hs b/src/Bitcoin/Script/SigHash.hs index fb672175..3fa2f081 100644 --- a/src/Bitcoin/Script/SigHash.hs +++ b/src/Bitcoin/Script/SigHash.hs @@ -44,6 +44,7 @@ import Data.Bytes.Serial import Data.Hashable import Data.Maybe import Data.Scientific +import qualified Data.Text as T import Data.Word import GHC.Generics (Generic) @@ -276,7 +277,7 @@ txSigHashSegwitV0 _ tx out v i sh = -- transaction inputs are of type 'TxSignature'. data TxSignature = TxSignature - { txSignature :: !Sig + { txSignature :: !Signature , txSignatureSigHash :: !SigHash } | TxSignatureEmpty diff --git a/src/Bitcoin/Transaction/Builder.hs b/src/Bitcoin/Transaction/Builder.hs index 353161d0..362747e4 100644 --- a/src/Bitcoin/Transaction/Builder.hs +++ b/src/Bitcoin/Transaction/Builder.hs @@ -311,7 +311,7 @@ countMulSig :: Script -> Word64 -> Int -> - [PubKey] -> + [PubKeyXY] -> [TxSignature] -> Int countMulSig net tx out val i = @@ -320,7 +320,7 @@ countMulSig net tx out val i = h = txSigHash net tx out val i -countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int +countMulSig' :: (SigHash -> Hash256) -> [PubKeyXY] -> [TxSignature] -> Int countMulSig' _ [] _ = 0 countMulSig' _ _ [] = 0 countMulSig' h (_ : pubs) (TxSignatureEmpty : sigs) = countMulSig' h pubs sigs diff --git a/src/Bitcoin/Transaction/Builder/Sign.hs b/src/Bitcoin/Transaction/Builder/Sign.hs index ea885017..d1cf425e 100644 --- a/src/Bitcoin/Transaction/Builder/Sign.hs +++ b/src/Bitcoin/Transaction/Builder/Sign.hs @@ -108,7 +108,7 @@ signInput :: SecKeyI -> Either String Tx signInput net tx i (sigIn@(SigInput so val _ _ rdmM), nest) key = do - let sig = makeSignature net tx i sigIn key + sig <- maybe (Left "cannot sign input") return $ makeSignature net tx i sigIn key si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key w <- updatedWitnessData tx i so si return @@ -246,9 +246,9 @@ parseExistingSigs net tx so i = insSigs <> witSigs -- | Produce a structured representation of a deterministic (RFC-6979) signature over an input. -makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature +makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Maybe TxSignature makeSignature net tx i (SigInput so val _ sh rdmM) key = - TxSignature (signHash (secKeyData key) m) sh + TxSignature <$> signHash (secKeyData key) m <*> pure sh where m = makeSigHash net tx i so val sh rdmM diff --git a/src/Bitcoin/Transaction/Partial.hs b/src/Bitcoin/Transaction/Partial.hs index 1c438564..9ab985d6 100644 --- a/src/Bitcoin/Transaction/Partial.hs +++ b/src/Bitcoin/Transaction/Partial.hs @@ -358,10 +358,14 @@ onPrevTxOut net signer tx ix input prevTxData = { partialSigs = newSigs <> partialSigs input } where - newSigs = HM.mapWithKey sigForInput sigKeys + newSigs = HM.foldMapWithKey sigForInput sigKeys sigForInput thePubKey theSecKey = - encodeTxSig . makeSignature net tx ix theSigInput $ - SecKeyI theSecKey (pubKeyCompressed thePubKey) + maybe + mempty + (HM.singleton thePubKey . encodeTxSig) + ( makeSignature net tx ix theSigInput $ + SecKeyI theSecKey (pubKeyCompressed thePubKey) + ) theSigInput = SigInput diff --git a/src/Bitcoin/Transaction/Taproot.hs b/src/Bitcoin/Transaction/Taproot.hs index 594d1bae..21c9b25b 100644 --- a/src/Bitcoin/Transaction/Taproot.hs +++ b/src/Bitcoin/Transaction/Taproot.hs @@ -25,7 +25,7 @@ module Bitcoin.Transaction.Taproot ( verifyScriptPathData, ) where -import Bitcoin.Crypto (PubKey, initTaggedHash, tweak, tweakAddPubKey) +import Bitcoin.Crypto (PubKeyXY, importTweak, initTaggedHash, pubKeyTweakAdd) import Bitcoin.Keys.Common (PubKeyI (PubKeyI), pubKeyPoint) import Bitcoin.Script.Common (Script) import Bitcoin.Script.Standard (ScriptOutput (PayWitness)) @@ -60,7 +60,7 @@ import Data.Word (Word8) -- | An x-only pubkey corresponds to the keys @(x,y)@ and @(x, -y)@. The --equality test only checks the x-coordinate. An x-only pubkey serializes to 32 --bytes. -newtype XOnlyPubKey = XOnlyPubKey {xOnlyPubKey :: PubKey} +newtype XOnlyPubKey = XOnlyPubKey {xOnlyPubKey :: PubKeyXY} deriving (Show) @@ -154,21 +154,21 @@ leafHash leafVersion leafScript = -- | Representation of a full taproot output. data TaprootOutput = TaprootOutput - { taprootInternalKey :: PubKey + { taprootInternalKey :: PubKeyXY , taprootMAST :: Maybe MAST } deriving (Show) -taprootOutputKey :: TaprootOutput -> PubKey +taprootOutputKey :: TaprootOutput -> PubKeyXY taprootOutputKey TaprootOutput{taprootInternalKey, taprootMAST} = - fromMaybe keyFail $ tweak commitment >>= tweakAddPubKey taprootInternalKey + fromMaybe keyFail $ importTweak commitment >>= pubKeyTweakAdd taprootInternalKey where commitment = taprootCommitment taprootInternalKey $ mastCommitment <$> taprootMAST keyFail = error "bitcoin taprootOutputKey: key derivation failed" -taprootCommitment :: PubKey -> Maybe (Digest SHA256) -> ByteString +taprootCommitment :: PubKeyXY -> Maybe (Digest SHA256) -> ByteString taprootCommitment internalKey merkleRoot = BA.convert . hashFinalize @@ -199,7 +199,7 @@ data ScriptPathData = ScriptPathData , scriptPathExternalIsOdd :: Bool , scriptPathLeafVersion :: Word8 -- ^ This value is masked by 0xFE - , scriptPathInternalKey :: PubKey + , scriptPathInternalKey :: PubKeyXY , scriptPathControl :: [ByteString] } deriving (Eq, Show) @@ -258,11 +258,11 @@ encodeTaprootWitness = \case -- | Verify that the script path spend is valid, except for script execution. verifyScriptPathData :: -- | Output key - PubKey -> + PubKeyXY -> ScriptPathData -> Bool verifyScriptPathData outputKey scriptPathData = fromMaybe False $ do - tweak commitment >>= fmap onComputedKey . tweakAddPubKey (scriptPathInternalKey scriptPathData) + importTweak commitment >>= fmap onComputedKey . pubKeyTweakAdd (scriptPathInternalKey scriptPathData) where onComputedKey computedKey = XOnlyPubKey outputKey == XOnlyPubKey computedKey @@ -276,7 +276,7 @@ verifyScriptPathData outputKey scriptPathData = fromMaybe False $ do expectedParity = bool 0 1 $ scriptPathExternalIsOdd scriptPathData -keyParity :: PubKey -> Word8 +keyParity :: PubKeyXY -> Word8 keyParity key = case BS.unpack . runPutS . serialize $ PubKeyI key True of 0x02 : _ -> 0x00 _ -> 0x01 diff --git a/src/Bitcoin/Util/Arbitrary/Keys.hs b/src/Bitcoin/Util/Arbitrary/Keys.hs index d1aa8848..d40c48e0 100644 --- a/src/Bitcoin/Util/Arbitrary/Keys.hs +++ b/src/Bitcoin/Util/Arbitrary/Keys.hs @@ -8,9 +8,12 @@ import Bitcoin.Keys.Common import Bitcoin.Keys.Extended import Bitcoin.Keys.Extended.Internal (Fingerprint (..)) import Bitcoin.Util.Arbitrary.Crypto +import Control.Monad (replicateM) import Data.Bits (clearBit) +import qualified Data.ByteString as BS import Data.Coerce (coerce) import Data.List (foldl') +import Data.Maybe (fromJust, isJust) import Data.Word (Word32) import Test.QuickCheck @@ -92,9 +95,17 @@ arbitraryParsedPath = -- | Arbitrary message hash, private key, nonce and corresponding signature. The -- signature is generated with a random message, random private key and a random -- nonce. -arbitrarySignature :: Gen (Hash256, SecKey, Sig) +arbitrarySignature :: Gen (Hash256, SecKey, Signature) arbitrarySignature = do m <- arbitraryHash256 key <- arbitrary - let sig = signHash key m + let Just sig = signHash key m return (m, key, sig) + + +instance Arbitrary SecKey where + arbitrary = gen_key + where + valid_bs = bs_gen `suchThat` isJust + bs_gen = importSecKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom + gen_key = fromJust <$> valid_bs diff --git a/stack.yaml b/stack.yaml index 2ad925db..848a8915 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,4 +6,5 @@ nix: - pkg-config extra-deps: - fourmolu-0.8.2.0 - - libsecp256k1-0.1.0 + - github: tochicool/libsecp256k1-haskell + commit: 2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef diff --git a/stack.yaml.lock b/stack.yaml.lock index d9ce229b..4a3baacf 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -12,12 +12,16 @@ packages: original: hackage: fourmolu-0.8.2.0 - completed: - hackage: libsecp256k1-0.1.0@sha256:c8de65c640e2e36b14947db00366228d550881640f5e61f496aeb2249966039c,1898 + name: libsecp256k1 pantry-tree: - size: 901 - sha256: 9713733dbf509b8af64449ea9b4b3d1ee518cb1e7e61c03a8a9297fa29c3b274 + sha256: 24162195ea5461190b4ea63c015b798d8a281c31fb7e5d57e390b4086873bee2 + size: 1259 + sha256: 52a1f9e8c82db503ba7c0f2482193d44822e888b11b8a6f6575865c8e895c792 + size: 30251 + url: https://github.com/tochicool/libsecp256k1-haskell/archive/2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef.tar.gz + version: 0.1.0 original: - hackage: libsecp256k1-0.1.0 + url: https://github.com/tochicool/libsecp256k1-haskell/archive/2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef.tar.gz snapshots: - completed: sha256: 1ecad1f0bd2c27de88dbff6572446cfdf647c615d58a7e2e2085c6b7dfc04176 diff --git a/test/Bitcoin/Crypto/SignatureSpec.hs b/test/Bitcoin/Crypto/SignatureSpec.hs index 9b33ef96..803609fc 100644 --- a/test/Bitcoin/Crypto/SignatureSpec.hs +++ b/test/Bitcoin/Crypto/SignatureSpec.hs @@ -39,12 +39,12 @@ spec = do prop "encoded signature is canonical" $ forAll arbitrarySignature $ testIsCanonical . lst3 - prop "decodeStrictSig . exportSig identity" $ + prop "decodeStrictSig . exportSignatureDer identity" $ forAll arbitrarySignature $ - (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 - prop "importSig . exportSig identity" $ + (\s -> decodeStrictSig (exportSignatureDer s) == Just s) . lst3 + prop "importSignature . exportSignatureDer identity" $ forAll arbitrarySignature $ - (\s -> importSig (exportSig s) == Just s) . lst3 + (\s -> importSignature (exportSignatureDer s) == Just s) . lst3 prop "getSig . putSig identity" $ forAll arbitrarySignature $ (\s -> runGet getSig (runPut $ putSig s) == Right s) . lst3 @@ -65,7 +65,7 @@ spec = do -- github.com/bitcoin/bitcoin/blob/master/src/script.cpp -- from function IsCanonicalSignature -testIsCanonical :: Sig -> Bool +testIsCanonical :: Signature -> Bool testIsCanonical sig = not $ -- Non-canonical signature: too short @@ -116,7 +116,7 @@ testIsCanonical sig = && not (testBit (BS.index s (fromIntegral rlen + 7)) 7) ) where - s = exportSig sig + s = exportSignatureDer sig len = fromIntegral $ BS.length s rlen = BS.index s 3 slen = BS.index s (fromIntegral rlen + 5) @@ -125,7 +125,7 @@ testIsCanonical sig = -- RFC6979 note: Different libraries of libsecp256k1 use different constants -- to produce a nonce. Thus, their deterministric signatures will be different. -- We still want to test against fixed signatures so we need a way to switch --- between implementations. We check the output of signMsg 1 0 +-- between implementations. We check the output of ecdsaSign 1 0 data ValidImpl = ImplCore @@ -135,10 +135,11 @@ data ValidImpl implSig :: Text implSig = encodeHex $ - exportSig $ - signMsg - "0000000000000000000000000000000000000000000000000000000000000001" - "0000000000000000000000000000000000000000000000000000000000000000" + exportSignatureDer $ + fromJust $ + ecdsaSign + "0000000000000000000000000000000000000000000000000000000000000001" + (BS.replicate 32 0) -- We have test vectors for these cases @@ -183,18 +184,18 @@ checkDistSig go = -- github.com/trezor/python-ecdsa/blob/master/ecdsa/test_pyecdsa.py toVector :: (Text, Text, Text) -> (SecKey, ByteString, Text) -toVector (prv, m, res) = (fromJust $ (secKey <=< decodeHex) prv, cs m, res) +toVector (prv, m, res) = (fromJust $ (importSecKey <=< decodeHex) prv, cs m, res) testRFC6979Vector :: (SecKey, ByteString, Text) -> Assertion testRFC6979Vector (prv, m, res) = do - assertEqual "RFC 6979 Vector" res (encodeHex $ encode $ exportCompactSig s) + assertEqual "RFC 6979 Vector" res (encodeHex $ exportSignatureCompact s) assertBool "Signature is valid" $ verifyHashSig h s (derivePubKey prv) assertBool "Signature is canonical" $ testIsCanonical s assertBool "Signature is normalized" $ isCanonicalHalfOrder s where h = sha256 m - s = signHash prv h + s = fromJust $ signHash prv h -- Test vectors from: @@ -202,13 +203,13 @@ testRFC6979Vector (prv, m, res) = do testRFC6979DERVector :: (SecKey, ByteString, Text) -> Assertion testRFC6979DERVector (prv, m, res) = do - assertEqual "RFC 6979 DER Vector" res (encodeHex $ exportSig s) + assertEqual "RFC 6979 DER Vector" res (encodeHex $ exportSignatureDer s) assertBool "DER Signature is valid" $ verifyHashSig h s (derivePubKey prv) assertBool "DER Signature is canonical" $ testIsCanonical s assertBool "DER Signature is normalized" $ isCanonicalHalfOrder s where h = sha256 m - s = signHash prv h + s = fromJust $ signHash prv h -- Reproduce the P2WPKH example from BIP 143 @@ -457,7 +458,7 @@ testBip143p2shp2wpkhMulsig = secHexKey :: Text -> Maybe SecKey -secHexKey = decodeHex >=> secKey +secHexKey = decodeHex >=> importSecKey toPubKey :: SecKey -> PubKeyI diff --git a/test/Bitcoin/Keys/ExtendedSpec.hs b/test/Bitcoin/Keys/ExtendedSpec.hs index f8254327..b606f48b 100644 --- a/test/Bitcoin/Keys/ExtendedSpec.hs +++ b/test/Bitcoin/Keys/ExtendedSpec.hs @@ -399,10 +399,10 @@ runVector m v = do assertBool "bip44Addr" $ addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m) == Just (v !! 3) - assertBool "prvKey" $ encodeHex (getSecKey $ xPrvKey m) == v !! 4 + assertBool "prvKey" $ encodeHex (exportSecKey $ xPrvKey m) == v !! 4 assertBool "xPrvWIF" $ xPrvWif btc m == v !! 5 assertBool "pubKey" $ - encodeHex (exportPubKey True $ xPubKey $ deriveXPubKey m) == v !! 6 + encodeHex (exportPubKeyXY True $ xPubKey $ deriveXPubKey m) == v !! 6 assertBool "chain code" $ encodeHex (runPutS . serialize $ xPrvChain m) == v !! 7 assertBool "Hex PubKey" $ encodeHex (runPutS $ putXPubKey btc $ deriveXPubKey m) == v !! 8 @@ -422,9 +422,9 @@ genVector m = , fromJust $ addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m) ) - , ("prvKey", encodeHex (getSecKey $ xPrvKey m)) + , ("prvKey", encodeHex (exportSecKey $ xPrvKey m)) , ("xPrvWIF", xPrvWif btc m) - , ("pubKey", encodeHex (exportPubKey True $ xPubKey $ deriveXPubKey m)) + , ("pubKey", encodeHex (exportPubKeyXY True $ xPubKey $ deriveXPubKey m)) , ("chain code", encodeHex (runPutS . serialize $ xPrvChain m)) , ("Hex PubKey", encodeHex (runPutS $ putXPubKey btc $ deriveXPubKey m)) , ("Hex PrvKey", encodeHex (runPutS (putXPrvKey btc m))) diff --git a/test/Bitcoin/KeysSpec.hs b/test/Bitcoin/KeysSpec.hs index b01a1b20..92d61b4b 100644 --- a/test/Bitcoin/KeysSpec.hs +++ b/test/Bitcoin/KeysSpec.hs @@ -68,7 +68,7 @@ spec = do describe "Bitcoin core vectors /src/test/key_tests.cpp" $ do it "Passes WIF decoding tests" testPrivkey it "Passes SecKey compression tests" testPrvKeyCompressed - it "Passes PubKey compression tests" testKeyCompressed + it "Passes PubKeyXY compression tests" testKeyCompressed it "Passes address matching tests" testMatchingAddress it "Passes signature verification" testSigs it "Passes deterministic signing tests" testDetSigning @@ -221,10 +221,10 @@ sigMsg = testSignature :: Hash256 -> Assertion testSignature h = do - let sign1 = signHash (secKeyData sec1) h - sign2 = signHash (secKeyData sec2) h - sign1C = signHash (secKeyData sec1C) h - sign2C = signHash (secKeyData sec2C) h + let sign1 = fromJust $ signHash (secKeyData sec1) h + sign2 = fromJust $ signHash (secKeyData sec2) h + sign1C = fromJust $ signHash (secKeyData sec1C) h + sign2C = fromJust $ signHash (secKeyData sec2C) h assertBool "Key 1, Sign1" $ verifyHashSig h sign1 (pubKeyPoint pub1) assertBool "Key 1, Sign2" $ not $ verifyHashSig h sign2 (pubKeyPoint pub1) assertBool "Key 1, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1) diff --git a/test/Bitcoin/ScriptSpec.hs b/test/Bitcoin/ScriptSpec.hs index 85cb4252..59a08fb4 100644 --- a/test/Bitcoin/ScriptSpec.hs +++ b/test/Bitcoin/ScriptSpec.hs @@ -111,7 +111,7 @@ standardSpec net = do derivePubKeyI $ wrapSecKey True $ fromJust $ - secKey $ + importSecKey $ B.replicate 32 1 decodeInput net (Script [OP_0, opPushData $ runPutS $ serialize pk]) `shouldBe` Right (RegularInput (SpendPKHash TxSignatureEmpty pk)) diff --git a/test/Bitcoin/Transaction/PartialSpec.hs b/test/Bitcoin/Transaction/PartialSpec.hs index f189e49f..c2c567eb 100644 --- a/test/Bitcoin/Transaction/PartialSpec.hs +++ b/test/Bitcoin/Transaction/PartialSpec.hs @@ -290,7 +290,7 @@ psbtSignerTest = do where signer = secKeySigner theSecKey <> xPrvSigner xprv (Just origin) - Just theSecKey = secKey "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + Just theSecKey = importSecKey "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" thePubKey = PubKeyI{pubKeyPoint = derivePubKey theSecKey, pubKeyCompressed = True} rootXPrv = makeXPrvKey "psbtSignerTest" @@ -401,7 +401,7 @@ unfinalizedPkhPSBT net (prvKey, pubKey) = , scriptOutput = runPutS (serialize prevOutScript) } h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll - sig = encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll + sig = encodeTxSig $ TxSignature (fromJust $ signHash (secKeyData prvKey) h) sigHashAll arbitraryMultiSig :: Gen ([(SecKeyI, PubKeyI)], Int) @@ -429,7 +429,7 @@ unfinalizedMsPSBT net (keys, m) = prevOut = TxOut{outValue = 200000000, scriptOutput = encodeOutputBS (toP2SH prevOutScript)} h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll sigs = fromList $ map sig keys - sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll) + sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (fromJust $ signHash (secKeyData prvKey) h) sigHashAll) unfinalizedTx :: TxHash -> Tx diff --git a/test/Bitcoin/Transaction/TaprootSpec.hs b/test/Bitcoin/Transaction/TaprootSpec.hs index 03ff256d..ed2b5f22 100644 --- a/test/Bitcoin/Transaction/TaprootSpec.hs +++ b/test/Bitcoin/Transaction/TaprootSpec.hs @@ -6,8 +6,8 @@ module Bitcoin.Transaction.TaprootSpec (spec) where import Bitcoin ( MAST (..), - PubKey, PubKeyI (PubKeyI), + PubKeyXY, ScriptOutput, ScriptPathData (..), TaprootOutput (TaprootOutput), @@ -112,7 +112,7 @@ testControlBlocks testData = do checkVerification = assertBool "Script verifies" . verifyScriptPathData theOutputKey -keyParity :: PubKey -> Word8 +keyParity :: PubKeyXY -> Word8 keyParity key = case BS.unpack . runPutS . serialize $ PubKeyI key True of 0x02 : _ -> 0x00 _ -> 0x01 @@ -153,7 +153,7 @@ instance FromJSON SpkGiven where data SpkIntermediary = SpkIntermediary { spkiLeafHashes :: Maybe [ByteString] , spkiMerkleRoot :: Maybe ByteString - , spkiTweakedPubKey :: PubKey + , spkiTweakedPubKey :: PubKeyXY } From 2d244efcd526a7b3d93207f4ca0b13cf4453be5b Mon Sep 17 00:00:00 2001 From: Tochi Obudulu Date: Sun, 27 Nov 2022 15:15:22 +0000 Subject: [PATCH 3/4] Compile optional schnorrsig and recovery modules --- .github/workflows/build.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml index fe789956..7daf757d 100644 --- a/.github/workflows/build.yaml +++ b/.github/workflows/build.yaml @@ -54,7 +54,7 @@ jobs: name: Checkout bitcoin-core/secp256k1 with: repository: bitcoin-core/secp256k1 - ref: 694ce8fb2d1fd8a3d641d7c33705691d41a2a860 + ref: 751c4354d51fb5b10a80764df627b84e1a5ccd4f path: lib/secp256k1 - uses: haskell/actions/setup@f7b0997283589ea5a6b4f2ade6a239d70a412877 @@ -83,7 +83,7 @@ jobs: working-directory: ./lib/secp256k1 run: | ./autogen.sh - ./configure + ./configure --enable-module-schnorrsig --enable-module-recovery make make check sudo make install @@ -97,7 +97,7 @@ jobs: pacman --noconfirm -S mingw-w64-x86_64-pkg-config pacman --noconfirm -S mingw-w64-x86_64-autotools ./autogen.sh - ./configure --prefix=/mingw64 + ./configure --prefix=/mingw64 --enable-module-schnorrsig --enable-module-recovery make make check make install From 140922f95c127a130f2d3c02802831e1d69a71f7 Mon Sep 17 00:00:00 2001 From: Tochi Obudulu Date: Mon, 28 Nov 2022 23:10:20 +0000 Subject: [PATCH 4/4] Bump `libsecp256k1-haskell` --- src/Bitcoin/Crypto/Signature.hs | 5 ++--- stack.yaml | 2 +- stack.yaml.lock | 10 +++++----- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Bitcoin/Crypto/Signature.hs b/src/Bitcoin/Crypto/Signature.hs index 96882130..15d435ec 100644 --- a/src/Bitcoin/Crypto/Signature.hs +++ b/src/Bitcoin/Crypto/Signature.hs @@ -35,7 +35,6 @@ import Data.Binary.Put (Put, putByteString) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Short (fromShort) -import Data.Maybe (fromMaybe, isNothing) import Numeric (showHex) @@ -48,7 +47,7 @@ signHash k = ecdsaSign k . fromShort . getHash256 verifyHashSig :: Hash256 -> Signature -> PubKeyXY -> Bool verifyHashSig h s p = ecdsaVerify (fromShort $ getHash256 h) p norm where - norm = fromMaybe s (normalizeSignature s) + norm = snd $ normalizeSignature s -- | Deserialize an ECDSA signature as commonly encoded in Bitcoin. @@ -78,7 +77,7 @@ putSig s = putByteString $ exportSignatureDer s -- | Is canonical half order. isCanonicalHalfOrder :: Signature -> Bool -isCanonicalHalfOrder = isNothing . normalizeSignature +isCanonicalHalfOrder = not . fst . normalizeSignature -- | Decode signature strictly. diff --git a/stack.yaml b/stack.yaml index bf35e4c1..c2174168 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,4 +8,4 @@ extra-deps: - fourmolu-0.8.2.0 - cryptonite-0.30 - github: tochicool/libsecp256k1-haskell - commit: 2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef + commit: 3a23ec0d8616bd3cc45e3b5764f604c4bed2e144 diff --git a/stack.yaml.lock b/stack.yaml.lock index 88c7700b..b5c35096 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -21,14 +21,14 @@ packages: - completed: name: libsecp256k1 pantry-tree: - sha256: 24162195ea5461190b4ea63c015b798d8a281c31fb7e5d57e390b4086873bee2 + sha256: e81e2a02eb41c57005a7bfeacbd54b29f8395667ddb912c2c9fae377f4791efa size: 1259 - sha256: 52a1f9e8c82db503ba7c0f2482193d44822e888b11b8a6f6575865c8e895c792 - size: 30251 - url: https://github.com/tochicool/libsecp256k1-haskell/archive/2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef.tar.gz + sha256: 853107597d46f48b7ebb010bae145147db624ddd149f96fdcb23a0aafc59f47e + size: 30221 + url: https://github.com/tochicool/libsecp256k1-haskell/archive/3a23ec0d8616bd3cc45e3b5764f604c4bed2e144.tar.gz version: 0.1.0 original: - url: https://github.com/tochicool/libsecp256k1-haskell/archive/2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef.tar.gz + url: https://github.com/tochicool/libsecp256k1-haskell/archive/3a23ec0d8616bd3cc45e3b5764f604c4bed2e144.tar.gz snapshots: - completed: sha256: 1ecad1f0bd2c27de88dbff6572446cfdf647c615d58a7e2e2085c6b7dfc04176