summaryrefslogtreecommitdiff
path: root/cubehash.rkt
blob: bb87788359b837c3cd9638aba45f8d01c1c1262f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
#lang typed/racket
;;; Copyright 2011, Matthias Andreas Benkard.
;;;
;;;-----------------------------------------------------------------------------
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Affero General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;-----------------------------------------------------------------------------
;;;

;;;
;;; NOTE:  The original version of CubeHash defaulted to
;;; init-rounds = fin-rounds = (* 10 rounds/block).  Therefore, if you see
;;; references to “Cubehash r/b-h” variants, you can instantiate those by using
;;; something like the following:
;;;
;;;  (cubehash (* 10 r) r b (* 10 r) h)
;;;


(require "util.rkt")

(provide: [cubehash      (Exact-Nonnegative-Integer Exact-Nonnegative-Integer
                          Exact-Nonnegative-Integer Exact-Nonnegative-Integer
                          Exact-Nonnegative-Integer ->
                          Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-128  (Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-160  (Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-224  (Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-256  (Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-384  (Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-512  (Bytes -> Exact-Nonnegative-Integer)]
          [cubehash-512x (Bytes -> Exact-Nonnegative-Integer)]
          #;[cubemac-128   (Bytes Bytes -> Exact-Nonnegative-Integer)])

(: cubehash      (Exact-Nonnegative-Integer Exact-Nonnegative-Integer
                  Exact-Nonnegative-Integer Exact-Nonnegative-Integer
                  Exact-Nonnegative-Integer ->
                  Bytes -> Exact-Nonnegative-Integer))
(: cubehash-128  (Bytes -> Exact-Nonnegative-Integer))
(: cubehash-160  (Bytes -> Exact-Nonnegative-Integer))
(: cubehash-224  (Bytes -> Exact-Nonnegative-Integer))
(: cubehash-256  (Bytes -> Exact-Nonnegative-Integer))
(: cubehash-384  (Bytes -> Exact-Nonnegative-Integer))
(: cubehash-512  (Bytes -> Exact-Nonnegative-Integer))
(: cubehash-512x (Bytes -> Exact-Nonnegative-Integer))
#;(: cubemac-128   (Bytes Bytes -> Exact-Nonnegative-Integer))


(define-type Word    Exact-Nonnegative-Integer)
(define-type Bit     (U Zero One))

(: w+ (Word Word -> Word))
(define (w+ a b)
  (bitwise-and (+ a b) #xffffffff))

(: wxor (Word Word -> Word))
(define wxor bitwise-xor)

(: wrot (Word Exact-Positive-Integer -> Word))
(define (wrot a e)
  (let ([ash (arithmetic-shift a e)])
    (bitwise-ior (bitwise-and ash #xffffffff)
                 (arithmetic-shift ash -32))))


(define (cubehash init-rounds rounds/block block-size fin-rounds output-bits)
  (λ: ([msg : Bytes])
    (let*: ([state   : (Vectorof Word)
                     (make-vector 32 #x0)]
            [msg-pad : Bytes
                     (bytes-append msg
                                   (list->bytes '(#x80))
                                   (make-bytes (modulo (- (+ 1 (bytes-length msg)))
                                                       block-size)
                                               #x0))]
            [x       : (Integer Integer Integer Integer Integer -> Word)
                     (λ (i j k l m)
                       (vector-ref state (+ (* i 16) (* j 8) (* k 4) (* l 2) m)))]
            [set-x!  : (Integer Integer Integer Integer Integer Word -> Void)
                     (λ (i j k l m v)
                       (vector-set! state (+ (* i 16) (* j 8) (* k 4) (* l 2) m) v))]
            [round!  : (-> Void)
                     (λ ()
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (set-x! 1 j k l m (w+ (x 0 j k l m)
                                               (x 1 j k l m))))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (set-x! 0 j k l m (wrot (x 0 j k l m) 7)))
                       (for*: ([k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (let ([tmp (x 0 0 k l m)])
                           (set-x! 0 0 k l m (x 0 1 k l m))
                           (set-x! 0 1 k l m tmp)))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (set-x! 0 j k l m (wxor (x 0 j k l m)
                                                 (x 1 j k l m))))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [m : Bit '(0 1)])
                         (let ([tmp (x 1 j k 0 m)])
                           (set-x! 1 j k 0 m (x 1 j k 1 m))
                           (set-x! 1 j k 1 m tmp)))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (set-x! 1 j k l m (w+ (x 0 j k l m)
                                               (x 1 j k l m))))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (set-x! 0 j k l m (wrot (x 0 j k l m) 11)))
                       (for*: ([j : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (let ([tmp (x 0 j 0 l m)])
                           (set-x! 0 j 0 l m (x 0 j 1 l m))
                           (set-x! 0 j 1 l m tmp)))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)])
                         (set-x! 0 j k l m (wxor (x 0 j k l m)
                                                 (x 1 j k l m))))
                       (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)])
                         (let ([tmp (x 1 j k l 0)])
                           (set-x! 1 j k l 0 (x 1 j k l 1))
                           (set-x! 1 j k l 1 tmp))))])
      (vector-set! state 0 (quotient output-bits 8))
      (vector-set! state 1 block-size)
      (vector-set! state 2 rounds/block)
      (for ([i (in-range 0 init-rounds)])
        (round!))
      (for ([i (in-range 0 (quotient (bytes-length msg-pad) block-size))])
        (let ([block (subbytes msg-pad (* i block-size) (* (add1 i) block-size))])
          (for: ([byte : Byte block]
                 [i    : Exact-Nonnegative-Integer (in-naturals)])
            (let ([s (vector-ref state (quotient i 4))])
              (vector-set! state
                           (quotient i 4)
                           (bitwise-xor s (arithmetic-shift byte
                                                            (* (remainder i 4) 8))))))
          (for ([i (in-range 0 rounds/block)])
            (round!))))
      (vector-set! state 31 (bitwise-xor (vector-ref state 31) 1))
      (for ([i (in-range 0 fin-rounds)])
        (round!))
      (bytes->integer
       (subbytes (bytes-append* (vector->list
                                 (vector-map (λ: ([w : Word])
                                               (integer->bytes/size w 'little-endian 4))
                                             state)))
                 0
                 (quotient output-bits 8))))))


(define cubehash-128  (cubehash 16 16 32 32 128))
(define cubehash-160  (cubehash 16 16 32 32 160))
(define cubehash-224  (cubehash 16 16 32 32 224))
(define cubehash-256  (cubehash 16 16 32 32 256))
(define cubehash-384  (cubehash 16 16 32 32 384))
(define cubehash-512  (cubehash 16 16 32 32 512))
(define cubehash-512x (cubehash 16 16 1  32 512))

#;(define cubemac-128 ...)