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