Commit 32b0f51a authored by Vicente Parra Hurtado's avatar Vicente Parra Hurtado

Alpha 0.3.1

parent 083f3746
import NukeBull
import EncrypText
import System.Environment
import Data.Char
import Data.Word
import Data.Maybe
import System.Random
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.IO as TIO
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as BS
main = do
(comando:_) <- getArgs
case comando of
"encrypt" -> do
(_:fileName10:fileName20:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
let fileName2 = "CryptMsg/" ++ fileName20 ++ ".cryptext"
-- Read Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 Cipher Lv 3.2
source <- B.readFile fileName1
-- Text to crypt
putStrLn "Text to Encrypt ( Maximum number of characters: 127 ) (ASCII 217 ┘ Forbidden)"
textoOn <- TIO.getLine
if T.length (textoOn) > 127
then putStrLn $ " Yours Characters are: " ++ (show(T.length (textoOn))) ++" (Number Maximun of characters are 127) "
else do
g <- newStdGen
g <- newStdGen
texto <- encryptext (E.encodeUtf8 textoOn) source g
putStrLn "Loading Password -------------- is Ok"
putStrLn "Encrypting Text --------------- is Ok"
let base64 = BS.encode texto
putStrLn "Encoding Base64 --------------- is Ok"
B.writeFile fileName2 base64
putStrLn "Writing Encrypted File -------- is OK"
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn ""
putStrLn (" Your text has been encrypted in " ++ (show(fileName2)))
putStrLn ""
"decrypt" -> do
(_:fileName10:fileName20:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
let fileName2 = "CryptMsg/" ++ fileName20 ++ ".cryptext"
-- Read Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 RandomGen Lv 3.2
source <- B.readFile fileName1
-- Decrypt
code <- B.readFile fileName2
let base64 = BS.decodeLenient code
if B.length base64 == 256
then do
text <- decryptext base64 source
-- The 217 ASCII is the end of the text
let textoInt = B.elemIndex 217 text
--TIO.putStrLn (E.decodeUtf8(B.take (fromJust textoInt) text))
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn " Decrypted Text: "
putStrLn ""
TIO.putStrLn (E.decodeUtf8(B.take (fromJust textoInt) text))
putStrLn ""
else do
-- No More
putStrLn "Is it a Cryptext File?"
otherwise ->do
putStrLn "Arguments Is Not Valid"
putStrLn "Used: encrypt FileName(Password) FileName (Crypt Msg)"
putStrLn "Used: decrypt FileName(Password) FileName (Crypt Msg)"
module EncrypText
(encryptext
,decryptext
) where
import NukeBull
import System.Random
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (BlockCipher(..), Cipher(..),IV, makeIV)
import Crypto.Error (throwCryptoError)
import qualified Data.ByteString as B
-- Text length =128
encryptext :: (RandomGen g) => B.ByteString -> B.ByteString -> g -> IO B.ByteString
encryptext msg password g = do
let vectorIV = B.pack ( take 16 $ B.unpack password )
let key = B.pack (take 32 ( drop 16 $ B.unpack password ))
let passwordL31 = B.pack (take 16 ( drop 48 $ B.unpack password ))
let rows = passwordRows $ B.unpack passwordL31
let cols = passwordCols $ B.unpack passwordL31
let pass = B.pack( take 16 ( drop 64 $ B.unpack password ))
let pass2 = B.pack( take 16 ( drop 80 $ B.unpack password ))
let pass3 = B.pack( take 16 ( drop 96 $ B.unpack password ))
let pass4 = B.pack( take 16 ( drop 112 $ B.unpack password ))
let text = entrophyBS 128 msg g
let mInitIV = makeIV vectorIV
case mInitIV of
Nothing -> error "Failed to generate and initialization vector."
Just initIV -> do
let texto = encryptAES256 key initIV text
let textoMatrix = orderLv3 16 (B.unpack texto) rows cols pass pass2 pass3 pass4
return textoMatrix
-- Text length =128
decryptext :: B.ByteString -> B.ByteString -> IO B.ByteString
decryptext msg password = do
--hola
let vectorIV = B.pack ( take 16 $ B.unpack password )
let key = B.pack (take 32 ( drop 16 $ B.unpack password ))
let passwordL31 = B.pack (take 16 ( drop 48 $ B.unpack password ))
let rows = passwordRows $ B.unpack passwordL31
let cols = passwordCols $ B.unpack passwordL31
let pass = B.pack( take 16 ( drop 64 $ B.unpack password ))
let pass2 = B.pack( take 16 ( drop 80 $ B.unpack password ))
let pass3 = B.pack( take 16 ( drop 96 $ B.unpack password ))
let pass4 = B.pack( take 16 ( drop 112 $ B.unpack password ))
let mInitIV = makeIV vectorIV
case mInitIV of
Nothing -> error "Failed to generate and initialization vector."
Just initIV -> do
let textoMatrix = orderLv3Inv 16 (B.unpack msg) rows cols pass pass2 pass3 pass4
let dtext = decryptAES256 key initIV (textoMatrix)
let text = decryptEntrophy 128 dtext
return text
import NukeBull (noOrder,randomBytesString)
import System.Environment
import Data.Word
import Data.Bits
import System.Random
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as BS
generator :: (RandomGen g ) => Int -> Int -> g -> [Int]
generator n m g = take n $ randomRs (0,m) g
choose :: Int -> B.ByteString -> B.ByteString
choose n b = B.drop (n-1) (B.take n b )
ordercrazy :: Int -> [Word8] ->[Int] -> [Int] -> [Word8]
ordercrazy 1 c s1 s2 = noOrder c s1 s2
ordercrazy n c s1 s2 = noOrder ( ordercrazy (n-1) c s1 s2 )s1 s2
crazyloop :: (RandomGen g) => Int -> Int -> g -> IO B.ByteString
crazyloop n m g = do
g <- newStdGen
let poll = randomBytesString m g
g <- newStdGen
let droping = generator n (m-1) g
let password = B.concat ( map (\x -> B.drop x (B.take (x+1) poll)) droping )
return password
main = do
(comando:_) <- getArgs
case comando of
"lazy" -> do
(_:fileName10:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
-- Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 RandomGen Lv 3.2
g <- getStdGen
g <- newStdGen
let passwords = randomBytesString 128 g
B.writeFile fileName1 passwords
putStrLn "Creating vectorIV ------------- OK"
putStrLn "Creating AES256 Key ----------- OK"
putStrLn "Creating Password Lv. 3.1 ----- OK"
putStrLn "Creating Password Lv. 3.2 ----- OK"
putStrLn "Writing Password --------------- OK"
"crazy" -> do
(_:fileName10:_) <- getArgs
let fileName1a = "Keys/" ++ fileName10 ++ "a.key"
let fileName1b = "Keys/" ++ fileName10 ++ "b.key"
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
-- Read Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 RandomGen Lv 3.2
putStrLn "Creating Random Poll --------------------------- OK"
putStrLn "Please wait, Millions of bits Playing ---------- OK"
g <- getStdGen
g <- newStdGen
password1 <- crazyloop 32 1048576 g
g <- newStdGen
password2 <- crazyloop 32 1048576 g
g <- newStdGen
password3 <- crazyloop 32 1048576 g
g <- newStdGen
password4 <- crazyloop 32 1048576 g
g <- newStdGen
password5 <- crazyloop 32 1048576 g
g <- newStdGen
password6 <- crazyloop 32 1048576 g
g <- newStdGen
password7 <- crazyloop 32 1048576 g
g <- newStdGen
password8 <- crazyloop 32 1048576 g
let passwords = B.unpack(password1) ++ B.unpack(password2) ++ B.unpack(password3) ++ B.unpack(password4) ++ B.unpack(password5) ++ B.unpack(password6) ++ B.unpack(password7) ++ B.unpack(password8)
g <- newStdGen
let rows = generator 32 15 g
g <- newStdGen
let cols = generator 32 15 g
let password = B.take 128 (B.pack (ordercrazy 30 passwords rows cols))
let passworda = B.drop 128 (B.pack (ordercrazy 30 passwords rows cols))
let passwordb = B.pack (B.zipWith (xor) ( password) ( passworda))
B.writeFile fileName1 password
let base64a = BS.encode passworda
let base64b = BS.encode passwordb
B.writeFile fileName1a base64a
B.writeFile fileName1b base64b
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn (" Your password has been created in " ++ (show(fileName1)))
putStrLn (" Two Complementary keys in " ++ (show(fileName1a)) ++" and "++ (show(fileName1a)))
putStrLn ""
putStrLn ""
"xor" -> do
(_:fileName10:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
let fileName1a = "Keys/" ++ fileName10 ++ "a.key"
let fileName1b = "Keys/" ++ fileName10 ++ "b.key"
base64a <- B.readFile fileName1a
let keya = BS.decodeLenient base64a
base64b <- B.readFile fileName1b
let keyb = BS.decodeLenient base64b
let password = B.pack (B.zipWith (xor) ( keya) (keyb))
B.writeFile fileName1 password
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn (" Your password has been created in " ++ (show(fileName1)))
putStrLn ""
"info" -> do
putStrLn "stack exec KeyGen-exe [Argument] FileName (Password) without extension"
putStrLn "Arguments:"
putStrLn "lazy - It is a basic Random Numbers Gen :: stack exec KeyGen-exe lazy FileName"
putStrLn "crazy - It is the Paranoid Random Number Gen :: stack exec KeyGen-exe crazy FileName"
putStrLn "xor - Joins the two complementary passwords :: stack exec KeyGen-exe xor FileName"
otherwise ->do
putStrLn "Arguments Is Not Valid"
putStrLn "Used: stack exec KeyGen-exe lazy FileName(Password)"
putStrLn "Used: stack exec KeyGen-exe crazy FileName(Password)"
putStrLn "Used: stack exec KeyGen-exe xor FileName(Password)"
module NukeBull
(generator256
,randomBytes
,randomBytesString
,entrophyBS
,encryptAES256
,decryptAES256
,decryptEntrophy
,noOrder
,passwordRows
,passwordCols,
orderLv3,
orderLv3Inv
) where
import System.Random
import Data.List
import Data.Word
import Data.Bits
import Data.Char
import qualified Data.ByteString as B
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (BlockCipher(..), Cipher(..),IV, makeIV)
import Crypto.Error (throwCryptoError)
import Crypto.Random(getSystemDRG, randomBytesGenerate)
import Crypto.KDF.Scrypt (generate, Parameters(..))
-- Randon generator, Int List Numbers (0-255)
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
generator256 :: (RandomGen g ) => Int -> g -> [Int]
generator256 n g = take n $ randomRs (0,255) g
-- Gen n random Word8
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
randomBytes :: (RandomGen g) => Int -> g -> [Word8]
randomBytes 0 _ = []
randomBytes n g = map fromIntegral (generator256 n g)
-- Gen Random ByteString n
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
randomBytesString :: (RandomGen g) => Int -> g -> B.ByteString
randomBytesString n g = B.pack $ randomBytes n g
---- Expand text
-- Extend the text for 127 bits
-- Char '217' is the character control
extendW8 :: (RandomGen g ) => Int -> [Word8] -> g -> [Word8]
extendW8 n a g
| n > B.length (B.pack a) = a ++ [217] ++ (B.unpack (B.take (n -1 - B.length (B.pack a)) (randomBytesString n g)))
| n <= B.length (B.pack a) = a
--- extendW8 version Bytetring
extendBS :: (RandomGen g ) => Int -> B.ByteString -> g -> B.ByteString
extendBS n a g = B.pack (extendW8 n (B.unpack a) g)
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
-- Random n xor [(extendW8 n a) xor (Random n)]
entrophyW8 :: (RandomGen g) => Int -> [Word8] -> g -> [Word8]
entrophyW8 n a g = if n > B.length (B.pack a) then
let (g1,g2) = split g
a1 = extendW8 n a g1
a2 = randomBytes n g2
in a2 ++ (zipWith xor a1 a2)
else a
-- entrophyW8 Bytestring version
entrophyBS :: (RandomGen g) => Int -> B.ByteString -> g -> B.ByteString
entrophyBS n a g = B.pack $ entrophyW8 n (B.unpack a ) g
-- entrophyBS decrypt function
decryptEntrophy :: Int -> B.ByteString -> B.ByteString
decryptEntrophy n a =
let a1 = B.unpack $ B.take n a
a2 = B.unpack $ B.drop n a
in B.pack (zipWith xor a1 a2)
-- AES ciPher Lv2
encryptAES256 :: B.ByteString -> IV AES256 -> B.ByteString -> B.ByteString
encryptAES256 key cIV plainData = cbcEncrypt ctx cIV plainData
where ctx :: AES256
ctx = throwCryptoError $ cipherInit key
decryptAES256 :: B.ByteString -> IV AES256 -> B.ByteString -> B.ByteString
decryptAES256 key cIV plainData = cbcDecrypt ctx cIV plainData
where ctx :: AES256
ctx = throwCryptoError $ cipherInit key
-- Coling Parcival's key derivation function
-- Parameters
paramN = 32:: Word64
paramR = 8
paramP = 1
paramKeyLen = 256
--Scrypt KDF - Coling Parcival's key derivation function
deriveKey :: B.ByteString -> B.ByteString -> B.ByteString
deriveKey password salt = generate params password salt
where params = Parameters {n = paramN, r = paramR, p = paramP, outputLength = paramKeyLen}
-- Transform bytes 8bits in two number (0-15) (4 bits numbers)
-- Similary hexadecimal transform
passwordRows :: [Word8] -> [Int]
passwordRows x = map (`div` 16) (map fromIntegral x)
passwordCols :: [Word8] -> [Int]
passwordCols x = map (`mod` 16) (map fromIntegral x)
-- Matrix translations n = Int deplazament , a = (list Word8) 'for 16 element'
moveBytes :: Int -> [Word8] -> [Word8]
moveBytes n [] = []
moveBytes n a = drop n a ++ take n a
-- moveBytes inverse 'for 16 element'
moveInvBytes :: Int-> [Word8] -> [Word8]
moveInvBytes n [] = []
moveInvBytes n a = drop (16-n) a ++ take (16-n) a
-- moveBytes and moveInvBytes Matrix 16*16 version
rotFileBytes :: [Int]-> [[Word8]] -> [[Word8]]
rotFileBytes x y = [ moveBytes (x !! n) (y !! n) | n <- [0..15]]
rotFileInvBytes :: [Int]-> [[Word8]] -> [[Word8]]
rotFileInvBytes x y = [ moveInvBytes (x !! n) (y !! n) | n <- [0..15]]
-- Generate a Matrix 16x16 [[Word8]] with 256 bytes [Word8]
matrixBytes :: [Word8] -> [[Word8]]
matrixBytes [] = []
matrixBytes x = [ take 16 (drop (n*16) x)| n <- [0..15]]
-- Generate a 256 bytes Word8 with Matrix 16x16
matrix :: [[Word8]] -> [Word8]
matrix [] = []
matrix (x:xs) = x ++ matrix xs
-- Transpose matrix
matrixTransBytes = transpose.matrixBytes
-- Moving elements in Matrix 16x16 s1 move files and s2 move colums
noOrder :: [Word8] ->[Int] -> [Int] -> [Word8]
noOrder c s1 s2 = matrix (matrixTransBytes (matrix (rotFileBytes s2 (matrixTransBytes (matrix (rotFileBytes s1 (matrixBytes c)))))))
-- noOrder decrypt
noOrderInv :: [Word8] ->[Int] -> [Int] -> [Word8]
noOrderInv c s1 s2 = matrix (rotFileInvBytes s1 (matrixBytes ( matrix (matrixTransBytes (matrix (rotFileInvBytes s2 (matrixTransBytes c)))))))
-- 16 interactions, interaction number n
noOrderLv3 ::Int -> [Word8] ->[Int] -> [Int] -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
noOrderLv3 n c s1 s2 pass pass2 pass3 pass4 = B.pack ( B.zipWith (xor) (passL3 n pass pass2 pass3 pass4) (B.pack (noOrder c s1 s2)))
-- noOrderLv3 decrypt
-- 16 interactions, interaction number n
noOrderLv3Inv :: Int -> [Word8] ->[Int] -> [Int] -> B.ByteString -> B.ByteString-> B.ByteString -> B.ByteString -> B.ByteString
noOrderLv3Inv n c s1 s2 pass pass2 pass3 pass4 = B.pack (noOrderInv (B.zipWith (xor) (passL3 (17 - n) pass pass2 pass3 pass4) (B.pack c) ) s1 s2)
-- All Interactions (16 = n)
orderLv3 :: Int -> [Word8] ->[Int] -> [Int] -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
orderLv3 1 c s1 s2 pass pass2 pass3 pass4 = noOrderLv3 1 c s1 s2 pass pass2 pass3 pass4
orderLv3 n c s1 s2 pass pass2 pass3 pass4 = noOrderLv3 n (B.unpack(orderLv3 (n-1) c s1 s2 pass pass2 pass3 pass4)) s1 s2 pass pass2 pass3 pass4
-- orderLv3 decrypt
orderLv3Inv :: Int -> [Word8] ->[Int] -> [Int] -> B.ByteString-> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
orderLv3Inv 1 c s1 s2 pass pass2 pass3 pass4 = noOrderLv3Inv 1 c s1 s2 pass pass2 pass3 pass4
orderLv3Inv n c s1 s2 pass pass2 pass3 pass4 = noOrderLv3Inv n (B.unpack(orderLv3Inv (n-1) c s1 s2 pass pass2 pass3 pass4)) s1 s2 pass pass2 pass3 pass4
-- Pass 256 Lv 1 for adiction
-- This funtions gen matrix 256 (16*16) bytes for n = 16, With two 16 bytes ByteString keys
passMatrixRow :: Int -> B.ByteString -> B.ByteString
passMatrixRow n a = B.concatMap (B.replicate n) a
passMatrixCols :: Int -> B.ByteString -> B.ByteString
passMatrixCols 1 a = a
passMatrixCols n a = B.pack ( (B.unpack (passMatrixRow (n-1) a)) ++ (B.unpack a))
passMatrix :: Int -> B.ByteString -> B.ByteString -> B.ByteString
passMatrix n a b = B.pack ( B.zipWith (xor) (passMatrixRow n a) (passMatrixCols n b) )
-- Gen n keys of 256 bytes using Scrypt KDF - Coling Parcival's key derivation function
-- In this aplication used 4*16 bytes keys and passMatrix
-- first and second kays gen password 256bytes for Scrypt KDF
-- third y fourth keys gen 16 salt for Scrypt KDF
passL3 :: Int -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
passL3 n a b c d = deriveKey (passMatrix 16 a b) (B.pack (take 16 (drop (16*(n-1)) (B.unpack (passMatrix 16 c d) ) ) ) )
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment