\(\( (*
\ 
      Algorithm\ 8.1  .10\ 
        \((Direct - embedding\ ECC\ encryption)\) . 			
\ Support\ code\ 
        for
\ R . \ Crandall\ and\ C . \ Pomerance, 
\ 
      "Prime Numbers: a Computational Perspective,"
\ Springer - 
        Verlag\ 2001. 
\ c . \ 2000\ Perfectly\ Scientific, \ 
      Inc . 
\ All\ Rights\ Reserved . 
	
	20\ Apr\ 2001\ RC\ 
        \((revamped\ for\ simplicity)\)
\ 10\ Dec\ 2000\ AH\ 
        \((Formatting)\)
	14\ Sep\ 2000\ RT\ \((Creation)\)
*) 
\)\)

\( (*\ CODE\ *) 

    
 (*\ 
      We\ include\ functions\ from\ algorithm\ 7.2  .2\ for\ performing\ 
        elliptic\ 
\(arithmetic . \)\ *) 

    
 (*\ Next, \ 
      a\ function\ that\ negates\ a\ point\ pt\ on\ an\ elliptic\ 
        \(curve . \)\ *) 

    ellneg[pt_]\  := \ Mod[pt\ *\ {1, \(-1\), \ 1}, \ p]; 

    
 (*\ Next, \ elliptic\ subtraction\ pt1 - \(pt2 . \)\ *) 

    \(ellsub[pt1_, \ pt2_]\  := \ elladd[pt1, \ ellneg[pt2]]; \)

    
 (*\ Next, \ the\ double\ of\ a\ \(point . \)\ *) \)\(elldouble[pt_]\  := \ elladd[pt, pt]; 

    
 (*\ Next, \ elliptic\ addition\ pt1 + \(pt2 . \)\ *) 



    \(elladd[pt1_, \ pt2_]\  := \ 
	
      Block[{x1, y1, x2, y2, x3, y3, m}, 
		
        If[pt1[\([3]\)]\  == \ 0, \ Return[pt2]]; 
		
        If[pt2[\([3]\)]\  == \ 0, \ Return[pt1]]; 
		
        x1\  = \ pt1[\([1]\)]; \ y1\  = \ pt1[\([2]\)]; 
		
        x2\  = \ pt2[\([1]\)]; \ y2\  = \ pt2[\([2]\)]; 
		
        If[x1\  == \ x2, \ 
			
          If[Mod[y1 + y2, p] == 0, \ Return[{1, 1, 0}]]; 
			
          m\  = \ Mod[\((3\ x1^2\  + \ a)\)\ *\ PowerMod[2  y1, \(-1\), p], \ 
              p], 
			
          m\  = \ Mod[\((y2 - y1)\)\ PowerMod[x2 - x1, \(-1\), p], p]
		]; 
        
		x3\  = \ Mod[m^2\  - \ x1\  - \ x2, p]; 
		
        y3\  = \ Mod[m \((x1 - x3)\)\  - \ y1, \ p]; 
		
        Return[{x3, y3, 1}]
	]; \)
\ \ 
    
 (*\ Next, \ elliptic - multiply\ a\ point\ pt\ by\ \(k . \)\ *) \)\(

elliptic[pt_, \ k_]\  := \ 
	
      Block[{hh, \ kk, pt2, lenh, \ lenk, \ hb, \ kb}, 
		
        If[k == 0, \ Return[{1, 1, 0}]]; 
		
        hh\  = \ Reverse[IntegerDigits[3  k, 2]]; 
		
        kk\  = \ Reverse[IntegerDigits[k, 2]]; 
		pt2\  = \ pt; 
		
        lenh\  = \ Length[hh]; 
		lenk\  = \ Length[kk]; 
		
        Do[
			pt2\  = \ elldouble[pt2]; 
			hb\  = \ hh[\([b]\)]; 

          			If[b\  <= \ lenk, \ kb\  = \ kk[\([b]\)], \ kb\  = \ 0]; 

          			If[{hb, kb}\  == \ {1, 0}, 
				
            pt2\  = \ elladd[pt2, \ pt], 
				
            If[{hb, \ kb}\  == \ {0, 1}, 
				
              pt2\  = \ ellsub[pt2, \ pt]]
			]
			, 

          			{b, \ lenh - 1, \ 2, \(-1\)}
		\ ]; 
	Return[pt2]
]

    
 (*\ Next, \ 
      we\ include\ algorithm\ 2.3  .8\ for\ finding\ square\ roots\ 
modulo\ 
        a\ prime\ p, \ 
      to\ be\ used\ to\ seek\ out\ valid\ y - 
        coordinates\ on\ \(curves . \)\ *) 
\)\(sqrtmod[b_, p_] := \ 
	
      Module[{a, x, c, d, cd, m, t, tst}, 
\ \ \ 		a\  = \ Mod[b, p]; 

        \ \ \ 		If[p\  == \ 2, \ Return[a]]; 
\ \ \ \ 	
        If[MemberQ[{3, 7}, Mod[p, 8]], 
\ \ \ \ \ \ 		
          Return[PowerMod[a, \((p + 1)\)/4, p]]
\ \ \ \ \ \ 	]; 
\ \ \ \ 	
        If[Mod[p, 8]\  == \ 5, 
\ \ \ \ \ \ 		
          x\  = \ PowerMod[a, \((p + 3)\)/8, p]; 
\ \ \ \ \ \ 		
          c\  = \ Mod[x^2, p]; 
\ \ \ \ \ \ 		
          If[Not[c\  == \ a], 
\ \ \ \ \ \ \ \ 		
            Return[Mod[x\ PowerMod[2, \((p - 1)\)/4, p], \ p]]

            \ \ \ \ \ \ \ \ 	]; 
\ \ \ \ \ \ 	]; 
\ \ \ \ 	

        \ \ \ \ 	 (*\ Here, \ p\  = \ 1\ \(\((mod\ 8)\) . \)\ *) 

        \ \ \ \ \ \ 	tst\  = \ 1; 
\ \ \ \ \ \ 	
        While[Not[tst\  == \ \(-1\)], 
\ \ \ \ \ \ \ \ 	
          d\  = \ Random[Integer, {1, p}]; 
\ \ \ \ \ \ \ \ 	
          tst\  = \ JacobiSymbol[d, p]
\ \ \ \ \ \ \ \ ]; 
\ \ \ \ \ \ 	
        t\  = \ \((p - 1)\)/2; \ s\  = \ 1; 
\ \ \ \ \ \ 	
        While[EvenQ[t], \ t\  = \ t/2; \ \(++s\)]; 
\ \ \ \ \ \ 	
        ca\  = \ PowerMod[a, t, p]; 
\ \ \ \ \ \ 	
        cd\  = \ PowerMod[d, t, p]; 
\ \ \ \ \ \ 	m\  = \ 0; 

        \ \ \ \ \ \ 	
        Do[
\ \ \ \ \ \ 	\ \ \ 
          If[PowerMod[Mod[ca\ PowerMod[cd, \ m, \ p], p], \ 
                2^\((s - 1 - i)\), \ p]
\ \ \ \ \ \ 	\ \ \ 		 == \ p - 1, 
            \ m\  += \ 2^i]
\ \ \ \ \ \ 	\ \ \ , {i, 0, s - 1}

          \ \ \ \ \ \ 	]; \ \ \ \ \ \ 	\ \ \ \ 
\ \ \ \ \ \ 	
        Return[Mod[PowerMod[a, \ \((t + 1)\)/2, p]\ PowerMod[cd, \ m/2, p], 
            p]]; \ 
	]; 


    
 (*\ Now, \ 
      the\ main\ routine . \ Parameters\ are\ given\ for\ 161 - 
        bit\ prime\ field
			and\ specific\ curve; 
	\ \ 
      direct\ embedding\ proceeds\ on\ "plaintext"\ integers\ x\ 
        \((mod\ p)\) . \ 
\ \ \ We\ start\ with\ relevant\ global\ 
        \((and\ public, \ except\ for\ kb)\)
\ \ \ parameters
\ *) 

    
p\  = \ 
      1654338658923174831024422729553880293604080853451; 
A\  = \ \(-152\); 
    
B\  = \ 722; 
g\  = \ \(-1\); 
    \ \  (*\ Quadratic\ nonresidue\ \((mod\ p)\)\ for\ this\ case, \ 
      as\ p\  = \ 3\ \(\((mod\ 4)\) . \)\ *) 

    Atwist\  = \ Mod[A\ \ Mod[h\  = \ g^2, p], \ p]; 

    Btwist\  = \ Mod[B\ \ Mod[h\ g, p], p]; 

    
 (*\ Next, \ 
      create\ public\ point\ P\ of\ prime\ order\ on\ main\ \(curve . \)\ *) 
      
x1 = \ 124590448755381588517063157600522073397838354227; \ \ 

    pubpoint\  = 
      \ {x1, \ sqrtmod[Mod[x1\ Mod[x1^2\  + \ A, p]\  + \ B, p], \ p], 1}; 

    
 (*\ Next, \ 
      create\ public\ point\ P'\ of\ prime\ order\ on\ twist\ 
        \(curve . \)\ *) 

    x1twist\  = \ 480775151193986876474195670157924389403361833567; 

    pubpointtwist\  = 
      \ {x1twist, \ 
        sqrtmod[Mod[x1twist\ Mod[x1twist^2\  + \ Atwist, p]\  + \ Btwist, p], 
          \ p], 1}; 

kb\  = \ 968525826201321079923232842886222248; 
    \ \  (*\ Private\ key\ \(K_B . \)\ *) 

{a, b}\  = \ {A, B}; 
    \ \  (*\ Prepare\ elliptic\ algebra\ for\ main\ \(curve . \)\ *) 

    pubkey\  = \ \ \ elliptic[pubpoint, \ kb]; 
    \ \ \ \ \ \ \ \  (*\ Public\ key\ \(P_B . \)\ *) 
\ 
    
{a, b}\  = \ {Atwist, \ Btwist}; 
    \ \ \  (*\ Prepare\ elliptic\ algebra\ for\ twist\ \(curve . \)\ *) 

    pubkeytwist\  = \ 	elliptic[pubpointtwist, \ kb]; 
    \ \ \ \ \  (*\ Public\ key\ \(P_B' . \)\ *) 
\ 
		

    encryptEmbed[x_] := \ 
      Module[{cubic, \ curve, \ X\  = \ x, \ Y, \ pbk, \ X1}, 
        
 (*\ First, \ 
          let\ us\ determine\ which\ curve . \ 
		\ \ \ EITHER\ X\ lies\ in
              \ the\ curve\ y^2\  = \ X^3\  + \ A\ X\  + \ B, 
		\ \ \ 
          or\ Xt\  := \ 
            \(g\ X\ lies\ on\ y^2\  = \ 
              Xt^3\  + \ Atwist\ Xt\  + \ Btwist\)\ *) 
		\ 
        cubic\  = \ Mod[X\ Mod[X^2\  + \ A, p]\  + \ B, p]; 
		\ 
        If[JacobiSymbol[cubic, \ p]\  > \ \(-1\), \ 
			\ \ \ \ \ \ 
          curve\  = \ 1; \ {a, b}\  = \ {A, B}; \ pbk\  = \ pubkey; \ 
          pbp\  = \ pubpoint, 			\ \ \ \ \ \ 
				\ \ \ \ \ 
          curve\  = \ \(-1\); \ {a, b}\  = \ {Atwist, \ Btwist}; \ 
          pbk\  = \ pubkeytwist; \ pbp\  = \ pubpointtwist; \ 

          									X\  = \ g\ X; \ 
		\ \ \ \ \ \ \ 
          cubic\  = \ Mod[X\ Mod[X^2\  + \ Atwist, p]\  + \ Btwist, p]

          		\ \ ]; 
		\ \ Y\  = \ sqrtmod[cubic, \ p]; \ \ 

        			 (*\ 
          Now\ we\ \(have : \ 
						\ \ 
              \((X\  = \ x, Y)\)\ or\ \((X\  = \ g\ x, \ Y)\) lies\ on\ the\ 
                respective\ curve\); 
				\ \ \ \ 
          \((a, b)\)\ parameters\ are\ set\ up\ for\ respective\ 
            \(curve . \)\ *) 
			\ 
			
        r\  = \ Random[Integer, \ {2, p - 2}]; 
			
        u\  = \ elladd[elliptic[pbk, \ r], \ {X, \ Y, 1}]; 
			
        c\  = \ elliptic[pbp, \ r]; 

        		\ \ {u, \ c, \ curve}
]; 


    decryptEmbed[cipherList_] := \ 
      Module[{u\  = \ cipherList[\([1]\)], \ c\  = \ cipherList[\([2]\)], \ 
          curve\  = \ cipherList[\([3]\)]}, 
        
If[curve\  == \ 1, 

          				{a, b}\  = \ {A, \ B}, 

          			\ \ {a, b}\  = \ {Atwist, \ Btwist}
		\ \ \ ]; 
		
        X\  = \ \(ellsub[u, \ elliptic[c, \ kb]]\)[\([1]\)]; 
		
        If[curve\  != \ 1, \ X\  = \ Mod[X\ PowerMod[g, \(-1\), \ p], p]]; 

        			X
]; 

\)

\( (*\ EXAMPLE\ *) \ 


    
ciph\  = \ 
      encryptEmbed[plain\  = \ 1324578918324567]\)decryptEmbed[ciph]