--- /dev/null
+USING: kernel math errors namespaces math-contrib sequences io ;
+USE: prettyprint
+USE: inspector
+IN: crypto
+
+SYMBOL: a
+SYMBOL: n
+SYMBOL: r
+SYMBOL: s
+SYMBOL: composite
+SYMBOL: count
+SYMBOL: trials
+
+: rand[1..n-1] ( n -- )
+ 1- random-int 1+ ;
+
+: (factor-2s) ( s n -- s n )
+ dup 2 mod 0 = [ -1 shift >r 1+ r> (factor-2s) ] when ;
+
+: factor-2s ( n -- r s )
+ #! factor an even number into 2 ^ s * m
+ dup dup even? >r 0 > r> and [
+ "input must be positive and even" throw
+ ] unless 0 swap (factor-2s) ;
+
+: init-miller-rabin ( n -- )
+ 0 composite set
+ [ n set ] keep 10000 < 20 100 ? trials set ;
+
+: miller-rabin ( n -- bool )
+ [
+ init-miller-rabin
+ n get even? [
+ f ] [
+ n get 1- factor-2s s set r set
+ trials get [
+ n get rand[1..n-1] a set
+ a get s get n get ^mod 1 = [
+ 0 count set
+ r get [
+ 2 over ^ s get * a get swap n get ^mod n get - -1 = [
+ count [ 1+ ] change
+ r get +
+ ] when
+ ] repeat
+ count get zero? [
+ composite on
+ trials get +
+ ] when
+ ] unless
+ ] repeat
+ composite get 0 = [ t ] [ composite get not ] if
+ ] if
+ ] with-scope ;
+
+: next-miller-rabin-prime ( n -- p )
+ dup even? [ 1+ ] [ 2 + ] if
+ dup miller-rabin [ next-miller-rabin-prime ] unless ;
+
+
+! 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 100 miller-rabin
--- /dev/null
+USING: kernel math namespaces math-contrib ;
+
+IN: crypto
+SYMBOL: d
+SYMBOL: p
+SYMBOL: q
+SYMBOL: n
+SYMBOL: m
+SYMBOL: ee
+
+: while-gcd ( -- )
+ m get ee get gcd nip 1 > [ ee [ 2 + ] change while-gcd ] when ;
+
+! n bits
+: generate-key-pair ( bitlen -- )
+ 2 swap 1- 2 /i shift
+ [ random-int next-miller-rabin-prime p set ] keep
+ random-int next-miller-rabin-prime q set
+
+ p get q get * n set
+ p get 1- q get 1- * m set
+ 3 ee set
+ while-gcd
+ m get ee get mod-inv m get + d set ;
+
+: rsa-encrypt ( message -- encrypted )
+ ee get n get ^mod ;
+
+: rsa-decrypt ( encrypted -- message )
+ d get n get ^mod ;