ton/crypto/fift/lib/TonUtil.fif

library TonUtil // TON Blockchain Fift Library
"Lists.fif" include

-1 constant Masterchain
0 constant Basechain

// parse workchain id
// ( S -- workchain )
{ (number) 1- abort"workchain id must be an integer"
  dup 32 fits not abort"workchain id must fit in 32 bits"
} : parse-workchain-id

{ (number) 1- abort"integer expected" } : parse-int

{ over null? ' swap if drop } : replace-if-null

// Private key load/generate
// ( fname -- pubkey privkey )
{ dup ."Loading private key from file " type cr 
  file>B dup Blen 32 <> abort"Private key must be exactly 32 bytes long"
  dup priv>pub swap 
} : load-keypair
// ( fname -- pubkey privkey )
{ dup file-exists?
  { load-keypair }
  { dup newkeypair swap rot over swap B>file
    rot ."Saved new private key to file " type cr 
  } cond
} : load-generate-keypair

// Parse smart-contract address
// ( S -- workchain addr bounce? )
{ $>smca not abort"invalid smart-contract address"
  1 and 0= 
} : parse-smc-addr

// ( x -- ) Displays a 64-digit hex number
{ 64 0x. } : 64x.
{ 64 0X. } : 64X.
// ( wc addr -- )  Show address in <workchain>:<account> form
{ swap ._ .":" 64x. } : .addr
// ( wc addr flags -- )  Show address in base64url form
{ smca>$ type } : .Addr
// ( wc addr fname -- )  Save address to file in 36-byte format
{ -rot 256 u>B swap 32 i>B B+ swap B>file } : save-address
// ( wc addr fname -- )  Save address and print message
{ dup ."(Saving address to file " type .")" cr save-address
} : save-address-verbose

// ( fname -- wc addr )  Load address from file
{ file>B 32 B| 
  dup Blen { 32 B>i@ } { drop Basechain } cond
  swap 256 B>u@
} : load-address
// ( fname -- wc addr )  Load address from file and print message
{ dup ."(Loading address from file " type .")" cr load-address
} : load-address-verbose
// Parse string as address or load address from file (if string is prefixed by @)
// ( S default-bounce -- workchain addr bounce? )
{ over $len 0= abort"empty smart-contract address"
  swap dup 1 $| swap "@" $=
  { nip load-address rot } { drop nip parse-smc-addr } cond
} : parse-load-address

// ( hex-str -- addr )  Parses ADNL address
{ dup $len 64 <> abort"ADNL address must consist of exactly 64 hexadecimal characters"
  (hex-number) 1 <> abort"ADNL address must consist of 64 hexadecimal characters"
  dup 256 ufits not abort"invalid ADNL address"
} : parse-adnl-address

// ( b wc addr -- b' )  Serializes address into Builder b
{ -rot 8 i, swap 256 u, } : addr, 
{ over 8 fits { rot b{100} s, -rot addr, } {
  rot b{110} s, 256 9 u, rot 32 i, swap 256 u, } cond
} : Addr,

// Gram utilities
1000000000 constant Gram
{ Gram swap */r } : Gram*/
{ Gram * } : Gram*
{ (number) dup { 1- ' Gram*/ ' Gram* cond true } if
} : $>GR?
// ( S -- nanograms )
{ $>GR? not abort"not a valid Gram amount"
} : $>GR
{ bl word $>GR 1 'nop } ::_ GR$
// ( nanograms -- S )
{ dup abs <# ' # 9 times char . hold #s rot sign #>
nip -trailing0 } : (.GR)
{ (.GR) ."GR$" type } : .GR_
{ .GR_ space } : .GR

// b x -- b'  ( serializes a Gram amount )
{ -1 { 1+ 2dup 8 * ufits } until
  rot over 4 u, -rot 8 * u, } : Gram,
// s -- x s'  ( deserializes a Gram amount )
{ 4 u@+ swap 8 * u@+ } : Gram@+
// s -- x
{ 4 u@+ swap 8 * u@ } : Gram@

// currency collections
// b x --> b'  ( serializes a VarUInteger32 )
{ -1 { 1+ 2dup 8 * ufits } until
  rot over 5 u, -rot 8 * u, } : VarUInt32,
// s --> x  ( deserializes a VarUInteger32 )
{ 5 u@+ swap 8 * u@ } : VarUInt32@
32 constant cc-key-bits
' VarUInt32, : val,
' VarUInt32@ : val@
// d k v -- d'
{ <b swap val, b> <s swap rot cc-key-bits idict!+ not abort"cannot add key-value to CurrencyCollection"
} : +newccpair
{ dup { -rot tuck swap cc-key-bits idict@- { val@ 2swap -rot + } { swap rot } cond +newccpair
  } { 2drop } cond
} : +ccpair
dictnew constant cc0   // zero currency collection
// ( v k -- d )  Creates currency collection representing v units of currency k
{ cc0 swap rot +ccpair } : of-cc
{ dictnew { over null? not } { swap uncons -rot unpair +ccpair } while nip } : list>cc
{ dup null? { ."(null)" drop } { val@ ._ } cond } dup : .maybeVarUInt32 : .val
{ swap cc-key-bits { rot { ."+" } if .val ."*$" ._ true true } idictforeach drop } : (.cc)
{ false (.cc) { ."0" } ifnot } : .cc_
{ .cc_ space } : .cc
{ true (.cc) drop } : .+cc_
{ .+cc_ space } : .+cc
{ cc-key-bits { rot . ."-> " swap .val .val ."; " true } dictdiff drop cr } : show-cc-diff
{ cc-key-bits { val@ swap val@ + val, true } dictmerge } : cc+
{ null swap cc-key-bits { val@ pair swap cons true } idictforeach drop } : cc>list-rev
{ cc>list-rev list-reverse } : cc>list
forget val,  forget val@  forget .val

// ( S -- x -1 or 0 )
{ (number) dup 2 = { -rot 2drop } if 1 = } : int?
{ int? dup { drop dup 0< { drop false } { true } cond } if } : pos-int?
// ( S -- k v -1 or 0 )  Parses expression <value>*<currency> or <value>*$<currency>
{ dup "*" $pos dup 0< { 2drop false } {
  $| dup $len 2 < { 2drop false } {
  1 $| nip dup 1 $| swap "$" $= { swap } if drop
  int? dup { over 32 fits { 2drop false } ifnot } if
  not { drop false } {
  swap pos-int? not { drop false } {
  true
  } cond } cond } cond } cond
} : cc-key-value?
// ( S -- D -1 or 0 )  Parses an extra currency collection
// e.g. "10000*$3+7777*$-11" means "10000 units of currency #3 and 7777 units of currency #-11"
{ dictnew {  // S D
    swap dup "+" $pos dup 0< { drop null -rot } { $| 1 $| nip -rot } cond
    cc-key-value? { +ccpair over null? dup { rot drop true } if } { 2drop false true } cond
  } until
} : $>xcc?
{ $>xcc? not abort"invalid extra currency collection" } : $>xcc
{ char } word dup $len { $>xcc } { drop dictnew } cond 1 'nop } ::_ CX{

// complete currency collections
{ $>xcc? { true } { drop false } cond } : end-parse-cc
// ( S -- x D -1 or 0 )  Parses a currency collection
// e.g. "1.2+300*$2" means "1200000000ng plus 300 units of currency #2"
{ 0 swap dup "+" $pos dup 0< { drop dup
      $>GR? { nip nip dictnew true } { end-parse-cc } cond
    } { over swap $| swap $>GR? { 2swap 2drop swap 1 $| nip } { drop
  } cond end-parse-cc } cond
} : $>cc?
{ $>cc? not abort"invalid currency collection" } : $>cc
{ char } word dup $len { $>cc } { drop 0 dictnew } cond 2 'nop } ::_ CC{
// ( x D -- )
{ swap ?dup { .GR_ .+cc_ } { .cc_ } cond } : .GR+cc_
{ .GR+cc_ space } : .GR+cc
{ -rot Gram, swap dict, } : Gram+cc,

// Libraries
// ( -- D )  New empty library collection
' dictnew : Libs{
// ( D -- D )  Return library collection as dictionary
'nop : }Libs
// ( D c x -- D' )  Add a public/private library c to collection D
{ <b swap 1 u, over ref, b> <s swap hash rot 256 udict!+
  0= abort"duplicate library in collection" } : lib+
// ( D c -- D' )  Add private library c to collection D
{ 0 lib+ } : private_lib
// ( D c -- D' )  Add public library c to collection D
{ 1 lib+ } : public_lib

// serialize simple transfers with long comments
// b B n -- b'
recursive append-long-bytes {
  over Blen over <= { drop B, } {
    B| <b swap 127 append-long-bytes b> -rot B, swap ref,
  } cond
} swap !
// b S n -- b'
{ swap $>B swap append-long-bytes } : append-long-string
// S -- c
{ <b over $len { 0 32 u, swap 36 append-long-string } { nip } cond b>
} : simple-transfer-body

// ( S -- x )  parse public key
{ dup $len 48 <> abort"public key must be 48 characters long"
  base64url>B dup Blen 36 <> abort"public key must be 48 characters long"
  34 B| 16 B>u@ over crc16 <> abort"crc16 mismatch in public key"
  16 B>u@+ 0x3ee6 <> abort"invalid tag in public key"
  256 B>u@
} : parse-pubkey
{ bl word parse-pubkey 1 'nop } ::_ PK'
// ( x -- S )  serialize public key
{ 256 u>B B{3ee6} swap B+ dup crc16 16 u>B B+ B>base64 } : pubkey>$
{ pubkey>$ type } : .pubkey

// ( S -- x )  parse validator-encoded public key
{ base64>B dup Blen 36 <> abort"public key with magic must be 36 bytes long"
  4 B| swap 32 B>u@ 0xC6B41348 <> abort"unknown magic for public key (not Ed25519)"
} : parse-val-pubkey
{ bl word parse-val-pubkey 1 'nop } ::_ VPK'
{ char } word base64>B 1 'nop } ::_ B64{

// adnl address parser
{ 256 u>B B{2D} swap B+ dup crc16 16 u>B B+ } : adnl-preconv
{ swap 32 /mod dup 26 < { 65 } { 24 } cond + rot swap hold } : Base32#
{ <# ' Base32# 8 times #> } : Base32#*8
{ "" over Blen 5 / { swap 40 B>u@+ Base32#*8 nip rot swap $+ } swap times nip } : B>Base32

// ( x -- S )  Converts an adnl-address from a 256-bit integer to a string
{ adnl-preconv B>Base32 1 $| nip } : adnl>$

{ 65 - dup 0>= { -33 and dup 26 < } { 41 + dup 25 > over 32 < and } cond ?dup nip } : Base32-digit?
{ Base32-digit? not abort"not a Base32 digit" } : Base32-digit
{ 0 { over $len } { swap 1 $| -rot (char) Base32-digit swap 5 << + } while nip } : Base32-number
{ B{} { over $len } { swap 8 $| -rot Base32-number 40 u>B B+ } while nip } : Base32>B

// ( S -- x )  Converts an adnl address from a string to 256-bit integer
{ dup $len 55 <> abort"not 55 alphanumeric characters" "F" swap $+ Base32>B
  33 B| 16 B>u@ over crc16 <> abort"crc16 checksum mismatch"
  8 B>u@+ 0x2D <> abort"not a valid adnl address" 256 B>u@ } : $>adnl

{ 65 - dup 0>= { -33 and 10 + dup 16 < } { 17 + dup 0>= over 10 < and } cond ?dup nip } : hex-digit?
// ( S -- x -1 or 0 )  Parses a hexadecimal integer
{ dup $len {
    0 {
      4 << swap 1 $| -rot (char) hex-digit?  // S a d -1 or S a 0
      { + over $len 0= } { drop -1 true } cond
    } until
    dup 0< { 2drop false } { nip true } cond
  } { drop false } cond
} : hex$>u?
// ( S -- x )
{ hex$>u? not abort"not a hexadecimal number" } : hex$>u

{ dup $len 64 = { hex$>u } {
  dup $len 55 = { $>adnl } {
    true abort"invalid adnl address"
  } cond } cond
} : parse-adnl-addr
{ adnl>$ type } : .adnl
{ bl word parse-adnl-addr 1 'nop } ::_ adnl:

// ( x a b -- a<=x<=b )
{ 2 pick >= -rot >= and } : in-range?

// ( c i -- ? )  Checks whether c is a valid value for config param #i
def? config-valid? {
  { nip 0>= { ."warning: cannot check validity of configuration parameter value, use create-state instead of fift to check validity" cr } if
    true } : config-valid?
} ifnot

{ dup -1000 = { drop <s ref@ <s 12 u@ 0xFF0 = } {
  dup -1001 = { drop <s ref@ <s 12 u@ 0xFF0 = } {
  over null? { 2drop true } {
  config-valid?
  } cond } cond } cond
} : is-valid-config?


// Get anycast depth / rewrite_pfx or return 0
// ( S -- x y S )
{
    // maybe
    1 u@+ swap 0 >
    {
        // anycast_info$_ depth:(#<= 30) { depth >= 1 }
        //    rewrite_pfx:(bits depth) = Anycast;
        30 u@+ swap // get depth

        dup 1 > {
            dup 2 roll swap u@+ // get rewrite_pfx
            // return depth, rewrite_pfx, slice
        }
        {
            drop // drop depth (<=1)
            0 0 2 roll // set anycast to none
        } cond
    }
    {
        0 0 2 roll // set anycast to none
    } cond
} : maybe-anycast

// Rewrite first bits of addr with anycast info
{ // input: anycast depth, rewrite_pfx, workchain, slice, address length
    4 -roll
    3 roll dup dup 0 = { 2drop 2 roll drop }
    {
        rot swap u@+ swap drop
        3 roll
        <b swap 3 roll u, b> <s swap |+
    } cond // rewrite first bits of address with rewrite_pfx
    2 roll
    u@+ // get address
} : parse-address-with-anycast

// Parse Slice S and return:
// 0 `addr_none S - if addr_none$00 is parsed
// addr `addr_extern S - if addr_extern$01 is parsed
// wc addr `addr_std S - if addr_std$10 is parsed
// wc addr `addr_var S - if addr_var$11 is parsed
// ( S -- 0 A S or addr A S or wc addr A S )
{ 2 u@+ swap dup 0>  // Get addr: addr_none$00 / addr_extern$01 / addr_std$10 / addr_var$11
    { // if greater that zero
       dup 1 >
       {
            2 =
            {
                // if addr_std$10
                // anycast:(Maybe Anycast)
                // workchain_id:int8
                // address:bits256  = MsgAddressInt;
                maybe-anycast // get anycast depth, bits, slice
                8 i@+ // get workchain
                256 parse-address-with-anycast
                `addr-std swap
            }

            {
                // if addr_var$11
                // anycast:(Maybe Anycast)
                // addr_len:(## 9)
                // workchain_id:int32
                // address:(bits addr_len) = MsgAddressInt;
                maybe-anycast // get anycast depth, bits, slice
                9 u@+  // get addr_len
                32 i@+ // get workchain
                swap 2 -roll // move workchain to neede position
                swap parse-address-with-anycast
                `addr-var swap
            } cond

       }
       {
            drop // drop header (dup for statment upper)
            // if addr_extern$01
            // addr_extern$01 len:(## 9)
            // external_address:(bits len)
            9 u@+ swap  // bit len
            u@+ // external_address
            `addr-extern swap
       } cond
    }
    {
        swap
        // if addr_none$00
        `addr-none swap
    } cond
} : addr@+

{ addr@+ drop } : addr@

// User-friendly prints output of addr@
// (0 A or addr A or wc addr A -- )
{
    dup `addr-none eq?
    { 2drop ."addr_none" }
    {
        `addr-extern eq?
        { (dump) type }
        { (x.) swap (dump) ":" $+ swap $+ type }
        cond
    }
    cond
} : print-addr // print addr with workchain

forget maybe-anycast
forget parse-address-with-anycast