diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,9 @@ # Changelog +- 0.3.0 (2025-06-21) + * The 'mnemonic' and 'seed' function families are now total, returning + 'Nothing' when supplied with bad inputs. + - 0.2.1 (2025-03-02) * Various documentation improvements. diff --git a/lib/Crypto/KDF/BIP39.hs b/lib/Crypto/KDF/BIP39.hs --- a/lib/Crypto/KDF/BIP39.hs +++ b/lib/Crypto/KDF/BIP39.hs @@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | --- Module: Crypto.HDKey.BIP39 +-- Module: Crypto.KDF.BIP39 -- Copyright: (c) 2025 Jared Tobin -- License: MIT -- Maintainer: Jared Tobin @@ -40,6 +40,7 @@ , spanish ) where +import Control.Monad (guard) import qualified Crypto.KDF.PBKDF as PBKDF import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA512 as SHA512 @@ -69,43 +70,40 @@ -- wordlist. -- -- The entropy must be at least 128 bits long and at most 256 bits --- long. Providing invalid entropy will result in an 'ErrorCall' --- exception. +-- long. Providing invalid entropy will result in a 'Nothing' value. -- -- >>> import qualified System.Entropy as E -- >>> trop <- E.getEntropy 16 -- >>> mnemonic trop --- "coral maze mimic half fat breeze thought club give brass bone snake" +-- Just "coral maze mimic half fat breeze thought club give brass bone snake" mnemonic :: BS.ByteString -- ^ 128-256 bits of entropy - -> T.Text + -> Maybe T.Text mnemonic = _mnemonic english -- | Generate a BIP39 mnemonic from some entropy, using the provided -- wordlist. -- -- The entropy must be at least 128 bits long and at most 256 bits --- long. Providing invalid entropy will result in an 'ErrorCall' --- exception. +-- long. Providing invalid entropy will result in a value of +-- 'Nothing'. -- -- >>> import qualified System.Entropy as E -- >>> trop <- E.getEntropy 16 -- >>> _mnemonic czech trop --- "naslepo lysina dikobraz slupka beseda rorejs ostraha kobliha napevno blahobyt kazivost jiskra" +-- Just "naslepo lysina dikobraz slupka beseda rorejs ostraha kobliha napevno blahobyt kazivost jiskra" _mnemonic :: Wordlist -> BS.ByteString -- ^ 128-256 bits of entropy - -> T.Text -_mnemonic (Wordlist wlist) entropy@(BI.PS _ _ l) - | l < 16 = error "ppad-bip39 (mnemonic): invalid entropy length" - | l > 32 = error "ppad-bip39 (mnemonic): invalid entropy length" - | otherwise = - let has = SHA256.hash entropy - h = BU.unsafeHead has - n = l `quot` 4 - kek = h .&. (0b1111_1111 .<<. (8 - n)) -- top n bits - cat = entropy <> BS.singleton kek - in T.intercalate " " (words wlist cat) + -> Maybe T.Text +_mnemonic (Wordlist wlist) entropy@(BI.PS _ _ l) = do + guard (l >= 16 && l <= 32) + let has = SHA256.hash entropy + h = BU.unsafeHead has + n = l `quot` 4 + kek = h .&. (0b1111_1111 .<<. (8 - n)) -- top n bits + cat = entropy <> BS.singleton kek + pure $! T.intercalate " " (words wlist cat) {-# INLINE _mnemonic #-} -- remaining, bits pool, number of bits in pool @@ -121,7 +119,7 @@ nacc = acc .&. ((1 .<<. (len - 11)) - 1) -- adjust pool nlen = len - 11 -- track less bits word = PA.indexArray wlist w11 - in Just (word, (etc, nacc, nlen)) + in pure (word, (etc, nacc, nlen)) | not (BS.null etc) = let next = BU.unsafeHead etc rest = BU.unsafeTail etc @@ -142,36 +140,33 @@ -- >>> let mnem = "coral maze mimic half fat breeze thought club give brass bone snake" -- >> let pass = "hunter2" -- >>> seed mnem pass --- <512-bit long seed> +-- Just <512-bit long seed> seed :: T.Text -- ^ mnemonic -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) - -> BS.ByteString -- ^ seed + -> Maybe BS.ByteString -- ^ seed seed = _seed english -- | Derive a master seed from a provided mnemonic and passphrase, where the -- mnemonic has been generated from an arbitrary wordlist. -- -- The provided mnemonic is checked for validity using '_valid'. --- Providing an invalid mnemonic will result in an 'ErrorCall' --- exception. +-- Providing an invalid mnemonic will result in a 'Nothing' value. -- -- >>> let mnem = "coral maze mimic half fat breeze thought club give brass bone snake" -- >> let pass = "hunter2" -- >>> _seed english mnem pass --- <512-bit long seed> +-- Just <512-bit long seed> _seed - :: Wordlist -- ^ wordlist - -> T.Text -- ^ mnemonic - -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) - -> BS.ByteString -- ^ seed -_seed wlist mnem pass - | not (_valid wlist mnem) = - error "ppad-bip39 (seed): invalid mnemonic" - | otherwise = - let salt = TE.encodeUtf8 ("mnemonic" <> ICU.nfkd pass) - norm = TE.encodeUtf8 (ICU.nfkd mnem) - in PBKDF.derive SHA512.hmac norm salt 2048 64 where + :: Wordlist -- ^ wordlist + -> T.Text -- ^ mnemonic + -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) + -> Maybe BS.ByteString -- ^ seed +_seed wlist mnem pass = do + guard (_valid wlist mnem) + let salt = TE.encodeUtf8 ("mnemonic" <> ICU.nfkd pass) + norm = TE.encodeUtf8 (ICU.nfkd mnem) + PBKDF.derive SHA512.hmac norm salt 2048 64 {-# INLINE _seed #-} -- | Derive a master seed from a provided mnemonic and passphrase. @@ -182,18 +177,16 @@ -- >>> let mnem = "coral maze mimic half fat breeze thought club give brass bone snake" -- >> let pass = "hunter2" -- >>> seed_unsafe mnem pass --- <512-bit long seed> +-- Just <512-bit long seed> seed_unsafe :: T.Text -- ^ mnemonic -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) - -> BS.ByteString -- ^ seed -seed_unsafe mnem pass - | length (T.words mnem) `notElem` [12, 15, 18, 21, 24] = - error "ppad-bip39 (seed_unsafe): invalid mnemonic" - | otherwise = - let salt = TE.encodeUtf8 ("mnemonic" <> ICU.nfkd pass) - norm = TE.encodeUtf8 (ICU.nfkd mnem) - in PBKDF.derive SHA512.hmac norm salt 2048 64 where + -> Maybe BS.ByteString -- ^ seed +seed_unsafe mnem pass = do + guard (length (T.words mnem) `elem` [12, 15, 18, 21, 24]) + let salt = TE.encodeUtf8 ("mnemonic" <> ICU.nfkd pass) + norm = TE.encodeUtf8 (ICU.nfkd mnem) + PBKDF.derive SHA512.hmac norm salt 2048 64 -- | Validate a mnemonic against the default English wordlist. -- diff --git a/ppad-bip39.cabal b/ppad-bip39.cabal --- a/ppad-bip39.cabal +++ b/ppad-bip39.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-bip39 -version: 0.2.1 +version: 0.3.0 synopsis: BIP39 mnemonic codes. license: MIT license-file: LICENSE @@ -40,7 +40,7 @@ build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13 - , ppad-pbkdf >= 0.1 && < 0.2 + , ppad-pbkdf >= 0.2 && < 0.3 , ppad-sha256 >= 0.2.3 && < 0.3 , ppad-sha512 >= 0.1.3 && < 0.2 , primitive >= 0.8 && < 0.10 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -75,12 +76,10 @@ mnem = bt_mnemonic seed = bt_seed xprv = bt_xprv - out_mnem = BIP39._mnemonic wl entr - giv_seed = seed_fn mnem "TREZOR" - out_seed = seed_fn out_mnem "TREZOR" - out_xprv = case BIP32.master out_seed of - Just hd -> BIP32.xprv hd - Nothing -> error "bang (bip32)" + Just out_mnem = BIP39._mnemonic wl entr + Just giv_seed = seed_fn mnem "TREZOR" + Just out_seed = seed_fn out_mnem "TREZOR" + Just out_xprv = BIP32.master out_seed >>= BIP32.xprv t_msg = mempty testGroup t_msg [ -- we always output (NFKD) normalized UTF8, but test inputs may not be @@ -115,12 +114,10 @@ pass = jp_passphrase seed = jp_seed xprv = jp_xprv - out_mnem = BIP39._mnemonic BIP39.japanese entr - giv_seed = BIP39.seed_unsafe mnem pass - out_seed = BIP39.seed_unsafe out_mnem pass - out_xprv = case BIP32.master out_seed of - Just hd -> BIP32.xprv hd - Nothing -> error "bang (bip32, jp)" + Just out_mnem = BIP39._mnemonic BIP39.japanese entr + Just giv_seed = BIP39.seed_unsafe mnem pass + Just out_seed = BIP39.seed_unsafe out_mnem pass + Just out_xprv = BIP32.master out_seed >>= BIP32.xprv testGroup mempty [ testCase "mnemonic" $ assertEqual mempty (ICU.nfkd mnem) out_mnem , testCase "seed (from given mnemonic)" $ assertEqual mempty seed giv_seed