bip39

BIP39 mnemonic codes in Haskell (docs.ppad.tech/bip39).
git clone git://git.ppad.tech/bip39.git
Log | Files | Refs | README | LICENSE

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