{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Crypto.Classical.Util
(
letter
, int
, inverse
, prng
, rseq
, mapInverse
, compose
, (|.|)
, uniZip
, stretch
, both
) where
import Crypto.Number.Generate
import Crypto.Number.ModArithmetic (inverseCoprimes)
import Crypto.Random
import Data.Char
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Modular
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 = map fst $ rseq' g (n - 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) []
both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)