雑記帳

単純な有限体を使った暗号化ごっこ

【DISCLAIMER】
学生時代の卒研のゼミで聞いた先生の雑談がベースになっていて、僕自身暗号理論には全く詳しくないので、その旨ご了承を。
(ただ、その時聞いた話が僕的にはわかりやすく、是非その知識もここで共有しておきたいなということで、その時聞いた話をそのまま小ネタノートにまとめている次第です。)
事前知識
まず要素数7の型を定義してその上に加減乗除を定義する
data Finite_7 = Finite_7 (Either (Either (Either (Either
  (Either (Either () ()) ()) ()) ()) ()) ()) deriving (Eq)

f7 = (id :: Finite_7 -> Finite_7)

f7_0 = Finite_7 (Left(Left(Left(Left(Left(Left()))))))
f7_1 = Finite_7 (Left(Left(Left(Left(Left(Right()))))))
f7_2 = Finite_7 (Left(Left(Left(Left(Right())))))
f7_3 = Finite_7 (Left(Left(Left(Right()))))
f7_4 = Finite_7 (Left(Left(Right())))
f7_5 = Finite_7 (Left(Right()))
f7_6 = Finite_7 (Right())

f7ToInt (Finite_7 x) =
  case x of
    Left(Left(Left(Left(Left(Left()))))) ->
      0
    Left(Left(Left(Left(Left(Right()))))) ->
      1
    Left(Left(Left(Left(Right())))) ->
      2
    Left(Left(Left(Right()))) ->
      3
    Left(Left(Right())) ->
      4
    Left(Right()) ->
      5
    Right() ->
      6

f7_quotTable :: [Finite_7]
f7_quotTable = do
  (x,y) <- prod [0..6] [0..6]
  if x*y == 1 then
    return y
  else
    []

prod x y = x >>= (\el -> zip (repeat el) y)

instance Show Finite_7 where
  show x = show $ f7ToInt x

instance Num Finite_7 where
  fromInteger i =
    case i `mod` 7 of
      0 -> f7_0
      1 -> f7_1
      2 -> f7_2
      3 -> f7_3
      4 -> f7_4
      5 -> f7_5
      6 -> f7_6
      _ -> f7_0

  (+) x y =
    fromInteger $ f7ToInt x + f7ToInt y

  (*) x y =
    fromInteger $ f7ToInt x * f7ToInt y

  abs = id

  signum x = 1

  negate x =
    fromInteger $ negate (f7ToInt x) `mod` 7


instance Enum Finite_7 where
  toEnum   = fromInteger . fromIntegral
  fromEnum = fromIntegral . f7ToInt


instance Fractional Finite_7 where
  recip x =
    let
      i = f7ToInt x
    in
      if i `elem` [1..(7-1)] then
        f7_quotTable !! (i - 1)
      else
        undefined
  fromRational x = fromIntegral . round $ fromRational x
aaa
f7 という関数は一見無意味なものに見えるが、数値リテラルを Finite_7 型として型推論させるのに役立つ。
以下はその使用例。
ghci> f7 $ 1+1
2
ghci> f7 $ 2*2
4
ghci> f7 $ 5+2
0
ghci> f7 $ 3-1
2
ghci> f7 $ 3-5
5
ghci> f7 $ (3-5)+5
3
ghci> f7 $ 2*5+2
5
ghci> f7 $ 3^2
2
ghci> f7 $ 4/2
2
ghci> f7 $ 6/2
3
ghci> f7 $ 5/2
6
ghci> f7 $ (5/2)*2
5
aaa
この抽象的な数の構造の何が面白いのかといえば、「割り算」が定義できることである。
続いて要素数を 4091 個まで増やして同じことを考えたいが、先ほどの Finite_7 と同様にして「終対象同士の余積を(4091-1)回とって得られる型」を出発点に考えるというのは、できないことはないが常軌を逸している。
余談
本来であれば数学の世界で行われるような、コイコライザを用いた「この種の抽象的な数の構造を与える写像が建つ土台となる集合」の通常の構成方法に倣って構成したいのだが、残念ながら Haskell の関数たちが作る世界の中ではそのようなことはできない。
そういうわけで、先ほどは濃度7の集合の代替となるような「要素数が7である型」を余積を使って構成し、その要素と整数を無理やり関係付けてみた。
(本来は「濃度が7であること」よりも、「succ と 大域要素 zero をコンテクストに伴う自然数対象を出発点に、2度の普遍的構成を経て構成されてきた特定の普遍射をコンテクストに伴う対象であること」の方が大切である)
aaa
data Finite_4091 = Finite_4091 (Integer) deriving (Eq)

f4091 = (id :: Finite_4091 -> Finite_4091)

f4091ToInt :: Finite_4091 -> Integer
f4091ToInt (Finite_4091 i) = i

intToF4091 :: Integer -> Finite_4091
intToF4091 = fromInteger

f4091_quotTable :: [Finite_4091]
f4091_quotTable = do
  (x,y) <- prod [0..(4091-1)] [0..(4091-1)]
  if x*y == 1 then
    return y
  else
    []

prod x y = x >>= (\el -> zip (repeat el) y)


instance Show Finite_4091 where
  show x = show $ f4091ToInt x

instance Num Finite_4091 where
  fromInteger i = Finite_4091 (i `mod` 4091)

  (+) x y =
    fromInteger $ f4091ToInt x + f4091ToInt y

  (*) x y =
    fromInteger $ f4091ToInt x * f4091ToInt y

  abs = id

  signum x = 1

  negate x =
    fromInteger $ negate (f4091ToInt x) `mod` 4091


instance Enum Finite_4091 where
  toEnum   = fromInteger . fromIntegral
  fromEnum = fromIntegral . f4091ToInt

instance Fractional Finite_4091 where
  recip x =
    let
      i = fromIntegral $ f4091ToInt x
    in
      if i `elem` [1..(4091-1)] then
        f4091_quotTable !! (i - 1)
      else
        undefined
  fromRational x = fromIntegral . round $ fromRational x
