BIP39.hs (11950B)
1 {-# LANGUAGE BinaryLiterals #-} 2 {-# LANGUAGE NumericUnderscores #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 -- | 6 -- Module: Crypto.KDF.BIP39 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- [BIP39](https://github.com/bitcoin/bips/blob/master/bip-0039.mediawiki) 12 -- mnemonic codes for deterministic key generation, supporting wordlists in 13 -- multiple languages. 14 15 module Crypto.KDF.BIP39 ( 16 -- * Mnemonic construction and validation 17 mnemonic 18 , _mnemonic 19 , valid 20 , _valid 21 22 -- * Seed derivation 23 , seed 24 , _seed 25 , seed_unsafe 26 27 -- * Wordlists 28 -- 29 -- $wordlists 30 , Wordlist(..) 31 , english 32 , chinese_traditional 33 , chinese_simplified 34 , czech 35 , french 36 , korean 37 , italian 38 , japanese 39 , portuguese 40 , spanish 41 ) where 42 43 import Control.Monad (guard) 44 import qualified Crypto.KDF.PBKDF as PBKDF 45 import qualified Crypto.Hash.SHA256 as SHA256 46 import qualified Crypto.Hash.SHA512 as SHA512 47 import Data.Bits ((.&.), (.|.), (.>>.), (.<<.)) 48 import qualified Data.ByteString as BS 49 import qualified Data.ByteString.Internal as BI 50 import qualified Data.ByteString.Unsafe as BU 51 import qualified Data.Foldable as F 52 import qualified Data.Maybe as M 53 import qualified Data.Primitive.Array as PA 54 import Data.Word (Word64) 55 import qualified Data.List as L 56 import Prelude hiding (words) 57 import qualified Data.Text as T 58 import qualified Data.Text.Encoding as TE 59 import qualified Data.Text.ICU.Normalize2 as ICU 60 import System.IO.Unsafe (unsafePerformIO) 61 62 fi :: (Integral a, Num b) => a -> b 63 fi = fromIntegral 64 {-# INLINE fi #-} 65 66 hmac_sha512 :: BS.ByteString -> BS.ByteString -> BS.ByteString 67 hmac_sha512 k b = case SHA512.hmac k b of 68 SHA512.MAC mac -> mac 69 {-# INLINE hmac_sha512 #-} 70 71 -- | A BIP39 wordlist. 72 newtype Wordlist = Wordlist (PA.Array T.Text) 73 74 -- | Generate a BIP39 mnemonic from some entropy, using the default English 75 -- wordlist. 76 -- 77 -- The entropy must be at least 128 bits long and at most 256 bits 78 -- long. Providing invalid entropy will result in a 'Nothing' value. 79 -- 80 -- >>> import qualified System.Entropy as E 81 -- >>> trop <- E.getEntropy 16 82 -- >>> mnemonic trop 83 -- Just "coral maze mimic half fat breeze thought club give brass bone snake" 84 mnemonic 85 :: BS.ByteString -- ^ 128-256 bits of entropy 86 -> Maybe T.Text 87 mnemonic = _mnemonic english 88 89 -- | Generate a BIP39 mnemonic from some entropy, using the provided 90 -- wordlist. 91 -- 92 -- The entropy must be at least 128 bits long and at most 256 bits 93 -- long. Providing invalid entropy will result in a value of 94 -- 'Nothing'. 95 -- 96 -- >>> import qualified System.Entropy as E 97 -- >>> trop <- E.getEntropy 16 98 -- >>> _mnemonic czech trop 99 -- Just "naslepo lysina dikobraz slupka beseda rorejs ostraha kobliha napevno blahobyt kazivost jiskra" 100 _mnemonic 101 :: Wordlist 102 -> BS.ByteString -- ^ 128-256 bits of entropy 103 -> Maybe T.Text 104 _mnemonic (Wordlist wlist) entropy@(BI.PS _ _ l) = do 105 guard (l >= 16 && l <= 32) 106 let has = SHA256.hash entropy 107 h = BU.unsafeHead has 108 n = l `quot` 4 109 kek = h .&. (0b1111_1111 .<<. (8 - n)) -- top n bits 110 cat = entropy <> BS.singleton kek 111 pure $! T.intercalate " " (words wlist cat) 112 {-# INLINE _mnemonic #-} 113 114 -- remaining, bits pool, number of bits in pool 115 type Acc = (BS.ByteString, Word64, Int) 116 117 words :: PA.Array T.Text -> BS.ByteString -> [T.Text] 118 words wlist bs = L.unfoldr coalg (bs, 0, 0) where 119 mask = 0b0111_1111_1111 120 coalg :: Acc -> Maybe (T.Text, Acc) 121 coalg (etc, acc, len) 122 | len > 10 = 123 let w11 = fi ((acc .>>. (len - 11)) .&. mask) -- take bits from pool 124 nacc = acc .&. ((1 .<<. (len - 11)) - 1) -- adjust pool 125 nlen = len - 11 -- track less bits 126 word = PA.indexArray wlist w11 127 in pure (word, (etc, nacc, nlen)) 128 | not (BS.null etc) = 129 let next = BU.unsafeHead etc 130 rest = BU.unsafeTail etc 131 nacc = (acc .<<. 8) .|. fi next -- add bits to pool 132 nlen = len + 8 -- track additional bits 133 in coalg (rest, nacc, nlen) 134 | otherwise = 135 Nothing 136 {-# INLINE words #-} 137 138 -- | Derive a master seed from a provided mnemonic and passphrase, where the 139 -- mnemonic has been generated from the default English wordlist. 140 -- 141 -- The mnemonic's length and words are validated. If you want to 142 -- validate the mnemonic's words against a non-English wordlist, use 143 -- '_seed'. 144 -- 145 -- >>> let mnem = "coral maze mimic half fat breeze thought club give brass bone snake" 146 -- >> let pass = "hunter2" 147 -- >>> seed mnem pass 148 -- Just <512-bit long seed> 149 seed 150 :: T.Text -- ^ mnemonic 151 -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) 152 -> Maybe BS.ByteString -- ^ seed 153 seed = _seed english 154 155 -- | Derive a master seed from a provided mnemonic and passphrase, where the 156 -- mnemonic has been generated from an arbitrary wordlist. 157 -- 158 -- The provided mnemonic is checked for validity using '_valid'. 159 -- Providing an invalid mnemonic will result in a 'Nothing' value. 160 -- 161 -- >>> let mnem = "coral maze mimic half fat breeze thought club give brass bone snake" 162 -- >> let pass = "hunter2" 163 -- >>> _seed english mnem pass 164 -- Just <512-bit long seed> 165 _seed 166 :: Wordlist -- ^ wordlist 167 -> T.Text -- ^ mnemonic 168 -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) 169 -> Maybe BS.ByteString -- ^ seed 170 _seed wlist mnem pass = do 171 guard (_valid wlist mnem) 172 let salt = TE.encodeUtf8 ("mnemonic" <> ICU.nfkd pass) 173 norm = TE.encodeUtf8 (ICU.nfkd mnem) 174 PBKDF.derive hmac_sha512 norm salt 2048 64 175 {-# INLINE _seed #-} 176 177 -- | Derive a master seed from a provided mnemonic and passphrase. 178 -- 179 -- The mnemonic's length is validated, but its individual words are 180 -- /not/. This function thus works for every wordlist. 181 -- 182 -- >>> let mnem = "coral maze mimic half fat breeze thought club give brass bone snake" 183 -- >> let pass = "hunter2" 184 -- >>> seed_unsafe mnem pass 185 -- Just <512-bit long seed> 186 seed_unsafe 187 :: T.Text -- ^ mnemonic 188 -> T.Text -- ^ passphrase (use e.g. "" or 'mempty' if not required) 189 -> Maybe BS.ByteString -- ^ seed 190 seed_unsafe mnem pass = do 191 guard (length (T.words mnem) `elem` [12, 15, 18, 21, 24]) 192 let salt = TE.encodeUtf8 ("mnemonic" <> ICU.nfkd pass) 193 norm = TE.encodeUtf8 (ICU.nfkd mnem) 194 PBKDF.derive hmac_sha512 norm salt 2048 64 195 196 -- | Validate a mnemonic against the default English wordlist. 197 -- 198 -- Verifies that the mnemonic has a valid length, and that every word 199 -- is contained in the wordlist. 200 -- 201 -- >>> valid "coral maze mimic half fat breeze thought club give brass bone snake" 202 -- True 203 -- >>> valid "coral maze mimic half fat breeze thought club give brass bone" 204 -- False 205 valid 206 :: T.Text -- ^ mnemonic 207 -> Bool -- ^ 'True' if valid 208 valid mnem = 209 length ws `elem` [12, 15, 18, 21, 24] 210 && all M.isJust (fmap (\word -> F.find (== word) wlist) ws) 211 where 212 ws = T.words mnem 213 Wordlist wlist = english 214 215 -- | Validate a mnemonic against a wordlist. 216 -- 217 -- Verifies that the mnemonic has a valid length, and that every word 218 -- is contained in the provided wordlist. 219 -- 220 -- >>> let mnem = "持 樓 粗 殺 承 圖 湧 整 拿 路 式 棋" 221 -- >>> _valid chinese_traditional mnem 222 -- True 223 -- >>> _valid chinese_simplified mnem 224 -- False 225 _valid 226 :: Wordlist 227 -> T.Text -- ^ mnemonic 228 -> Bool -- ^ 'True' if valid 229 _valid (Wordlist wlist) mnem = 230 length ws `elem` [12, 15, 18, 21, 24] 231 && all M.isJust (fmap (\word -> F.find (== word) wlist) ws) 232 where 233 ws = T.words mnem 234 235 -- wordlists ------------------------------------------------------------------ 236 237 -- $wordlists 238 -- 239 -- Wordlists for various languages. 240 -- 241 -- For the following examples: 242 -- 243 -- >>> import qualified Data.Text.IO as TIO 244 -- >>> let trop = "0123456789abcdef" 245 246 -- | The default English wordlist. 247 -- 248 -- >>> TIO.putStrLn $ _mnemonic english trop 249 -- coral maze mimic half fat breeze thought club give brass bone snake 250 english :: Wordlist 251 english = unsafePerformIO $ do 252 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/english.txt") 253 let ls = T.lines wlist 254 pure (Wordlist (PA.arrayFromList ls)) 255 {-# NOINLINE english #-} 256 257 -- | The default Traditional Chinese wordlist. 258 -- 259 -- >>> TIO.putStrLn $ _mnemonic chinese_traditional trop 260 -- 持 樓 粗 殺 承 圖 湧 整 拿 路 式 棋 261 chinese_traditional :: Wordlist 262 chinese_traditional = unsafePerformIO $ do 263 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/chinese_traditional.txt") 264 let ls = T.lines wlist 265 pure (Wordlist (PA.arrayFromList ls)) 266 {-# NOINLINE chinese_traditional #-} 267 268 -- | The default Simplified Chinese wordlist. 269 -- 270 -- >>> TIO.putStrLn $ _mnemonic chinese_simplified trop 271 -- 持 楼 粗 杀 承 图 涌 整 拿 路 式 棋 272 chinese_simplified :: Wordlist 273 chinese_simplified = unsafePerformIO $ do 274 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/chinese_simplified.txt") 275 let ls = T.lines wlist 276 pure (Wordlist (PA.arrayFromList ls)) 277 {-# NOINLINE chinese_simplified #-} 278 279 -- | The default Korean wordlist. 280 -- 281 -- >>> TIO.putStrLn $ _mnemonic korean trop 282 -- 대문 어쩐지 여덟 설거지 볶음 그늘 태권도 단맛 상반기 균형 국왕 진출 283 korean :: Wordlist 284 korean = unsafePerformIO $ do 285 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/korean.txt") 286 let ls = T.lines wlist 287 pure (Wordlist (PA.arrayFromList ls)) 288 {-# NOINLINE korean #-} 289 290 -- | The default French wordlist. 291 -- 292 -- >>> TIO.putStrLn $ _mnemonic french trop 293 -- chlorure kimono légume flamme endroit bénéfice soulever céleste falaise belette banlieue reprise 294 french :: Wordlist 295 french = unsafePerformIO $ do 296 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/french.txt") 297 let ls = T.lines wlist 298 pure (Wordlist (PA.arrayFromList ls)) 299 {-# NOINLINE french #-} 300 301 -- | The default Spanish wordlist. 302 -- 303 -- >>> TIO.putStrLn $ _mnemonic spanish trop 304 -- charla marido mente guía explicar banco tapa casco gemelo balcón ayuda ropa 305 spanish :: Wordlist 306 spanish = unsafePerformIO $ do 307 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/spanish.txt") 308 let ls = T.lines wlist 309 pure (Wordlist (PA.arrayFromList ls)) 310 {-# NOINLINE spanish #-} 311 312 -- | The default Czech wordlist. 313 -- 314 -- >>> TIO.putStrLn $ _mnemonic czech trop 315 -- hadr omladina oslepit metr krajina deflace varovat flirt lovec dechovka cudnost svitek 316 czech :: Wordlist 317 czech = unsafePerformIO $ do 318 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/czech.txt") 319 let ls = T.lines wlist 320 pure (Wordlist (PA.arrayFromList ls)) 321 {-# NOINLINE czech #-} 322 323 -- | The default Italian wordlist. 324 -- 325 -- >>> TIO.putStrLn $ _mnemonic italian trop 326 -- conferma nevrotico obbligo indole florido benigno svista cigno grotta belva barbaro sfocato 327 italian :: Wordlist 328 italian = unsafePerformIO $ do 329 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/italian.txt") 330 let ls = T.lines wlist 331 pure (Wordlist (PA.arrayFromList ls)) 332 {-# NOINLINE italian #-} 333 334 -- | The default Portuguese wordlist. 335 -- 336 -- >>> TIO.putStrLn $ _mnemonic portuguese trop 337 -- capacho juba lareira figurado ejetar avaliar sonhador cachorro exposto autismo aterro refinar 338 portuguese :: Wordlist 339 portuguese = unsafePerformIO $ do 340 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/portuguese.txt") 341 let ls = T.lines wlist 342 pure (Wordlist (PA.arrayFromList ls)) 343 {-# NOINLINE portuguese #-} 344 345 -- | The default Japanese wordlist. 346 -- 347 -- >>> TIO.putStrLn $ _mnemonic japanese trop 348 -- きおん たさい たまご しゃおん こふん えきたい ますく がはく しかい えおり うろこ ひとごみ 349 japanese :: Wordlist 350 japanese = unsafePerformIO $ do 351 wlist <- fmap TE.decodeUtf8 (BS.readFile "etc/japanese.txt") 352 let ls = T.lines wlist 353 pure (Wordlist (PA.arrayFromList ls)) 354 {-# NOINLINE japanese #-} 355