\(\( (*
	No - Y - coordinate\ version\ of\ Algorithm\ 8.1  .10; 
	
      see\ program\ 8.1  .10 . directembed . nb
			

\ 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\ *) 

    
 (*\ First, \ a\ function\ for\ inverting\ n\ mod\ \(p . \)\ *) 

    ellinv[n_]\  := \ If[n == 0, 0, PowerMod[n, \(-1\), p]]; 

    
 (*\ Next, \ 
      a\ function\ for\ normalizing\ the\ x\ \(coordinate . \)\ *) 

    ex[pt_]\  := \ Mod[pt[\([1]\)]\ *\ ellinv[pt[\([2]\)]], \ p]; 

    
 (*\ Next, \ 
      the\ doubleh \(()\)\ function\ for\ doubling\ a\ \(point . \)\ *) 

    elleven[pt_]\  := \ 
	
      Block[{x1\  = \ pt[\([1]\)], \ z1\  = \ pt[\([2]\)], \ e, \ f\ }, 

        \ \ 		e\  = \ 
          Mod[\((x1^2\  - \ a\ z1^2)\)^2\  - \ 
              4\ b\ \((2\ x1\  + \ c\ z1)\)\ z1^3, \ p]; 
\ \ 		
        f\  = \ Mod[
            4\ z1\ \((x1^3\  + \ c\ x1^2\ z1\  + \ a\ x1\ z1^2\  + \ b\ z1^3)
                \), \ p]; 
\ \ 		{e, f}
	]; 

    
 (*\ Next, \ 
      the\ addh \(()\)\ function\ for\ adding\ pt\ and\ pu\ with\ pv\  = \ 
        pt - pu\ known\ 

            \(\((x\ and\ z\ coordinates\ only\ of\ course)\) . \)\ *) 

    ellodd[pt_, \ pu_, \ pv_]\  := \ 
	
      Block[
		{x1\  = \ pt[\([1]\)], \ z1\  = \ pt[\([2]\)], 
		\ 
          x2\  = \ pu[\([1]\)], \ z2\  = \ pu[\([2]\)], 
		\ 
          xx\  = \ pv[\([1]\)], \ zz\  = \ pv[\([2]\)], \ i, \ j
		\ }, 

        \ \ 	\ \ \ \ \ 
        i\  = \ Mod[
            zz\ \((\((x1\ x2\  - \ a\ z1\ z2)\)^2\  - 

                  \ \ 	\ \ \ \ \ \ \ \ \ \ 	
                  4\ b \((x1\ z2\  + \ x2\ z1\  + \ c\ z1\ z2)\)\ z1\ z2)\), 
            \ 
\ \ 	\ \ \ \ \ \ \ \ \ \ 	p
\ \ 	\ \ \ \ \ \ \ \ \ ]; 

        \ \ 	\ \ \ \ \ j\  = \ Mod[xx\ \((x1\ z2\  - \ x2\ z1)\)^2, \ p]; 

        \ \ 		\ {i, j}
	]; 

    
 (*\ Now, \ the\ main\ routine, \ elliptic\ multiply\ [k] \(pt . \)\ *) 
      
elliptic[pt_, \ k_]\  := \ 
	
      Block[{porg, \ ps, \ pp, \ q}, 
		If[k\  == 1, \ Return[pt]]; 
		
        If[k\  == 2, \ Return[elleven[pt]]]; 
		porg\  = \ pt; 
		
        ps\  = \ elleven[pt]; 
		pp\  = \ pt; 
		
        bitlist\  = \ Reverse[IntegerDigits[k, 2]]; 
		
        Do[	\ \ \ 
	\ \ \ 		
          If[bitlist[\([q]\)]\  == \ 1, 
	\ \ \ 	\ \ \ 		
            pp\  = \ ellodd[ps, \ pp, \ porg]; 
	\ \ \ 	\ \ \ 		
            ps\  = \ elleven[ps]
	\ \ \ 	\ \ \ 		, 

            	\ \ \ 	\ \ \ \ \ \ 	ps\  = \ ellodd[pp, \ ps, \ porg]; 

            		\ \ \ \ \ 	pp\  = \ elleven[pp]
	\ \ \ 		]

          	\ \ \ 		, 

          	\ \ \ 		{q, \ Length[bitlist] - 1, \ 1, \ \(-1\)}
\ \ \ \ 	]; 
        
\ \ \ \ 	Return[Mod[pp, p]]
	]; 

    
 (*\ Next, \ 
      we\ include\ algorithm\ 2.3  .8\ for\ finding\ square\ roots\ 
modulo\ 
        a\ prime\ \(p . \)\ *) 


    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]]; \ 
	]; 

    
 (*\ Next, \ a\ function\ relevant\ to\ Algorithm\ 7.2 \( .8 . \)\ *) 

    
