USING: byte-arrays checksums checksums.md5 io kernel lcs 
math namespaces prettyprint random sequences syntax ;
IN: md5game

! Based on the C version of this guy here
! http://www.reddit.com/r/programming/comments/8i9h7/someone_has_told_me_that_this_may_take_several/c09e5vu
! but search for longest common subsequence and not
! for first bytes that match.
! It all started here: http://www.reddit.com/r/programming/comments/8i9h7/someone_has_told_me_that_this_may_take_several/
! ...and a followup: http://www.reddit.com/r/programming/comments/8iguu/md5_gamechallenge_for_you_reddit/

! Anyway... LOL! Teh InterWebz is phun!

CONSTANT: buff_size 16
SYMBOL: lcs-so-far

: print-solutions* ( original md5 -- )
    [ hex-string ] bi@
    [ "Original: " write print ] dip
    "MD5: " write print flush ;

: print-solutions ( original md5 -- original md5 )
    2dup print-solutions* ;

: is-a-record? ( original md5 -- subseq ? )
    lcs dup length lcs-so-far get > ;

: set-new-record ( subseq -- subseq )
    dup length lcs-so-far set ;

: check-for-record ( original md5 -- original )
    2dup is-a-record? [ 
        set-new-record [ print-solutions ] dip nip
        "Subsequence: " write hex-string print nl flush
    ] [ 2drop ] if ;

: (increment) ( i bytes -- bytes ) 
    2dup [ 1+ ] change-nth 2dup ?nth zero? [
        [ 1- ] dip (increment)
    ] [ nip ] if ;

: increment ( bytes -- bytes+1 ) 
    dup length 1- swap (increment) ;

: (md5game) ( bytes -- )
    dup md5 checksum-bytes 2dup = [ 
        "Found!" print print-solutions* 
    ] [ 
        check-for-record increment (md5game) 
    ] if ;

: populate ( -- bytes ) 
    buff_size random-bytes >byte-array ;

: md5game ( -- ) 
    populate 0 lcs-so-far set (md5game) ;

MAIN: md5game