basis/checksums/ripemd/ripemd.factor

   1 ! Copyright (C) 2017 Jon Harper.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data byte-arrays checksums
   4 checksums.common combinators grouping hints kernel
   5 kernel.private math math.bitwise sequences sequences.private
   6 specialized-arrays ;
   7 SPECIALIZED-ARRAY: uint
   8 IN: checksums.ripemd
   9
  10 SINGLETON: ripemd-160
  11
  12 INSTANCE: ripemd-160 block-checksum
  13
  14 TUPLE: ripemd-160-state < block-checksum-state
  15 { state1 uint-array }
  16 { state2 uint-array }
  17 { old-state uint-array } ;
  18
  19 : <ripemd-160-state> ( -- ripemd-160 )
  20     ripemd-160-state new-checksum-state
  21         64 >>block-size
  22         uint-array{ 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0 }
  23         [ clone >>state1 ] [ clone >>state2 ] [ >>old-state ] tri ;
  24
  25 M: ripemd-160 initialize-checksum-state drop <ripemd-160-state> ;
  26
  27 <PRIVATE
  28
  29 : combine-ripemd-160 ( ripemd-160-state -- new-state )
  30     [ old-state>> 1 cut prepend ]
  31     [ state1>> 2 cut prepend ]
  32     [ state2>> 3 cut prepend ] tri
  33     [ w+ ] 2map [ w+ ] 2map ; inline
  34
  35 : update-ripemd-160 ( ripemd-160 -- )
  36     [ combine-ripemd-160 dup clone dup clone ] [ ] bi
  37     [ old-state<< ] [ state1<< ] [ state2<< ] tri ; inline
  38
  39 : F ( x y z -- out ) bitxor bitxor ;  inline
  40 : G ( x y z -- out ) pick bitnot swap [ bitand ] 2bi@ bitor ; inline
  41 : H ( x y z -- out ) [ bitnot bitor ] [ bitxor ] bi* ; inline
  42 : I ( x y z -- out ) tuck bitnot [ bitand ] 2bi@ bitor ; inline
  43 : J ( x y z -- out ) bitnot bitor bitxor ; inline
  44
  45 CONSTANT: T11 0x00000000
  46 CONSTANT: T12 0x5A827999
  47 CONSTANT: T13 0x6ED9EBA1
  48 CONSTANT: T14 0x8F1BBCDC
  49 CONSTANT: T15 0xA953FD4E
  50
  51 CONSTANT: T21 0x50A28BE6
  52 CONSTANT: T22 0x5C4DD124
  53 CONSTANT: T23 0x6D703EF3
  54 CONSTANT: T24 0x7A6D76E9
  55 CONSTANT: T25 0x00000000
  56
  57 CONSTANT: a 0
  58 CONSTANT: b 1
  59 CONSTANT: c 2
  60 CONSTANT: d 3
  61 CONSTANT: e 4
  62
  63 CONSTANT: S1 uint-array{
  64 11 14 15 12 5 8 7 9 11 13 14 15 6 7 9 8
  65 7 6 8 13 11 9 7 15 7 12 15 9 11 7 13 12
  66 11 13 6 7 14 9 13 15 14 8 13 6 5 12 7 5
  67 11 12 14 15 14 15 9 8 9 14 5 6 8 6 5 12
  68 9 15 5 11 6 8 13 12 5 12 13 14 11 8 5 6
  69 }
  70
  71 CONSTANT: S2 uint-array{
  72 8 9 9 11 13 15 15 5 7 7 8 11 14 14 12 6
  73 9 13 15 7 12 8 9 11 7 7 12 7 6 15 13 11
  74 9 7 15 11 8 6 6 14 12 13 5 14 13 13 7 5
  75 15 5 8 11 14 14 6 14 6 9 12 9 12 5 15 8
  76 8 5 12 9 12 5 14 6 8 13 6 5 15 13 11 11
  77 }
  78
  79 :: (ABCDE) ( x state a b c d e k S s T quot -- )
  80     ! a = e + ((a + F(b,c,d) + X[k] + T) <<< S[s])
  81     ! c = c <<< 10
  82     a state [
  83         b state nth-unsafe
  84         c state nth-unsafe
  85         d state nth-unsafe quot call w+
  86         k x nth-unsafe w+
  87         T w+
  88         s S nth-unsafe bitroll-32
  89         e state nth-unsafe w+
  90     ] change-nth-unsafe
  91     c state [ 10 bitroll-32 ] change-nth-unsafe ; inline
  92
  93 MACRO: with-ripemd-160-round ( ops quot -- quot )
  94     '[ [ _ (ABCDE) ] compose ] map '[ _ 2cleave ] ;
  95
  96 : (process-ripemd-160-block-F1) ( block state1 -- )
  97     { uint-array uint-array } declare {
  98         [ a b c d e  0 S1  0 T11 ]
  99         [ e a b c d  1 S1  1 T11 ]
 100         [ d e a b c  2 S1  2 T11 ]
 101         [ c d e a b  3 S1  3 T11 ]
 102         [ b c d e a  4 S1  4 T11 ]
 103         [ a b c d e  5 S1  5 T11 ]
 104         [ e a b c d  6 S1  6 T11 ]
 105         [ d e a b c  7 S1  7 T11 ]
 106         [ c d e a b  8 S1  8 T11 ]
 107         [ b c d e a  9 S1  9 T11 ]
 108         [ a b c d e 10 S1 10 T11 ]
 109         [ e a b c d 11 S1 11 T11 ]
 110         [ d e a b c 12 S1 12 T11 ]
 111         [ c d e a b 13 S1 13 T11 ]
 112         [ b c d e a 14 S1 14 T11 ]
 113         [ a b c d e 15 S1 15 T11 ]
 114     } [ F ] with-ripemd-160-round ;
 115
 116 : (process-ripemd-160-block-G1) ( block state1 -- )
 117     { uint-array uint-array } declare {
 118         [ e a b c d  7 S1 16 T12 ]
 119         [ d e a b c  4 S1 17 T12 ]
 120         [ c d e a b 13 S1 18 T12 ]
 121         [ b c d e a  1 S1 19 T12 ]
 122         [ a b c d e 10 S1 20 T12 ]
 123         [ e a b c d  6 S1 21 T12 ]
 124         [ d e a b c 15 S1 22 T12 ]
 125         [ c d e a b  3 S1 23 T12 ]
 126         [ b c d e a 12 S1 24 T12 ]
 127         [ a b c d e  0 S1 25 T12 ]
 128         [ e a b c d  9 S1 26 T12 ]
 129         [ d e a b c  5 S1 27 T12 ]
 130         [ c d e a b  2 S1 28 T12 ]
 131         [ b c d e a 14 S1 29 T12 ]
 132         [ a b c d e 11 S1 30 T12 ]
 133         [ e a b c d  8 S1 31 T12 ]
 134     } [ G ] with-ripemd-160-round ;
 135
 136 : (process-ripemd-160-block-H1) ( block state1 -- )
 137     { uint-array uint-array } declare {
 138         [ d e a b c  3 S1 32 T13 ]
 139         [ c d e a b 10 S1 33 T13 ]
 140         [ b c d e a 14 S1 34 T13 ]
 141         [ a b c d e  4 S1 35 T13 ]
 142         [ e a b c d  9 S1 36 T13 ]
 143         [ d e a b c 15 S1 37 T13 ]
 144         [ c d e a b  8 S1 38 T13 ]
 145         [ b c d e a  1 S1 39 T13 ]
 146         [ a b c d e  2 S1 40 T13 ]
 147         [ e a b c d  7 S1 41 T13 ]
 148         [ d e a b c  0 S1 42 T13 ]
 149         [ c d e a b  6 S1 43 T13 ]
 150         [ b c d e a 13 S1 44 T13 ]
 151         [ a b c d e 11 S1 45 T13 ]
 152         [ e a b c d  5 S1 46 T13 ]
 153         [ d e a b c 12 S1 47 T13 ]
 154     } [ H ] with-ripemd-160-round ;
 155
 156 : (process-ripemd-160-block-I1) ( block state1 -- )
 157     { uint-array uint-array } declare {
 158         [ c d e a b  1 S1 48 T14 ]
 159         [ b c d e a  9 S1 49 T14 ]
 160         [ a b c d e 11 S1 50 T14 ]
 161         [ e a b c d 10 S1 51 T14 ]
 162         [ d e a b c  0 S1 52 T14 ]
 163         [ c d e a b  8 S1 53 T14 ]
 164         [ b c d e a 12 S1 54 T14 ]
 165         [ a b c d e  4 S1 55 T14 ]
 166         [ e a b c d 13 S1 56 T14 ]
 167         [ d e a b c  3 S1 57 T14 ]
 168         [ c d e a b  7 S1 58 T14 ]
 169         [ b c d e a 15 S1 59 T14 ]
 170         [ a b c d e 14 S1 60 T14 ]
 171         [ e a b c d  5 S1 61 T14 ]
 172         [ d e a b c  6 S1 62 T14 ]
 173         [ c d e a b  2 S1 63 T14 ]
 174     } [ I ] with-ripemd-160-round ;
 175
 176 : (process-ripemd-160-block-J1) ( block state1 -- )
 177     { uint-array uint-array } declare {
 178         [ b c d e a  4 S1 64 T15 ]
 179         [ a b c d e  0 S1 65 T15 ]
 180         [ e a b c d  5 S1 66 T15 ]
 181         [ d e a b c  9 S1 67 T15 ]
 182         [ c d e a b  7 S1 68 T15 ]
 183         [ b c d e a 12 S1 69 T15 ]
 184         [ a b c d e  2 S1 70 T15 ]
 185         [ e a b c d 10 S1 71 T15 ]
 186         [ d e a b c 14 S1 72 T15 ]
 187         [ c d e a b  1 S1 73 T15 ]
 188         [ b c d e a  3 S1 74 T15 ]
 189         [ a b c d e  8 S1 75 T15 ]
 190         [ e a b c d 11 S1 76 T15 ]
 191         [ d e a b c  6 S1 77 T15 ]
 192         [ c d e a b 15 S1 78 T15 ]
 193         [ b c d e a 13 S1 79 T15 ]
 194     } [ J ] with-ripemd-160-round ;
 195
 196
 197 : (process-ripemd-160-block-J2) ( block state2 -- )
 198     { uint-array uint-array } declare {
 199         [ a b c d e  5 S2  0 T21 ]
 200         [ e a b c d 14 S2  1 T21 ]
 201         [ d e a b c  7 S2  2 T21 ]
 202         [ c d e a b  0 S2  3 T21 ]
 203         [ b c d e a  9 S2  4 T21 ]
 204         [ a b c d e  2 S2  5 T21 ]
 205         [ e a b c d 11 S2  6 T21 ]
 206         [ d e a b c  4 S2  7 T21 ]
 207         [ c d e a b 13 S2  8 T21 ]
 208         [ b c d e a  6 S2  9 T21 ]
 209         [ a b c d e 15 S2 10 T21 ]
 210         [ e a b c d  8 S2 11 T21 ]
 211         [ d e a b c  1 S2 12 T21 ]
 212         [ c d e a b 10 S2 13 T21 ]
 213         [ b c d e a  3 S2 14 T21 ]
 214         [ a b c d e 12 S2 15 T21 ]
 215     } [ J ] with-ripemd-160-round ;
 216
 217 : (process-ripemd-160-block-I2) ( block state2 -- )
 218     { uint-array uint-array } declare {
 219         [ e a b c d  6 S2 16 T22 ]
 220         [ d e a b c 11 S2 17 T22 ]
 221         [ c d e a b  3 S2 18 T22 ]
 222         [ b c d e a  7 S2 19 T22 ]
 223         [ a b c d e  0 S2 20 T22 ]
 224         [ e a b c d 13 S2 21 T22 ]
 225         [ d e a b c  5 S2 22 T22 ]
 226         [ c d e a b 10 S2 23 T22 ]
 227         [ b c d e a 14 S2 24 T22 ]
 228         [ a b c d e 15 S2 25 T22 ]
 229         [ e a b c d  8 S2 26 T22 ]
 230         [ d e a b c 12 S2 27 T22 ]
 231         [ c d e a b  4 S2 28 T22 ]
 232         [ b c d e a  9 S2 29 T22 ]
 233         [ a b c d e  1 S2 30 T22 ]
 234         [ e a b c d  2 S2 31 T22 ]
 235     } [ I ] with-ripemd-160-round ;
 236
 237 : (process-ripemd-160-block-H2) ( block state2 -- )
 238     { uint-array uint-array } declare {
 239         [ d e a b c 15 S2 32 T23 ]
 240         [ c d e a b  5 S2 33 T23 ]
 241         [ b c d e a  1 S2 34 T23 ]
 242         [ a b c d e  3 S2 35 T23 ]
 243         [ e a b c d  7 S2 36 T23 ]
 244         [ d e a b c 14 S2 37 T23 ]
 245         [ c d e a b  6 S2 38 T23 ]
 246         [ b c d e a  9 S2 39 T23 ]
 247         [ a b c d e 11 S2 40 T23 ]
 248         [ e a b c d  8 S2 41 T23 ]
 249         [ d e a b c 12 S2 42 T23 ]
 250         [ c d e a b  2 S2 43 T23 ]
 251         [ b c d e a 10 S2 44 T23 ]
 252         [ a b c d e  0 S2 45 T23 ]
 253         [ e a b c d  4 S2 46 T23 ]
 254         [ d e a b c 13 S2 47 T23 ]
 255     } [ H ] with-ripemd-160-round ;
 256
 257 : (process-ripemd-160-block-G2) ( block state2 -- )
 258     { uint-array uint-array } declare {
 259         [ c d e a b  8 S2 48 T24 ]
 260         [ b c d e a  6 S2 49 T24 ]
 261         [ a b c d e  4 S2 50 T24 ]
 262         [ e a b c d  1 S2 51 T24 ]
 263         [ d e a b c  3 S2 52 T24 ]
 264         [ c d e a b 11 S2 53 T24 ]
 265         [ b c d e a 15 S2 54 T24 ]
 266         [ a b c d e  0 S2 55 T24 ]
 267         [ e a b c d  5 S2 56 T24 ]
 268         [ d e a b c 12 S2 57 T24 ]
 269         [ c d e a b  2 S2 58 T24 ]
 270         [ b c d e a 13 S2 59 T24 ]
 271         [ a b c d e  9 S2 60 T24 ]
 272         [ e a b c d  7 S2 61 T24 ]
 273         [ d e a b c 10 S2 62 T24 ]
 274         [ c d e a b 14 S2 63 T24 ]
 275     } [ G ] with-ripemd-160-round ;
 276
 277 : (process-ripemd-160-block-F2) ( block state2 -- )
 278     { uint-array uint-array } declare {
 279         [ b c d e a 12 S2 64 T25 ]
 280         [ a b c d e 15 S2 65 T25 ]
 281         [ e a b c d 10 S2 66 T25 ]
 282         [ d e a b c  4 S2 67 T25 ]
 283         [ c d e a b  1 S2 68 T25 ]
 284         [ b c d e a  5 S2 69 T25 ]
 285         [ a b c d e  8 S2 70 T25 ]
 286         [ e a b c d  7 S2 71 T25 ]
 287         [ d e a b c  6 S2 72 T25 ]
 288         [ c d e a b  2 S2 73 T25 ]
 289         [ b c d e a 13 S2 74 T25 ]
 290         [ a b c d e 14 S2 75 T25 ]
 291         [ e a b c d  0 S2 76 T25 ]
 292         [ d e a b c  3 S2 77 T25 ]
 293         [ c d e a b  9 S2 78 T25 ]
 294         [ b c d e a 11 S2 79 T25 ]
 295     } [ F ] with-ripemd-160-round ;
 296
 297 : byte-array>le ( byte-array -- byte-array )
 298     little-endian? [
 299         dup 4 <groups> [
 300             [ [ 1 2 ] dip exchange-unsafe ]
 301             [ [ 0 3 ] dip exchange-unsafe ] bi
 302         ] each
 303     ] unless ;
 304
 305 HINTS: byte-array>le byte-array ;
 306
 307 M: ripemd-160-state checksum-block
 308     [
 309         [ byte-array>le uint cast-array ] dip [
 310         state1>> {
 311             [ (process-ripemd-160-block-F1) ]
 312             [ (process-ripemd-160-block-G1) ]
 313             [ (process-ripemd-160-block-H1) ]
 314             [ (process-ripemd-160-block-I1) ]
 315             [ (process-ripemd-160-block-J1) ]
 316         } 2cleave ] [
 317         state2>> {
 318             [ (process-ripemd-160-block-J2) ]
 319             [ (process-ripemd-160-block-I2) ]
 320             [ (process-ripemd-160-block-H2) ]
 321             [ (process-ripemd-160-block-G2) ]
 322             [ (process-ripemd-160-block-F2) ]
 323         } 2cleave ] 2bi
 324     ] [
 325         update-ripemd-160
 326     ] bi ;
 327
 328 : ripemd-160>checksum ( ripemd-160 -- bytes )
 329     old-state>> underlying>> byte-array>le ;
 330
 331 M: ripemd-160-state clone
 332     call-next-method
 333     [ clone ] change-state1 [ clone ] change-state2
 334     [ clone ] change-old-state ;
 335
 336 M: ripemd-160-state get-checksum
 337     clone
 338     [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
 339     [ [ checksum-block ] curry each ] [ ripemd-160>checksum ] bi ;
 340
 341 PRIVATE>