ellXadd[x1_, x2_] := 
	
      Module[{u2, v, g}, 
		g = x1 - x2; 
        
		den = PowerMod[g, \(-2\), p]; 
        
		
        alpha = Mod[
            \((\((x1\ x2 + a)\) \((x1 + x2)\) + 2  c\ x1\ x2 + 2  b)\), p]; 
        
		
        beta = Mod[\((\((x1\ x2 - a)\)^2 - 4  b \((x1 + x2 + c)\))\), p]; 
        
		disc = Mod[alpha^2 - beta\ g^2, p]; 
        
		{\ \ 
          Mod[\ den*\((alpha + sqrtmod[disc, p])\), p], \ 
		\ \ \ \ 
          Mod[den*\((alpha - sqrtmod[disc, 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; 
c\  = \ 0; \ \  (*\ Montgomery\ \(parameter . \)\ *) 

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

    pubpointtwist\  = 
      \ {1173563507729187954550227059395955904200719019884, 1}; 


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


    pubkey\  = \ \ \ elliptic[pubpoint, \ kb]; 
    \ \ \ \ \ \ \ \  (*\ Public\ key\ \(P_B . \)\ *) 

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

    encryptEmbed[x_] := \ 
      Module[{cubic, \ curve, \ X\  = \ x, \ pbk, \ pbp, \ clueX, \ X2, \ uX, 
          
		\ \ piece, \ try, \ sign}, 
        
 (*\ First, \ 
          let\ us\ determine\ which\ curve . \ 
		\ \ \ EITHER\ X\ lies\ in
              \ the\ curve\ y^2\  = \ X^3\  + \ c\ X^2\  + \ a\ X\  + \ b, 

          		\ \ \ 
          or\ on\ g\ y^2\  = \ X^3\  + \ c\ X^2\  + \ a\ X\  + \ b\ *) 

        		\ cubic\  = \ Mod[X\ Mod[X^2\  + c\ X\  + \ \ a, p]\  + \ b, p]; 
        
		\ If[JacobiSymbol[cubic, \ p]\  > \ \(-1\), \ 

          			\ \ \ \ \ \ curve\  = \ 1; \ pbk\  = \ pubkey; \ 
          pbp\  = \ pubpoint, 			\ \ \ \ \ \ 
				\ \ \ \ \ 
          curve\  = \ \(-1\)\ ; \ pbk\  = \ pubkeytwist; \ 
          pbp\  = \ pubpointtwist; \ 
		\ \ ]; 
		
			
        r\  = \ Random[Integer, \ {2, p - 2}]; 		\ \ 
			
        clueX\  = \ ex[elliptic[pbp, \ r]]; 
		\ \ 
        X2\  = \ ex[elliptic[pbk, \ r]]; 
        \  (*\ We\ shall\ be\ adding\ the\ points\ having\ X, \ X2, \ 
          and
					\ \ \ there\ is\ a\ sign\ ambiguity\ a\ la\ Algorithm
              \ 7.2  .8\ because\ Y - 
            coordinates
						\ \ are\ being\ \(avoided . \)\ *) \ 

        		\ \ \ uX\  = \ \(ellXadd[X, \ X2]\)[\([1]\)]; 
		

        		 (*\ Next, \ 
          feedback\ loop\ to\ determine\ which\ value\ of\ sign\ recovers\ 
            \(plaintext . \)\ *) 
		
		\ \ \ 
        piece\  = \ ex[elliptic[{clueX, 1}, \ kb]]; 		\ 
		\ \ \ 
        try\  = \ ellXadd[uX, \ piece]; 

			\ 
        If[	try[\([1]\)]\  == \ X, \ sign\  = \ 1, 

          			\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
          If[try[\([2]\)]\  == \ X, \ sign\  = \ \(-1\), \ Print["TILT!"]]
            
			]; 				\ \ \ \ \ \ \ \ 

        		\ \ {uX, \ clueX, \ curve, \ sign}
]; 
    


    decryptEmbed[cipherList_] := \ 
      Module[{uX\  = \ cipherList[\([1]\)], \ 
          clueX\  = \ cipherList[\([2]\)], \ curve\  = \ cipherList[\([3]\)], 
          \ sign\  = \ cipherList[\([4]\)]}, 
		\ \ \ 
        piece\  = \ ex[elliptic[{clueX, 1}, \ kb]]; 		\ 
		\ \ \ 
        try\  = \ ellXadd[uX, \ piece]; 
		\ \ \ 
        X\  = \ try[\([\((3 - sign)\)/2]\)]; 
			X
]; 
    

\)\)

\(\( (*\ EXAMPLE\ *) \ 


      ciph\  = \ encryptEmbed[plain\  = \ Random[Integer, p - 1]]; 

      If[decryptEmbed[ciph]\  != \ plain, \ Print["TILT!"]], {ct, 1, 10}]
      \)\)

p

CC

6277101735386680763835789423207666416083908700390324961279