{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Crypto.Classical.Util
(
letter
, int
, inverse
, prng
, rseq
, mapInverse
, compose
, (|.|)
, uniZip
, stretch
) where
import Crypto.Number.Generate
import Crypto.Number.ModArithmetic (inverseCoprimes)
import Crypto.Random
import Data.Char
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Modular
import Lens.Micro
letter :: ℤ/26 -> Char
letter l = chr $ ord 'A' + fromIntegral (unMod l)
int :: Char -> ℤ/26
int c = toMod . toInteger $ ord c - ord 'A'
inverse :: ℤ/26 -> ℤ/26
inverse a = toMod $ inverseCoprimes (unMod a) 26
prng :: IO SystemRNG
prng = fmap cprgCreate createEntropyPool
rseq :: CPRG g => g -> Integer -> [Integer]
rseq g n = rseq' g (n - 1) ^.. traverse . _1
where rseq' :: CPRG g => g -> Integer -> [(Integer, g)]
rseq' _ 0 = []
rseq' g' i = (j, g') : rseq' g'' (i - 1)
where (j, g'') = generateBetween g' 0 i
mapInverse :: (Ord k, Ord v) => Map k v -> Map v k
mapInverse = M.foldrWithKey (\k v acc -> M.insert v k acc) M.empty
compose :: (Ord k, Ord v) => Map k v -> Map v v' -> Map k v'
compose s t = M.foldrWithKey f M.empty s
where f k v acc = case M.lookup v t of
Nothing -> acc
Just v' -> M.insert k v' acc
(|.|) :: (Ord k, Ord v) => Map k v -> Map v v' -> Map k v'
(|.|) = compose
uniZip :: [a] -> [(a,a)]
uniZip [] = []
uniZip [_] = []
uniZip (a:b:xs) = (a,b) : uniZip xs
stretch :: [a] -> [a]
stretch = foldr (\x acc -> x : x : acc) []