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