extra/base58/base58.factor

   1 ! Copyright (C) 2020 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: base64.private byte-arrays checksums checksums.sha
   5 io.binary kernel kernel.private literals math sequences ;
   6
   7 IN: base58
   8
   9 ERROR: malformed-base58 ;
  10
  11 <PRIVATE
  12
  13 <<
  14 CONSTANT: alphabet $[
  15     "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
  16     >byte-array
  17 ]
  18 >>
  19
  20 PRIVATE>
  21
  22 : ch>base58 ( ch -- ch )
  23     alphabet nth ; inline
  24
  25 : base58>ch ( ch -- ch )
  26     $[ alphabet alphabet-inverse ] nth
  27     [ malformed-base58 ] unless* { fixnum } declare ; inline
  28
  29 :: >base58 ( seq -- base58 )
  30     BV{ } clone :> accum
  31     seq [ zero? not ] find [ drop seq length ] unless :> i
  32     seq i tail-slice be>
  33     [ 58 /mod ch>base58 accum push ] until-zero
  34     i alphabet first '[ _ accum push ] times
  35     accum reverse! B{ } like ;
  36
  37 :: base58> ( base58 -- seq )
  38     BV{ } clone :> accum
  39     base58 alphabet first '[ _ = not ] find
  40     [ drop base58 length ] unless :> i
  41     0 base58 [ [ 58 * ] dip base58>ch + ] i each-from
  42     [ 256 /mod accum push ] until-zero
  43     i [ 0 accum push ] times
  44     accum reverse! B{ } like ;
  45
  46 <PRIVATE
  47
  48 : base58-check ( base58 -- base58-check )
  49     2 [ sha-256 checksum-bytes ] times ;
  50
  51 PRIVATE>
  52
  53 : >base58-check ( seq -- base58-check )
  54     dup base58-check 4 head-slice append >base58 ;
  55
  56 : base58-check> ( base58-check -- seq )
  57     base58> 4 cut* [ dup base58-check 4 head-slice ] [ assert-sequence= ] bi* ;