blah
(GHCi で実行する場合、f4091_quotTable の要素が参照されて初めてそのインデックスまでのリストが生成されるため、その表データの大部分の生成が要求されることになる decrypt の初回実行時は多くの時間を要する場合が多い。但し一度表データの計算が済んだそれ以降はその表データがキャッシュされるのか実行速度は大幅に向上する。)
blah
AさんがBさんに誰もが読むことが可能な掲示板を介して、秘密のメッセージのやり取りを行うことを考える。(もしくは、通信が傍受されている状態で、生データのやり取りを行うの方がわかりやすいかな aaa)
1. まず Aさんが公開する鍵 w と秘密の鍵 a を 上で定義した 0以外の Finite_4091 型の数字としてそれぞれ適当に考える
2. Aさんが、「w と \(w^a\)」の値の対を掲示板に書き込む
3. 続いてBさんもBさん側で適当に1つ秘密の鍵を 0以外の Finite_4091 型の数字として考える。
4. Bさんが、「\(w^b\)」の値を掲示板に書き込む
5. Aさんは「\((w^b)^a\)」、Bさんは「\((w^a)^b\)」という値を計算する
6. 2人の間で「\(w^{a\cdot b}\)」という値が共有される。
7. Aさんがその共有された Finite_4091 型の数字を使って、文章を適当に暗号化し、その暗号化された文字列を掲示板上に書き込む
8. Bさんがその共有された Finite_4091 型の数字を使って、掲示板上に書き込まれた暗号された文字列を解読する
有限体の持つ対数の計算 (離散対数) が困難であること (離散対数を効率的に解くアルゴリズムが現状見つかってない?) を信用し、「離散対数を計算しない限り各々が保有する秘密のカギを第三者が取得することはできない」という状況の下で、同じ鍵を共有ための手続きを公の場で行っているわけであるが、「要素が有限」である以上 Brute-force で攻める要素の数が少ないと、簡単に鍵が第三者に取得されてしまう。
例えばこの場合、使用している有限体の要素数は (理想的には) 4091 個であるので、0 から 4090 まで総当たりをすれば、公開されている鍵と、その公開されている鍵で解読しづらくした上で一緒に公開したAさんが所有している秘密の鍵の2つの情報からAさんが持つ秘密の鍵を求めることができてしまう。
デモ
■ 掲示板上でのやり取り
[1] Aさん:
(1922, 901)
[2] Bさん:
1310
[3] Aさん:
77104425597907171809503472347757382245200701302774833562681845880713480977833068391838846150030892915122782575738612968074413396903990886923672447103874151206263134727824722798692318436991702469242672191493360359987248582193438948809795896940464044070409377478392930246281390913700730282168691655364692373722836927798480599321336888512009679063914286311
■ Aさんサイド
1. なんとなく「公開用の鍵: 1922, 自身の秘密の鍵: 2095」と決める。
2. 冪 \(1922^{2095}\) を計算させたら 901 が出力された。ということで、掲示板に (1922,901) を書き込む。
ghci> f4091 $ 1922^2095
901
3. Bさんからの応答を待つ。
4. 暗号化されたBさんの秘密の鍵の情報 q(=2467) が掲示板に書き込まれたら、\(q^{2095}\) を計算する。結果1310になった。
ghci> f4091 $ 2467^2095
1310
5. 鍵 1310 を使って適当にメッセージを暗号化し、その暗号化により得られた文字列を掲示板に投稿する。
ghci> encrypt "Hi, I'm looking forward to hanging out with you next Saturday!" [1310]
"77104425597907171809503472347757382245200701302774833562681845880713480977833068391838846150030892915122782575738612968074413396903990886923672447103874151206263134727824722798692318436991702469242672191493360359987248582193438948809795896940464044070409377478392930246281390913700730282168691655364692373722836927798480599321336888512009679063914286311"
■ Bさんサイド
1. なんとなく「自身の秘密の鍵: 221」と決める。
2. Aさんが掲示板に公開用の鍵を書き込むのを待つ。
3. 公開用の鍵と暗号化されたAさんの秘密の鍵の情報 p(=901) が書き込まれたら、まず\(p^{221}\) を計算する。結果 1310 になった。
ghci> f4091 $ 901^221
1310
4. 続いて冪 \(1922^{221}\) を計算する。結果 2467 が得られたので、それを掲示板に書き込む。
ghci> f4091 $ 1922^221
2467
5. Aさんが暗号化した文字列を投稿するのを待つ。
6. Aさんが投稿した暗号を、鍵 1310 を使って復号する。すると「Hi, I'm looking forward to hanging out with you next Saturday!」というメッセージが得られた。
ghci> decrypt "77104425597907171809503472347757382245200701302774833562681845880713480977833068391838846150030892915122782575738612968074413396903990886923672447103874151206263134727824722798692318436991702469242672191493360359987248582193438948809795896940464044070409377478392930246281390913700730282168691655364692373722836927798480599321336888512009679063914286311" [1310]
"Hi, I'm looking forward to hanging out with you next Saturday!"
第三者の視点から暗号文を解読する #1
先ほどのやり取りを何も知らない第三者が見れば通常は「なにやってるんだろう...」で終わってしまうかもしれないが、実はこの程度の脆弱な暗号化ならば簡単に解読することが可能である。
特に、ここでは暗号化や復号化に用いている関数はオープンソースにしてしまっているため、尚更難しいことを考えることなしに解読される。
まず一つ目の方法は、誰もが思いつく力技で
「掲示板上に書き込まれた暗号化された文章に対して、とりあえずよくわからないけど様々な鍵で復号化をかけて強引に暗号化される前の文章を総当たりで探し出す」
という方法。(俗にいう Brute-force method)
以下 1から4090までの全ての鍵を使って総当たりで解読するコード
let f i = (decrypt "77104425597907171809503472347757382245200701302774833562681845880713480977833068391838846150030892915122782575738612968074413396903990886923672447103874151206263134727824722798692318436991702469242672191493360359987248582193438948809795896940464044070409377478392930246281390913700730282168691655364692373722836927798480599321336888512009679063914286311" [i]) in (foldr (>>) (return ()) $ do{i<-[1..4090];return(putStrLn $ show i ++ ": " ++ f i)})
出力を全て表示するとページが非常にごちゃごちゃになってしまうので、1300 から 1350 までの範囲の出力だけ切り取ったものを載せておく。上に書いてあるように 1310 が暗号化に用いた鍵であり、行頭の数字が「1310」になっている行を見てみると、暗号化したメッセージが見つけられてしまっている。
1300: \ct-{3n-_orz+\-z+O-_t`o$[ln-zL_lz3\rnV!Cz+{+
1301: [+i_l4zlnsu`5[lot[{[#Kro r\\Y\r\3ztKr~r\5_l{
1302: Px[l)Xt`yu~rKx3PlK+o4/*QfN</8kz-kk5_-lT/Wlk+~-&/rz5`+Kt[
1303: _l[m\;+Kp;5'{3~sSHR4Onm,+ 5U$(n5n-NS5P+`"vtK
1304: \rk5zo{tz`A+zk3"boe@S_-L+zLt{g|}+1sr3{t
1305: 5OKor[k'dO+~+`+"Emp~%Kr_>&k\5\Nlnl[JM_5Pr[4\`nox
1306: .jFwq=\-K+_r\-1x^+PrK5My<5l{q+n{,oyi@t`+\+`-O+\*
1307: nKx;7(ro-j0t{BA1o+_[~lzra%n+~\([krn-n|qtv
1308: oXbOL-^HEzl~$3[to5{t\l +r_j-~k3L33)/lz5z
1309: =~k_o[zt +lrl\[Llo5X+{5 tO+k-3le~M-kM|
1310: Hi, I'm looking forward to hanging out with you next Saturday!
1311: rkt~h3tK3\ :+Otr +niHz |5~ $i'\`+_+'PovB|3nnnFPrPT{
1312: M* ~nq!nr[tK[!p_+K3OrLr-ztK3 ozt}W-nw!_l5Kn)
1313: %2=/ k-kry#mLn t~3lPy3n+Llk-[ -zlrtKkLnW
1314: XtyW!AcbuztOC"P?ZsrK-vw?x5L1SU/tK 5N {lL-t!MlorgCx}t
1315: 5z+-" &`3Y +{uDnkvGOr +k+`lo+lz!rl~5ol\-zk
1316: m-Kk-lKmEn3Pz-B|7llnl";cKk:<Y[+\tKt rtnu>\OxyQv
1317: + +`-`rk3VLtlkr_zlO+OB*yu[LB5_-_lktL5~5[rh_!Ty3[Pa
1318: 5{-nr-=sr-{+nlE;[r\rPK-K3 +~K5L/od{K~t`n
1319: zrKr`-n~ H)m_+\{5L5nl~k3[lk`%}wa~ong]*~+Kt{3[-k
1320: o|WUQHk5!nrnlzr\tk3S[mW}>'klzlOry~+ +zzlo-[o/6@|.tz
1321: 5 -KK5zy\-"2imPlLroU`rt[Au`nlDe~+o,No+nq
1322: -kkQ rqk3~r'kt +{ytOlkO:vu#nsn+k8:5ktK+n-`5\3LtLl(s
1323: +k,!8+Kr4X|SITrz-[rOt!LG3[Pl~[-O[~sg1LR!+~0pmzxMK5k5O+
1324: Fr3f%lkl{lc{tor{_l+_[4rK5~_53O{-_{-ro(++
1325: +klPtPtKrY2Ukt[o-z3`5HE(+[c[]?'AK;tl\7K[3`t{{
1326: +k+}T~lmK+~tP+z3{Olu3[{>1o-KL5`3 +tK-`-Aktkn
1327:  r[t&Pm{tD_rOs'\+lollto3~kKro3&=8/p5E^(5L
1328: -`lKlq:pCz3 l~3z9qClKtOt& 55n%+rL} H:P3kV+
1329: -Kl_rP9#^LrK3rP6+|R:#-4Rwr{-[ 5/<p}~O.
1330: Z_+K+luL5`tM-rzr .$V[ tOkr~PP
1331: J?x= 3{rKln0:k[l+Pl$O.sl_r1/l_3lPwq!ck-~t`z
1332: \sQQ[tL3[\roK{G+k5_|t'kknrKl\6a#l+nn+5\t~
1333: _s5Ot~{-olo5KlL3Or_+rzc~lRoOl_z+o%P`{=$K{o3
1334: {i?zklN|T"?'p)^rkW/+O3efkO+Pt_bt,`!@Ih^?#K\lK
1335: 5~{ol-o8KuI[3l\-q{pLpl3z3|5K\3Ko/Ih+n+[+nr
1336: r!PX.vybe~5(,(kL@9-K-ko)#z+L |iN\t`-+Er$ 5 +~m!_l~s0
1337: tPl[5";lKnrvBestO5Rl5~m5_3yq*PKz~S\3ar3Lt\+Pkkr+[|
1338: klP5`zk-Oll@uln-[3+Lk3ljU#\3#a*r5K5{z
1339: 5ztn 4r;!+~z]k5{-{tp$lkt\rE5L-_l~3or  +)v Ort
1340: `6z[lkrK3\t`tK5k+`al\1PEO+tP:PkE{h5P3Lz5Pl3X'3o
1341: `lolO+`+tw{r5OOt[klk`1%z`~3_k+K7lKr=83
1342: +zl3P3LiOr_5LOrL-[VjkKK3`Zys_`-[klk3r{3zz~zo
1343: l]Kk5n+z+3{kz+`{Uo5~r{tz+OP-[n3_ 3`+o
1344: ~o5{-K3Qchrk+qt\trOlaW# rL-{O ;+Fo+
1345: k3cKp~[Mt~)6unP[zlLl-{+n* o9>1krx;lPt[+K5l;-K
1346: k+z3on3MyhMsr`3lO=5Kmmg~XlK5Iornle{zJ Vn
1347: [3nla`Glnz*sL5ns5Pm2&/rKotwk5~5k+~+\-[+3k+Oo-\-K3
1348: ntzk+m&3Ezry%F++[rrorL-K5z&H|[l[+_r 3 n
1349: ko+#\5+[+f@~ClK -~k3 3r!dqS{5n-ot_klnlKt 5pl/r
1350: +k}L5C)&[lZwUKt"[upCo{-nlKrRl'dp.{lk3O+o+~5k+n}u_ -
第三者の視点から暗号文を解読する #2
先ほどは、暗号化された文章に対して、使用され得る全ての鍵を一つずつ使って総当たりで解読するという方法をとったが、そもそも「離散対数」の方を力技で求めてしまう方が、より確実かつシンプルに解読することができてしまう。
この方法は「鍵を行列にすることで少し複雑にしたバージョンの暗号文」に対しても有効なので、実際に離散対数を求めることで以下の謎のやり取りを解析する例を紹介する。
■ 掲示板上でのやり取り
[1] Aさん:
([1922,123,234,345], [957,2421,3608,1747])
[2] Bさん:
[2471,1541,3231,1938]
[3] Aさん:
539952015664944056884679006621635438025012612196690463284025690034444996909444080712637025364478125086313720131947018520211842297151992005605032221602604818770751095081071038528110758818254716239207122450746056039972004091122563205525514643586760435059069270705834087325374645175923517617047722706283773835970740111365833784870503944952569
見ての通り、公開用の鍵が行列になってしまったことで、先ほどのような暗号文を総当たりで解読するためには、4090 回の行列積の計算をするか、200兆以上にも及ぶ鍵の全パターンを直接愚直に調べることなどが必要となる。
とはいえ、行列の理論を少しかじっている人からすればわかるように、
\[ \det(W^a) = (\det W)^a \]
という関係式が成り立ってしまうため、この事実を上手く使えば、行列が使用されていたとしてもAさんの持つ鍵を先ほどの行列でないバージョンと同様の手間 (単なる4090回のF4091型の数の冪の総当たり) で求めることができる。(見方を変えれば行列演算というのは、非常に良い性質を持つ整然としたものということ)
まず、公開用の鍵 \(W\) として与えられている行列のデターミナントを求める。
ghci> f4091 $ mat2_det [1922,123,234,345]
203
続いて、公開されているAさんの鍵の情報を含んだ行列 \(W^a\) のデターミナントも求める。
ghci> f4091 $ mat2_det [957,2421,3608,1747]
2068
この時、行列の理論より
\[ 2068 = 203^a \]
が成り立つわけなので、この離散対数を総当たりで解いてしまう。
ghci> ([1..4090]) >>= (\a -> if (f4091 $ 203^a) == 2068 then return a else [])
[2095]
実際に実行してみればわかるが、総当たりする数が非常に少ない分、1秒もかからぬ間にAさんの持つ鍵「2095」が取得できる。
あとは、Bさんが公開している \(W^b\) を用いて \((W^b)^a\) を求めれば、AさんとBさんが共有している秘密の行列が以下のようにして第三者によって取得されることになる。
ghci> mat2_power [2471,1541,3231,1938] 2095
[1752,2790,219,1902]
得られた鍵を復号化用の関数の引数に渡してあげれば解読が完了である。
ghci> decrypt "539952015664944056884679006621635438025012612196690463284025690034444996909444080712637025364478125086313720131947018520211842297151992005605032221602604818770751095081071038528110758818254716239207122450746056039972004091122563205525514643586760435059069270705834087325374645175923517617047722706283773835970740111365833784870503944952569" [1752,2790,219,1902]
"Hi, I'm looking forward to hanging out with you next Saturday!"
あああ
解読を困難にしたバージョン
以下の解読を困難にさせる小細工を2点追加する
・掲示板上でのやり取りに使用する有限体のサイズを超巨大にする。具体的には \(2^{1279}-1\) 個にしたため、1つ当たりの計算に要する時間を \(3.3 \times {10}^{-12}\) 秒程度と見積もったとしても、総当たりに要する時間は1000億年とかそういう次元ではなく、\(1.1\times 10^{366}\) 年以上かかる。
・計算コストの大きい「鍵から行列を生成する関数」を用いて、共有した鍵それ自体ではなく、その関数を使って生成される行列を使って暗号化を行うことで、さらに総当たりを困難にする。(ちなみに僕の低スペックPCでは、genKeyで行列を生成するのに約3分程かかる。)
デモ2
■ 掲示板上でのやり取り
[1] Aさん:
(4323660658413665489080977455466615497073106608077519640809706763820186332620788656758741789002187781595198884215013494760277552450616114631113576227143502163034487326597845146330310725669364369699748371318511148719875220313497756298210351781962441303719564955995442174543341836373679265902025706861082632346368148860660622356381268504010225960524119642588524926836809055023993016893532, 1175855229597196446878480308674346474763046389543454835786303271587723196048831914149979453653667682477461314330661270893548199529474235759058370781105864075516242415006660186946845246923980894460902623461890150947816416893965168105879489549019777451334246881978826680077308090414337797608249485351730609439660449684476459749605583731332585396678702463344060876882351958243600266196237)
[2] Bさん:
10000256990836362893781679900109303280442746199821157549001109860448412434663150994106301540761533547769345659005910567449724927678590208297522613227036057729078868993543753424758520181952969391227400328672211669820819149526881069071770473517438047270212435633014303915300913566029877423724136154875994784999931086520700730228927074384068502705612450326567545875558766779951703772288849
[3] Aさん:
939972568540494443828708307317605838113392940345463723986715421081375238506544033374443226384497335743802157880451152405907075954468467801144133764650587598933597092227375563492957261939152259552988399270536372921406619140527893809092573658384701863758017243134841506151239163895021150225172273772520291946817259651853214854192254897
■ Aさんサイド
1. なんとなく「公開用の鍵: (1922^1922 mod 2^1279-1), 自身の秘密の鍵: (2095^2095 mod 2^1279-1)」と決める。
2. 公開用の鍵と以下の計算の出力の対を掲示板に書き込む。
ghci> fmersenne1279 $ 4323660658413665489080977455466615497073106608077519640809706763820186332620788656758741789002187781595198884215013494760277552450616114631113576227143502163034487326597845146330310725669364369699748371318511148719875220313497756298210351781962441303719564955995442174543341836373679265902025706861082632346368148860660622356381268504010225960524119642588524926836809055023993016893532 ^ 2028460873374517296103136460295843352220357324581594061123588900685422375914481879533540489943354218974188397523053357252366047367062114026024271202777628133915073666162235780740359711222224633601241649570003478396620388857590416043942974918481547367647902913758617947290719510917371194429365271499493528594632213225897857505927952437303649181332728532952430632255392464005760749266369
1175855229597196446878480308674346474763046389543454835786303271587723196048831914149979453653667682477461314330661270893548199529474235759058370781105864075516242415006660186946845246923980894460902623461890150947816416893965168105879489549019777451334246881978826680077308090414337797608249485351730609439660449684476459749605583731332585396678702463344060876882351958243600266196237
3. Bさんからの応答を待つ。
4. 暗号化されたBさんの秘密の鍵の情報 q が掲示板に書き込まれたら、以下を計算する。
ghci> fmersenne1279 $ 10000256990836362893781679900109303280442746199821157549001109860448412434663150994106301540761533547769345659005910567449724927678590208297522613227036057729078868993543753424758520181952969391227400328672211669820819149526881069071770473517438047270212435633014303915300913566029877423724136154875994784999931086520700730228927074384068502705612450326567545875558766779951703772288849 ^ 2028460873374517296103136460295843352220357324581594061123588900685422375914481879533540489943354218974188397523053357252366047367062114026024271202777628133915073666162235780740359711222224633601241649570003478396620388857590416043942974918481547367647902913758617947290719510917371194429365271499493528594632213225897857505927952437303649181332728532952430632255392464005760749266369
6571614399873915587342692495972514337492966820048792693806377276012879009385414845403374895571041946291598922348582531257268942031677900777680698213737491990854439042904255963314645553145417252605974110171616086580870378589558165246052443793036553738656227091824868274806345505329628963423418430522131063517389822494797573439803974117478714075398344667709454745563154316833922558248055
5. 上の鍵から行列を生成する。
ghci> genKey 6571614399873915587342692495972514337492966820048792693806377276012879009385414845403374895571041946291598922348582531257268942031677900777680698213737491990854439042904255963314645553145417252605974110171616086580870378589558165246052443793036553738656227091824868274806345505329628963423418430522131063517389822494797573439803974117478714075398344667709454745563154316833922558248055
[1810,635,3663,3105,472,4053,3379,1887,2319,3533,1424,185,2884,2512,2521,1340,1416,3777,2229,3413,4032,3147,1497,2725,227,745,3434,3997,2753,2902,2482,4008,473,2637,2169,35,2100,3878,2915,264,3769,819,1125,1972,579,187,3740,141,3451,949,979,3491,2579,2504,2223,2933,1340,915,187,1231,3161,2590,3492,599]
6. 生成した行列を使って適当にメッセージを暗号化し、その暗号化により得られた文字列を掲示板に投稿する。
ghci> encrypt "Hi, I'm looking forward to hanging out with you next Saturday!" [1810,635,3663,3105,472,4053,3379,1887,2319,3533,1424,185,2884,2512,2521,1340,1416,3777,2229,3413,4032,3147,1497,2725,227,745,3434,3997,2753,2902,2482,4008,473,2637,2169,35,2100,3878,2915,264,3769,819,1125,1972,579,187,3740,141,3451,949,979,3491,2579,2504,2223,2933,1340,915,187,1231,3161,2590,3492,599]
"939972568540494443828708307317605838113392940345463723986715421081375238506544033374443226384497335743802157880451152405907075954468467801144133764650587598933597092227375563492957261939152259552988399270536372921406619140527893809092573658384701863758017243134841506151239163895021150225172273772520291946817259651853214854192254897"
■ Bさんサイド
1. なんとなく「自身の秘密の鍵: (221^221 mod 2^1279-1)」と決める。
2. Aさんが掲示板に公開用の鍵を書き込むのを待つ。
3. 公開用の鍵と暗号化されたAさんの秘密の鍵の情報 p が書き込まれたら、まず以下を計算する。
ghci> fmersenne1279 $ 1175855229597196446878480308674346474763046389543454835786303271587723196048831914149979453653667682477461314330661270893548199529474235759058370781105864075516242415006660186946845246923980894460902623461890150947816416893965168105879489549019777451334246881978826680077308090414337797608249485351730609439660449684476459749605583731332585396678702463344060876882351958243600266196237 ^ 3551029248537572220953764050502353907927042443909892396214019906482177426188143177732788867491224159208965992482198301660510573657085302502961267222047520306558292119854145437605065482863860387926732989290781336749061930597144764577155153430541171864281867272130737318142045636928168320099363325988111231030449014412084303429199117702385108566841377926775030561287043466793646988766288
6571614399873915587342692495972514337492966820048792693806377276012879009385414845403374895571041946291598922348582531257268942031677900777680698213737491990854439042904255963314645553145417252605974110171616086580870378589558165246052443793036553738656227091824868274806345505329628963423418430522131063517389822494797573439803974117478714075398344667709454745563154316833922558248055
4. 続いて以下を計算する。そしてその結果を掲示板に書き込む。
ghci> fmersenne1279 $ 4323660658413665489080977455466615497073106608077519640809706763820186332620788656758741789002187781595198884215013494760277552450616114631113576227143502163034487326597845146330310725669364369699748371318511148719875220313497756298210351781962441303719564955995442174543341836373679265902025706861082632346368148860660622356381268504010225960524119642588524926836809055023993016893532 ^ 3551029248537572220953764050502353907927042443909892396214019906482177426188143177732788867491224159208965992482198301660510573657085302502961267222047520306558292119854145437605065482863860387926732989290781336749061930597144764577155153430541171864281867272130737318142045636928168320099363325988111231030449014412084303429199117702385108566841377926775030561287043466793646988766288
10000256990836362893781679900109303280442746199821157549001109860448412434663150994106301540761533547769345659005910567449724927678590208297522613227036057729078868993543753424758520181952969391227400328672211669820819149526881069071770473517438047270212435633014303915300913566029877423724136154875994784999931086520700730228927074384068502705612450326567545875558766779951703772288849
5. Aさんが暗号化した文字列を投稿するのを待つ。
6. 上で求めた鍵から行列を生成する。
ghci> genKey 6571614399873915587342692495972514337492966820048792693806377276012879009385414845403374895571041946291598922348582531257268942031677900777680698213737491990854439042904255963314645553145417252605974110171616086580870378589558165246052443793036553738656227091824868274806345505329628963423418430522131063517389822494797573439803974117478714075398344667709454745563154316833922558248055
[1810,635,3663,3105,472,4053,3379,1887,2319,3533,1424,185,2884,2512,2521,1340,1416,3777,2229,3413,4032,3147,1497,2725,227,745,3434,3997,2753,2902,2482,4008,473,2637,2169,35,2100,3878,2915,264,3769,819,1125,1972,579,187,3740,141,3451,949,979,3491,2579,2504,2223,2933,1340,915,187,1231,3161,2590,3492,599]
7. Aさんが投稿した暗号を、生成した行列を使って復号する。すると「Hi, I'm looking forward to hanging out with you next Saturday!」というメッセージが得られた。
ghci> decrypt "939972568540494443828708307317605838113392940345463723986715421081375238506544033374443226384497335743802157880451152405907075954468467801144133764650587598933597092227375563492957261939152259552988399270536372921406619140527893809092573658384701863758017243134841506151239163895021150225172273772520291946817259651853214854192254897" [1810,635,3663,3105,472,4053,3379,1887,2319,3533,1424,185,2884,2512,2521,1340,1416,3777,2229,3413,4032,3147,1497,2725,227,745,3434,3997,2753,2902,2482,4008,473,2637,2169,35,2100,3878,2915,264,3769,819,1125,1972,579,187,3740,141,3451,949,979,3491,2579,2504,2223,2933,1340,915,187,1231,3161,2590,3492,599]
"Hi, I'm looking forward to hanging out with you next Saturday!"
おまけ
おまけとして、今回使ったコードを載せておく。
使い捨てコードのつもりで書いたため、識別子名の付け方やコードの組み方は本当に乱雑で適当。
Haskell は標準モジュール (Prelude) だけでも色々なコードがかけるんだぞということを色々な人たちにも認識してほしくて、敢えてそれ以外のモジュールは一切読み込まずに書いた。(「暗号化・復号化の仕組みを実践的に理解するための玩具」なのでパフォーマンスのことは一旦置いておき、標準モジュール以外のモジュールを使わずに書いているけれど、「実用向けのツール」を Haskell で書きたいのであれば言うまでもなく用途に応じたモジュールを探して活用するのが得策。)
暗号化に用いた関数の説明
【encrypt 関数】
1. 文字と整数を結び付け、その対応を用いて文字列を整数のリストに変換する。この時、その整数の最大値を格納するのに必要になる最小ビット数をpiyopiyoとする。
2. そのリスト内の整数を全て「長さpiyopiyoの2進数表記した文字列」に書き換え、さらにそれらすべての文字列を連結させる。
3. あるビット数 piyopiyo2 があって、そのビットを使って表現可能な整数の最大値をオーバーフローさせることなく Finite_4901 型の数として読み取れるもの内、最小のものを求める。
4. 連結して得られた文字列内の1と0を全て反転させた後、vacuous(piyopiyo2) という関数 (詳細は後述) を用いてビット列の保護を行う。
5. piyopiyo2 毎にビット列を区切り、その区切られたビットをそれぞれ Finite_4091 型の数として読み取る。
6. 鍵 を k としたとき、得られた Finite_4091 型の数のリストの (i-1)番目の要素に k^(((i-1) mod 256)+1) を掛ける。
7. 掛け算を終えたリスト内の全ての数の総和をとる。
8. 「リストの i 番目の要素」を「リスト内にある i 番目以外の数を全て足し合わせた数 (つまりは総和から自身を引いた値)」に変換する。
9. リスト内のFinite_4091 型の数を全て (piyopiyo2+1) 長のビット列に変換し、それらを全て連結する。(piyopiyo2+1: Finite_4091 型の数の最大値が格納できる最小ビット数)
10. vacuous(piyopiyo2+1) を用いてビット列の保護を行う。
11. 保護処理が施されたビット列を32ビット毎に区切ってそれぞれを整数として読み取る。この時末尾に区切りの悪いビットが残る場合は、必要分をダミーの0で埋めたものを整数として読み取る。
12. リスト内の整数を固定幅の文字列に変換する。
13. それらの文字列を全て連結して得られる文字列の先頭に'1'を添えたものを整数として読み取る。
14. その整数を9で割った時の整数部と余りに分解し、その余りに1を加えた値を文字列化したものと整数部を文字列したものとを連結して得られる文字列が最終出力となる。
(変更を加えたので以下に載せてあるコードとは異なる点がいくつか存在する)
【vacuous 関数】
建前としては、「暗号化の過程で実行している Finite_4091 型の足し算引き算によってリスト末尾に零が現れる場合があるのだが、そうなるとその後ビットの末尾に添えられる可能性のあるダミーの零の羅列との区別が付けられなくなる。この関数はその問題を回避できるようにビット列を保護するもの」。でも必要な処理以外にも余計な処理を含めている。以下詳細。
1. 入力された文字列を奇数番目の文字と偶数番目の文字に分解し、それらを連結する。
2. 連結された文字列を (width-1)文字毎に区切る。この時末尾に区切りの悪い文字列が現れる場合は、その文字列を blah と置く。
3. 区切ったそれぞれ文字列の先頭に "1" を付けて再度連結する。(こうして得られる文字列を A と置く。)
4. blah が空でない場合、blah 内の文字 c をそれぞれ「c に '0' 以外の文字を1文字以上含むようなwidth-1の長さのダミー文字列を連結した文字列」に変換し、それらをさらに全て連結する。(こうして得られる文字列を B と置く。) その後、A と B を間に「width の長さの '0'」を挟んで連結する。
暗号化に用いた関数のソースコード
data Finite_7 = Finite_7 (Either (Either (Either (Either
  (Either (Either () ()) ()) ()) ()) ()) ()) deriving (Eq)

f7 = (id :: Finite_7 -> Finite_7)

f7_0 = Finite_7 (Left(Left(Left(Left(Left(Left()))))))
f7_1 = Finite_7 (Left(Left(Left(Left(Left(Right()))))))
f7_2 = Finite_7 (Left(Left(Left(Left(Right())))))
f7_3 = Finite_7 (Left(Left(Left(Right()))))
f7_4 = Finite_7 (Left(Left(Right())))
f7_5 = Finite_7 (Left(Right()))
f7_6 = Finite_7 (Right())

f7ToInt (Finite_7 x) =
  case x of
    Left(Left(Left(Left(Left(Left()))))) ->
      0
    Left(Left(Left(Left(Left(Right()))))) ->
      1
    Left(Left(Left(Left(Right())))) ->
      2
    Left(Left(Left(Right()))) ->
      3
    Left(Left(Right())) ->
      4
    Left(Right()) ->
      5
    Right() ->
      6

f7_quotTable :: [Finite_7]
f7_quotTable = do
  (x,y) <- prod [0..6] [0..6]
  if x*y == 1 then
    return y
  else
    []

instance Show Finite_7 where
  show x = show $ f7ToInt x

instance Num Finite_7 where
  fromInteger i =
    case i `mod` 7 of
      0 -> f7_0
      1 -> f7_1
      2 -> f7_2
      3 -> f7_3
      4 -> f7_4
      5 -> f7_5
      6 -> f7_6
      _ -> f7_0

  (+) x y =
    fromInteger $ f7ToInt x + f7ToInt y

  (*) x y =
    fromInteger $ f7ToInt x * f7ToInt y

  abs = id

  signum x = 1

  negate x =
    fromInteger $ negate (f7ToInt x) `mod` 7


instance Enum Finite_7 where
  toEnum   = fromInteger . fromIntegral
  fromEnum = fromIntegral . f7ToInt


instance Fractional Finite_7 where
  recip x =
    let
      i = f7ToInt x
    in
      if i `elem` [1..(7-1)] then
        f7_quotTable !! (i - 1)
      else
        undefined
  fromRational x = fromIntegral . round $ fromRational x



-- #################



data Finite_4091 = Finite_4091 (Integer) deriving (Eq)

f4091 = (id :: Finite_4091 -> Finite_4091)

f4091ToInt :: Finite_4091 -> Integer
f4091ToInt (Finite_4091 i) = i

intToF4091 :: Integer -> Finite_4091
intToF4091 = fromInteger

f4091_quotTable :: [Finite_4091]
f4091_quotTable = do
  (x,y) <- prod [0..(4091-1)] [0..(4091-1)]
  if x*y == 1 then
    return y
  else
    []


instance Show Finite_4091 where
  show x = show $ f4091ToInt x

instance Num Finite_4091 where
  fromInteger i = Finite_4091 (i `mod` 4091)

  (+) x y =
    fromInteger $ f4091ToInt x + f4091ToInt y

  (*) x y =
    fromInteger $ f4091ToInt x * f4091ToInt y

  abs = id

  signum x = 1

  negate x =
    fromInteger $ negate (f4091ToInt x) `mod` 4091


instance Enum Finite_4091 where
  toEnum   = fromInteger . fromIntegral
  fromEnum = fromIntegral . f4091ToInt

instance Fractional Finite_4091 where
  recip x =
    let
      i = fromIntegral $ f4091ToInt x
    in
      if i `elem` [1..(4091-1)] then
        f4091_quotTable !! (i - 1)
      else
        undefined
  fromRational x = fromIntegral . round $ fromRational x


mersenne1279 = 2^1279-1
data Finite_mersenne1279 = Finite_mersenne1279 (Integer) deriving (Eq)

fmersenne1279 = (id :: Finite_mersenne1279 -> Finite_mersenne1279)

fmersenne1279ToInt :: Finite_mersenne1279 -> Integer
fmersenne1279ToInt (Finite_mersenne1279 i) = i

intToFmersenne1279 :: Integer -> Finite_mersenne1279
intToFmersenne1279 = fromInteger

instance Show Finite_mersenne1279 where
  show x = show $ fmersenne1279ToInt x

instance Num Finite_mersenne1279 where
  fromInteger i = Finite_mersenne1279 (i `mod` mersenne1279)

  (+) x y =
    fromInteger $ fmersenne1279ToInt x + fmersenne1279ToInt y

  (*) x y =
    fromInteger $ fmersenne1279ToInt x * fmersenne1279ToInt y

  abs = id

  signum x = 1

  negate x =
    fromInteger $ negate (fmersenne1279ToInt x) `mod` mersenne1279

instance Enum Finite_mersenne1279 where
  toEnum   = fromInteger . fromIntegral
  fromEnum = fromIntegral . fmersenne1279ToInt


encrypt :: String -> [Finite_4091] -> String
encrypt str keys =
  let
    piyo = sum keys
    keys' =
      if length keys == 1 then
        keys
      else
        keys >>= (\x -> return $ x^(f4091ToInt $ piyo-x))
    tmp  = (zip [0..] (repeat keys')) >>= (\(i,xs) -> (fmap (^(i`mod`256+1)) $ xs))
    foo00  = foldr (++) "" $ (fmap $ toBits piyopiyo . charToInt) $ str
    foo01  = vacuous piyopiyo2 . myNot $ foo00
    foo02  = divideList piyopiyo2 $ foo01
    foo03  = (fmap $ fromInteger . fromIntegral . fromBits piyopiyo2) $ foo02

    foo2 = zipWith (*) tmp foo03
    foo20 = sum foo2
    foo21 = do
      x <- foo2
      return $ foo20 - x
    foo22 = (fmap $ toBits (piyopiyo2+1) . f4091ToInt) $ foo21

    foo3 = vacuous (piyopiyo2+1) $ foldr (++) "" foo22
    foo34 = foo3
    foo4 = take ((4*8)*((length foo34 + (4*8-1)) `div` (4*8))) $ foo34 ++ (repeat '0')
    foo5 = divideList (4*8) foo4
    foo6 = (fmap $ show . fromBits (4*8)) foo5
    foo7 = length $ show (2^(4*8+1)-1)
    foo8 = (fmap $ \xs -> (replicate (foo7 - length xs) '0')++xs) foo6
    foo9 = reverse $ foldr (++) "" $ reverse foo8
    foo10 = read . efg . abc $ '1':foo9
    foo11 = (show $ foo10 `mod` 9 + 1) ++ (show $ foo10 `div` 9)
  in
    foo11


decrypt :: String -> [Finite_4091] -> String
decrypt dat keys =
  let
    piyo = sum keys
    keys' =
      if length keys == 1 then
        keys
      else
        keys >>= (\x -> return $ x^(f4091ToInt $ piyo-x))
    tmp  = fmap (1/) $ keys'
    tmp2 = (zip [0..] (repeat tmp)) >>= (\(i,xs) -> (fmap (^(i`mod`256+1)) $ xs))
    tmp3 = replicate piyopiyo '0'
    foo  = length $ show (2^(4*8+1)-1)
    foo00 = abc_inv . efg_inv . show $ ((read $ [dat!!0])-1) + 9*(read $ tail dat)
    foo2 = reverse . divideList foo . reverse . tail $ foo00
    foo3 = foldr (++) "" $ (fmap $ toBits (4*8) . read) foo2    
    foo4 = divideList (piyopiyo2+1) . vacuous_inv (piyopiyo2+1) $ foo3
    foo5 = (fmap $ intToF4091 . fromBits (piyopiyo2+1)) foo4

    foo51 =
      if null foo5 then
        0
      else
        sum foo5 / ((intToF4091 . fromIntegral $ length foo5) - 1)
    foo52 = foo5
    foo53 = do
      x <- foo52
      return $ foo51 - x

    foo7 = (fmap $ f4091ToInt) (zipWith (*) tmp2 foo53)
    foo8 = foldr (++) ""  $ (fmap $ toBits piyopiyo2) foo7
    foo9 = divideList piyopiyo $ foo8  ++ replicate (piyopiyo - 1) '0'
    foo99 = foldr (++) "" $ foo9
    foo98 = divideList piyopiyo $ myNot . vacuous_inv piyopiyo2 $ foo99
    foo10 = (fmap $ fromBits piyopiyo) foo98
    foo11 = foo10 >>= (\x -> if x==0 then [] else return x)
    foo12 = (fmap $ intToChar) foo11
  in
    foo12

myNot str = do
  c <- str
  if c == '0' then
    return '1'
  else
    return '0'

fromBits n str =
  foldr f 0 $ zip (reverse [0..n-1]) str
  where
    f = \(i,x) y -> if x=='1' then y + 2^i else y

toBits n k =
  reverse . snd $ (foldr f (k,[]) $ (fmap (2^)) [0..(n-1)])
  where
    f = \x (y,xs) -> if x <= y then (y-x,'1':xs) else (y,'0':xs)

divideList i xs =
  reverse . snd $ (foldr f (xs,[]) $ replicate (length xs `div` i) ())
  where
    f = \_ (y,tmp) -> (drop i y,(take i y):tmp)

charToInt :: Char -> Int
charToInt c =
  let
    tmp = length [' '..'~']
    tmp2 = fromEnum c - fromEnum ' '
  in
    21 + ((tmp2 `rem` tmp) + tmp) `rem` tmp

intToChar :: Int -> Char
intToChar i =
  let
    tmp = length [' '..'~']
    tmp2 = (((i - 21) `rem` tmp) + tmp) `rem` tmp
  in
    toEnum $ fromEnum ' ' + tmp2

piyopiyo =
  let
    tmp = length [' '..'~']
    tmp2 = fromEnum '~' - fromEnum ' '
    tmp3 = fromIntegral $ 21 + ((tmp2 `rem` tmp) + tmp) `rem` tmp
  in
    ceiling $ log(tmp3) / log(2)    

piyopiyo2 = floor $ log(4091) / log(2)
piyopiyo3 = piyopiyo2 - (piyopiyo2 `div` 2)

abc str =
  let
    foo = length str
    tmp1 = (fmap $ (str !!)) [0,2..(foo-1)]
    tmp2 = (fmap $ (str !!)) [1,3..(foo-1)]
    tmp3 = tmp1 ++ tmp2
  in
    tmp3

abc_inv str =
  let
    foo = length str
    foo2 = foo `div` 2
    foo3 = foo - foo2
    tmp4 = do
      i <- [0..foo3-1]
      let
        blah =
          if (foo2 /= foo3) && i == (foo3-1) then
            ""
          else
            [str !! (foo3 + i)]
      [str !! i] ++ blah
  in
    tmp4


efg str =
  let
    str' = reverse str
    foo0 = read $ [str' !! 0]
    foo1 = drop 1 $ str'
  in
    f (foo0,foo1,[str'!!0])
  where
    f = fix $ \rec (k, current, final) ->
      let
        foo = 0
      in
        case current of
          [] ->
            final

          x:xs ->
            let
              tmp  = min (3+2*(k `mod` 4) - 2) $ length current
              tmp2 = (3+(k `mod` 7))
              tmp2_1 = take tmp $ current
              tmp3 = read . ('7':) . reverse $ tmp2_1
              tmp4 = show $ tmp3 * tmp2
              tmp5_0 = length tmp4
              tmp5_1 = (tmp+2) - tmp5_0
              tmp5_2 = replicate tmp5_1 '0' ++ tmp4
              tmp5_3 = read [tmp2_1!!0]
              tmp6 = drop tmp $ current

            in
              rec(tmp5_3,tmp6,tmp5_2++final)



efg_inv str =
  let
    str' = reverse str
    foo0 = read $ [str' !! 0]
    foo1 = drop 1 $ str'
  in
    f (foo0,foo1,[str'!!0])
  where
    f = fix $ \rec (k, current, final) ->
      let
        foo = 0
      in
        case current of
          [] ->
            final

          x:xs ->
            let
              tmp  = min (3+2*(k `mod` 4)) $ length current
              tmp2 = (3+(k `mod` 7))
              tmp3 = read . reverse . take tmp $ current
              tmp4 = show $ tmp3 `div` tmp2
              tmp5_2 = drop 1 $ tmp4
              tmp5_3 =
                if null tmp5_2 then
                  3
                else
                  read [last tmp5_2]
              tmp6 = drop tmp $ current

            in
              rec(tmp5_3,tmp6,tmp5_2++final)



vacuous width str =
  let
    foo = length str

    tmp3 = abc str    
    tmp10 = foo `mod` (width-1)
    (tmp11,tmp12) =
      if tmp10 == 0 then
        ((,)>>=id) $ ""
      else
        ( (fmap $ (tmp3 !!)) [(foo-1 - (tmp10 - 1))..(foo-1)]
        , (++) (replicate width '0') $ do
          x <- tmp11
          x : '1' : take (width-2) str )

    tmp4 = do
      (i,x) <- zip [0..] (take (foo-tmp10) tmp3)
      if i `mod` (width-1) == 0 then
        ['1',x]
      else
        return x
  in
    tmp4 ++ tmp12

vacuous_inv width str =
  let
    tmp10 = divideList width str
    tmp11 = takeWhile (/=(replicate width '0')) tmp10
    tmp12 = foldr (++) "" tmp11
    tmp13 = do
      xs <- drop (length tmp11 + 1) tmp10
      if xs == replicate width '0' then
        []
      else
        return $ xs !! 0


    tmp0 = do
      (i,x) <- zip [0..] (tmp12)
      if i `mod` width == 0 then
        []
      else
        return x
    tmp00 = tmp0 ++ tmp13
    foo = abc_inv tmp00
  in
    foo

genKey x =
  let
    tmp = fmersenne1279ToInt $ x^2
    tmp2 = show $ (mersenne1279 + tmp)^20
    tmp3 = fmap read $ divideList 3 tmp2
    tmp4 = take (3*k^2+1) tmp3
    tmp5 = fmap intToF4091 $ drop 1 tmp4
    tmp6 = do
      i <- [0..(k^2 - 1)]
      return $ (tmp5!!(0*k^2+i))+(tmp5!!(1*k^2+i))+(tmp5!!(2*k^2+i))
    tmp7 = zipWith (+) tmp6 id
  in
    mat8_power tmp7 $ last tmp4 + (f4091ToInt $ mat_det k tmp7)
  where
    k  = 8
    id = id_mat k

mat2_power :: [Finite_4091] -> Integer -> [Finite_4091]
mat2_power xs n =
  foldr (mat_prod 2) (id_mat 2) $ replicate (fromIntegral n) xs

mat8_power :: [Finite_4091] -> Integer -> [Finite_4091]
mat8_power xs n =
  foldr (mat_prod 8) (id_mat 8) $ replicate (fromIntegral n) xs

mat2_det x =
  x!!idx(1,1)*x!!idx(2,2) - x!!idx(1,2)*x!!idx(2,1)
  where
    idx (i,j) = 2*(i-1)+(j-1)

mat_det n x =
  sum $ do
    s <- permutations' [1..n]
    let
      tmp = do
        i <- [1..n]
        return $ x!!idx(i,s!!(i-1))
    return $ sign s * product tmp
  where
    idx (i,j) = n*(i-1)+(j-1)    

mat_prod n x y = do
  (i,j) <- prod [1..n] [1..n]
  return $ foldr (+) 0 $ do
    k <- [1..n]
    return $ x!!idx(i,k) * y!!idx(k,j)
  where
    idx (i,j) = n*(i-1)+(j-1)

id_mat n = do
  (i,j) <- prod [1..n] [1..n]
  return $
    if i == j then
      1
    else
      0

sign s =
  f1 (1,1,s)
  where
    f1 = fix $ \rec (i,piyo,xs) ->
      if null xs then
        piyo
      else
        let
          tmp2 = do
            (j,x) <- zip [1..] xs
            if x == i then
              return ([], f2 j)
            else
              return ([x], 1)
          (tmp3,tmp4) = unzip tmp2
        in
          rec (succ i, foldr (*) piyo tmp4, tmp3 >>= id)
    f2 x =
      if odd x then
        1
      else
        -1

prod x y = x >>= (\el -> zip (repeat el) y)

permutations' = (foldr (curry (uncurry id . (fmap (,) (([uncurry (:), snd] !!) . fromEnum . uncurry elem) <*> id))) ([]) . uncurry id . (fmap (,) (fmap . fmap . (!!)) <*> (((filter . (. foldr (curry (uncurry (+) . (fmap (,) ((2 ^) . fst) <*> snd))) 0) . (==) . foldr (curry (uncurry (+) . (fmap (,) ((2 ^) . fst) <*> snd))) 0 . enumFromTo 0) <*> (fmap ($ ([])) . flip (((.) . foldr (.) . const . fmap (:) . enumFromTo 0) <*> replicate <*> ((<*>) . (fmap (.)) . fmap (:) . enumFromTo 0)) ())) . fst . (iterate ((fmap (,) id <*> succ) . snd) (0, 0) !!) . length)))