From: miha-q <> Date: Fri, 11 Aug 2023 12:20:09 +0000 (-0400) Subject: Fri Aug 11 08:20:09 AM EDT 2023 X-Git-Url: http://www.foleosoft.com/?a=commitdiff_plain;h=cb7c97d448565e76e4a7d2840056e97d639950f5;p=CryptoFoleo.git Fri Aug 11 08:20:09 AM EDT 2023 --- diff --git a/bin/CryptoFoleo.h b/bin/CryptoFoleo.h index 0b955b6..0aba4e2 100644 --- a/bin/CryptoFoleo.h +++ b/bin/CryptoFoleo.h @@ -1,17 +1,17 @@ #include #include -uint8_t* foleo_chacha20(uint8_t[32], uint8_t[12], uint32_t, uint64_t); -uint8_t* foleo_chacha20_poly1305(uint8_t[32], uint8_t[12], uint8_t*, uint64_t); +uint8_t* foleo_chacha20(uint8_t[32], uint8_t[12], uint32_t, size_t); +uint8_t* foleo_chacha20_poly1305(uint8_t[32], uint8_t[12], uint8_t*, size_t); uint8_t* foleo_dhke(uint8_t*, uint8_t*); -uint8_t* foleo_dhke_prf(uint32_t, uint8_t*, uint32_t, uint8_t*, uint32_t, uint8_t*, uint32_t); -uint8_t* foleo_poly1305(uint8_t*, uint8_t*, uint8_t*, uint64_t); -static uint8_t* foleo_prigen(uint16_t); -#define FOLEO_RSA_NONE 99 -#define FOLEO_RSA_ENCRYPTION 1 -#define FOLEO_RSA_SIGNATURE 2 -#define FOLEO_RSA_OAEP 3 -#define FOLEO_RSA_PSS 4 +uint16_t foleo_dhke_modsize(); + +uint8_t* foleo_poly1305(uint8_t*, uint8_t*, uint8_t*, size_t); +#define FOLEO_RSA_PADDING_NONE 99 +#define FOLEO_RSA_PADDING_ENCRYPTION 1 +#define FOLEO_RSA_PADDING_SIGNATURE 2 +#define FOLEO_RSA_PADDING_OAEP 3 +#define FOLEO_RSA_PADDING_PSS 4 typedef struct { mpz_t n, k; @@ -22,9 +22,25 @@ void foleo_rsa_import(rsakey_t*, uint8_t*); uint8_t* foleo_rsa_export(rsakey_t*); void foleo_rsa_free(rsakey_t*); void foleo_rsa_keygen(uint16_t, rsakey_t*, rsakey_t*); + +//The maximum message block size that can be used +// for a particular padding scheme. +uint16_t foleo_rsa_msgsize(rsakey_t*, uint8_t); + +//Size of the rsakey struct uint16_t foleo_rsa_keysize(); -uint16_t foleo_rsa_size(rsakey_t*, uint8_t); + +//Size in bytes of RSA modulus, same thing as the number +// of bytes the encrypt() function will return +uint16_t foleo_rsa_modsize(rsakey_t*); + uint8_t* foleo_rsa_encrypt(rsakey_t*, uint8_t, uint8_t*, uint16_t); uint8_t* foleo_rsa_decrypt(rsakey_t*, uint8_t, uint8_t*, uint16_t*); uint8_t* foleo_sha256(uint8_t*, uint32_t); -#define FOLEO_SHA256 foleo_sha256, 32, 64 + +#define FOLEO_SHA256 1 +uint8_t* foleo_hmac(uint8_t, uint8_t*, uint32_t, uint8_t*, uint32_t); +uint8_t* foleo_hmac_hkdf(uint8_t, uint32_t, uint8_t*, uint32_t, uint8_t*, uint32_t, uint8_t*, uint32_t); +uint8_t* foleo_hmac_prf(uint8_t, uint32_t, uint8_t*, uint32_t, uint8_t*, uint32_t, uint8_t*, uint32_t); + +uint8_t foleo_hash_size(uint8_t); \ No newline at end of file diff --git a/bin/CryptoFoleo.hi b/bin/CryptoFoleo.hi index 19308d7..48ee238 100644 Binary files a/bin/CryptoFoleo.hi and b/bin/CryptoFoleo.hi differ diff --git a/bin/CryptoFoleo.hs b/bin/CryptoFoleo.hs index f6014c0..7a2746b 100644 --- a/bin/CryptoFoleo.hs +++ b/bin/CryptoFoleo.hs @@ -1,16 +1,28 @@ module CryptoFoleo ( + dhke, + chacha20, + poly1305, + rsa_keygen, rsa_import, rsa_export, rsa_encrypt, rsa_decrypt, + sha256, + hash_sha256, + hmac, + hmac_prf, + hmac_hkdf, + rsa_padding_none, rsa_padding_encryption, rsa_padding_signature, rsa_padding_oaep, - rsa_padding_pss + rsa_padding_pss, + + byteStringToHexString ) where import System.IO as IO @@ -22,6 +34,7 @@ import Data.ByteString.Internal import Data.Word import Data.ByteString.Unsafe import Control.DeepSeq +import Control.Monad import qualified Data.ByteString.Internal as BI import qualified Foreign.Marshal.Utils as MU import qualified Data.ByteString.Char8 as C8 @@ -50,12 +63,39 @@ foreign import ccall unsafe "foleo_rsa_encrypt" foreign import ccall unsafe "foleo_rsa_decrypt" c_rsa_decrypt :: Ptr () -> CUChar -> Ptr (CUChar) -> Ptr (CUShort) -> IO (Ptr (CUChar)) ---uint8_t* foleo_rsa_encrypt(rsakey_t* key, uint8_t padding, uint8_t* buffer, uint16_t bufferSize) +foreign import ccall unsafe "foleo_dhke_modsize" + c_dhke_modsize :: IO (CUShort) + +foreign import ccall unsafe "foleo_dhke" + c_dhke :: Ptr (CUChar) -> Ptr (CUChar) -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_sha256" + c_sha256 :: Ptr (CUChar) -> Word32 -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_hash_size" + c_hash_size :: CUChar -> IO (CUChar) + +foreign import ccall unsafe "foleo_hmac" + c_hmac :: CUChar -> Ptr (CUChar) -> Word32 -> Ptr (CUChar) -> Word32 -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_hmac_prf" + c_hmac_prf :: CUChar -> Word32 -> Ptr (CUChar) -> Word32 -> Ptr (CUChar) -> Word32 -> Ptr (CUChar) -> Word32 -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_hmac_hkdf" + c_hmac_hkdf :: CUChar -> Word32 -> Ptr (CUChar) -> Word32 -> Ptr (CUChar) -> Word32 -> Ptr (CUChar) -> Word32 -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_chacha20" + c_chacha20 :: Ptr (CUChar) -> Ptr (CUChar) -> Word32 -> CSize -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_poly1305" + c_poly1305 :: Ptr (CUChar) -> Ptr (CUChar) -> Ptr (CUChar) -> CSize -> IO (Ptr (CUChar)) + +foreign import ccall unsafe "foleo_chacha20_poly1305" + c_chacha20_poly1305 :: Ptr (CUChar) -> Ptr (CUChar) -> Ptr (CUChar) -> CSize -> IO (Ptr (CUChar)) foreign import ccall unsafe "free" c_free :: Ptr a -> IO () - rsa_padding_none :: Int rsa_padding_none = 99 @@ -71,6 +111,9 @@ rsa_padding_oaep = 3 rsa_padding_pss :: Int rsa_padding_pss = 4 +hash_sha256 :: Int +hash_sha256 = 1 + rsa_encrypt :: ByteString -> Int -> ByteString-> IO (ByteString) rsa_encrypt keyBS padType ptBS = do useAsCString keyBS $ \keyPtr -> do @@ -88,10 +131,13 @@ rsa_decrypt keyBS padType ctBS = do sModSize <- c_rsa_modsize (castPtr keyPtr) allocaBytes 2 $ \sizePtr -> do ptPtr <- c_rsa_decrypt (castPtr keyPtr) (fromIntegral padType) (castPtr ctPtr) (castPtr sizePtr) - ptSize <- peek sizePtr - ptBS <- BI.create ptSize (\ptr -> MU.copyBytes ptr (castPtr ptPtr) ptSize) - c_free ptPtr - return ptBS + if ptPtr == nullPtr then do + return BS.empty + else do + ptSize <- peek sizePtr + ptBS <- BI.create ptSize (\ptr -> MU.copyBytes ptr (castPtr ptPtr) ptSize) + c_free ptPtr + return ptBS rsa_keygen :: Word16 -> (ByteString -> ByteString -> IO ()) -> IO () rsa_keygen n fn = do @@ -119,7 +165,7 @@ rsa_import n fn = do fn key rsa_free key -rsa_export :: ByteString -> IO(String) +rsa_export :: ByteString -> IO (String) rsa_export keyBS = do useAsCString keyBS $ \keyPtr -> do cStrPtr <- c_rsa_export (castPtr keyPtr) @@ -130,11 +176,164 @@ rsa_export keyBS = do rsa_free :: ByteString -> IO() rsa_free blob = useAsCString blob $ \ptr -> c_rsa_free (castPtr ptr) ---main :: IO() ---main = do --- rsa_keygen 2048 $ \pub prv -> do --- spub <- rsa_export pub --- IO.putStr spub +dhke :: (ByteString, ByteString) -> IO (ByteString) +dhke v = do + c_modSize <- c_dhke_modsize + let modSize = fromIntegral c_modSize + if ((BS.length(fst v) + BS.length(snd v)) == 0) then do + secretPtr <- c_dhke nullPtr nullPtr + bsPtr <- BI.create modSize (\ptr -> MU.copyBytes ptr (castPtr secretPtr) modSize) + c_free secretPtr + return bsPtr + else if (BS.length(snd v) == 0) then do + useAsCString (fst v) $ \secretPtr -> do + sharePtr <- c_dhke (castPtr secretPtr) nullPtr + bsPtr <- BI.create modSize (\ptr -> MU.copyBytes ptr (castPtr sharePtr) modSize) + c_free sharePtr + return bsPtr + else if (BS.length(snd v) > 0) then do + useAsCString (fst v) $ \secretPtr -> do + useAsCString (snd v) $ \sharePtr -> do + keyPtr <- c_dhke (castPtr secretPtr) (castPtr sharePtr) + bsPtr <- BI.create modSize (\ptr -> MU.copyBytes ptr (castPtr keyPtr) modSize) + c_free keyPtr + return bsPtr + else return BS.empty + +sha256 :: ByteString -> IO (String) +sha256 ptBS = do + let ptSize :: Word32 + ptSize = fromIntegral (BS.length ptBS) + useAsCString ptBS $ \ptPtr -> do + hPtr <- c_sha256 (castPtr ptPtr) (fromIntegral ptSize) + hBS <- BI.create 32 (\ptr -> MU.copyBytes ptr (castPtr hPtr) 32) + c_free hPtr + return (byteStringToHexString hBS) + +hmac :: Int -> ByteString -> ByteString -> IO (ByteString) +hmac h k m = do + useAsCString k $ \kPtr -> do + useAsCString m $ \mPtr -> do + rPtr <- c_hmac (fromIntegral h) (castPtr kPtr) (fromIntegral (BS.length k)) (castPtr mPtr) (fromIntegral (BS.length m)) + if rPtr == nullPtr then do + return BS.empty + else do + size <- c_hash_size (fromIntegral h) + r <- BI.create (fromIntegral size) (\ptr -> MU.copyBytes ptr (castPtr rPtr) (fromIntegral size)) + c_free rPtr + return r + +hmac_prf :: Int -> Int -> ByteString -> ByteString -> ByteString -> IO (ByteString) +hmac_prf hf db sc lb sd = do + useAsCString sc $ \scPtr -> do + useAsCString lb $ \lbPtr -> do + useAsCString sd $ \sdPtr -> do + rPtr <- c_hmac_prf (fromIntegral hf) (fromIntegral db) (castPtr scPtr) (fromIntegral (BS.length sc)) (castPtr lbPtr) (fromIntegral (BS.length lb)) (castPtr sdPtr) (fromIntegral (BS.length sd)) + if rPtr == nullPtr then do + return BS.empty + else do + r <- BI.create db (\ptr -> MU.copyBytes ptr (castPtr rPtr) db) + c_free rPtr + return r + +hmac_hkdf :: Int -> Int -> ByteString -> ByteString -> ByteString -> IO (ByteString) +hmac_hkdf hf db sc lb sd = do + useAsCString sc $ \scPtr -> do + useAsCString lb $ \lbPtr -> do + useAsCString sd $ \sdPtr -> do + rPtr <- c_hmac_hkdf (fromIntegral hf) (fromIntegral db) (castPtr scPtr) (fromIntegral (BS.length sc)) (castPtr lbPtr) (fromIntegral (BS.length lb)) (castPtr sdPtr) (fromIntegral (BS.length sd)) + if rPtr == nullPtr then do + return BS.empty + else do + r <- BI.create db (\ptr -> MU.copyBytes ptr (castPtr rPtr) db) + c_free rPtr + return r + +chacha20 :: ByteString -> ByteString -> Int -> Int -> IO (ByteString) +chacha20 key nonce block count = do + if (BS.length key) /= 32 || (BS.length nonce) /= 12 || block < 0 || count < 0 then + return BS.empty + else + useAsCString key $ \keyPtr -> do + useAsCString nonce $ \noncePtr -> do + rPtr <- c_chacha20 (castPtr keyPtr) (castPtr noncePtr) (fromIntegral block) (fromIntegral count) + r <- BI.create count (\ptr -> MU.copyBytes ptr (castPtr rPtr) count) + c_free rPtr + return r + +poly1305 :: ByteString -> ByteString -> ByteString -> IO (ByteString) +poly1305 r s m = do + if (BS.length r /= 16) || (BS.length s /= 16) then + return BS.empty + else + useAsCString r $ \rPtr -> do + useAsCString s $ \sPtr -> do + useAsCString m $ \mPtr -> do + hPtr <- c_poly1305 (castPtr rPtr) (castPtr sPtr) (castPtr mPtr) (fromIntegral (BS.length m)) + h <- BI.create 16 (\ptr -> MU.copyBytes ptr (castPtr hPtr) 16) + c_free hPtr + return h + +chacha20_poly1305 :: ByteString -> ByteString -> ByteString -> IO (ByteString) +chacha20_poly1305 key nonce ctext = do + if (BS.length key) /= 32 || (BS.length nonce) /= 12 then + return BS.empty + else + useAsCString key $ \keyPtr -> do + useAsCString nonce $ \noncePtr -> do + useAsCString ctext $ \ctextPtr -> do + rPtr <- c_chacha20_poly1305 (castPtr keyPtr) (castPtr noncePtr) (castPtr ctextPtr) (fromIntegral (BS.length ctext)) + r <- BI.create 16 (\ptr -> MU.copyBytes ptr (castPtr rPtr) 16) + c_free rPtr + return r + + +byteToHexString :: Word8 -> String +byteToHexString b = do + case (div b 16) of + 0 -> "0" + 1 -> "1" + 2 -> "2" + 3 -> "3" + 4 -> "4" + 5 -> "5" + 6 -> "6" + 7 -> "7" + 8 -> "8" + 9 -> "9" + 10 -> "a" + 11 -> "b" + 12 -> "c" + 13 -> "d" + 14 -> "e" + 15 -> "f" + _ -> "0" + ++ + case (mod b 16) of + 0 -> "0" + 1 -> "1" + 2 -> "2" + 3 -> "3" + 4 -> "4" + 5 -> "5" + 6 -> "6" + 7 -> "7" + 8 -> "8" + 9 -> "9" + 10 -> "a" + 11 -> "b" + 12 -> "c" + 13 -> "d" + 14 -> "e" + 15 -> "f" + _ -> "0" + + +byteStringToByteList :: ByteString -> [Word8] +byteStringToByteList b = BS.unpack b + +byteStringToHexString :: ByteString -> String +byteStringToHexString b = Prelude.foldr (\i s -> (byteToHexString i) ++ s) "" (byteStringToByteList b) byteStringToInteger :: ByteString -> Integer byteStringToInteger = foldl' (\acc byte -> acc * 256 + fromIntegral byte) 0 diff --git a/bin/CryptoFoleo.o b/bin/CryptoFoleo.o index ce7906b..40f9b4d 100644 Binary files a/bin/CryptoFoleo.o and b/bin/CryptoFoleo.o differ diff --git a/bin/Main.hi b/bin/Main.hi index 764fd94..d96de91 100644 Binary files a/bin/Main.hi and b/bin/Main.hi differ diff --git a/bin/Main.hs b/bin/Main.hs index 893bd81..62a1c64 100644 --- a/bin/Main.hs +++ b/bin/Main.hs @@ -4,29 +4,85 @@ import Control.Monad import CryptoFoleo import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 +import qualified Numeric as N main :: IO() main = do - --generate key files if the don't exist - existsPub <- doesFileExist "pub.key" - existsPrv <- doesFileExist "prv.key" - unless (existsPub && existsPrv) $ do - rsa_keygen 2048 $ \pub prv -> do - spub <- rsa_export pub - sprv <- rsa_export prv - writeFile "pub.key" spub - writeFile "prv.key" sprv + let s :: BS.ByteString + s = BS.pack + [ + 0x01, 0x03, 0x80, 0x8a, 0xfb, 0x0d, 0xb2, 0xfd, + 0x4a, 0xbf, 0xf6, 0xaf, 0x41, 0x49, 0xf5, 0x1b + ] + r :: BS.ByteString + r = BS.pack + [ + 0x85, 0xd6, 0xbe, 0x78, 0x57, 0x55, 0x6d, 0x33, + 0x7f, 0x44, 0x52, 0xfe, 0x42, 0xd5, 0x06, 0xa8 + ] + m :: BS.ByteString + m = BS.pack + [ + 0x43, 0x72, 0x79, 0x70, 0x74, 0x6f, 0x67, 0x72, + 0x61, 0x70, 0x68, 0x69, 0x63, 0x20, 0x46, 0x6f, + 0x72, 0x75, 0x6d, 0x20, 0x52, 0x65, 0x73, 0x65, + 0x61, 0x72, 0x63, 0x68, 0x20, 0x47, 0x72, 0x6f, + 0x75, 0x70 + ] - --load the key files if they do exist - spub <- readFile "pub.key" - sprv <- readFile "prv.key" - rsa_import spub $ \pubKey -> do - rsa_import sprv $ \prvKey -> do - let pt = C8.pack "one two three it's photosynthesis you see" - ct <- rsa_encrypt pubKey rsa_padding_oaep pt - dt <- rsa_decrypt prvKey rsa_padding_oaep ct - putStrLn $ "Plaintext:\n\t" ++ (show pt) - putStrLn $ "Ciphertext:\n\t" ++ (show ct) - putStrLn $ "Decrypted message:\n\t" ++ (show dt) + p <- poly1305 r s m + print $ byteStringToHexString p +-- --generate key files if the don't exist +-- existsPub <- doesFileExist "pub.key" +-- existsPrv <- doesFileExist "prv.key" +-- unless (existsPub && existsPrv) $ do +-- rsa_keygen 2048 $ \pub prv -> do +-- spub <- rsa_export pub +-- sprv <- rsa_export prv +-- writeFile "pub.key" spub +-- writeFile "prv.key" sprv +-- +-- --load the key files if they do exist +-- spub <- readFile "pub.key" +-- sprv <- readFile "prv.key" +-- rsa_import spub $ \pubKey -> do +-- rsa_import sprv $ \prvKey -> do +-- let pt = C8.pack "one two three it's photosynthesis you see" +-- ct <- rsa_encrypt pubKey rsa_padding_oaep pt +-- dt <- rsa_decrypt prvKey rsa_padding_oaep ct +-- putStrLn $ "Plaintext:\n\t" ++ (show pt) +-- putStrLn $ "Ciphertext:\n\t" ++ (show ct) +-- putStrLn $ "Decrypted message:\n\t" ++ (show dt) +-- +-- +-- g <- sha256 (C8.pack "abc") +-- print g +-- +-- prv1 <- dhke (BS.empty, BS.empty) +-- putStrLn "prv1=" +-- print prv1 +-- +-- prv2 <- dhke (BS.empty, BS.empty) +-- putStrLn "prv2=" +-- print prv2 +-- +-- pub1 <- dhke (prv1, BS.empty) +-- putStrLn "pub1=" +-- print pub1 +-- +-- pub2 <- dhke (prv2, BS.empty) +-- putStrLn "pub2=" +-- print pub2 +-- +-- key1 <- dhke(prv1, pub2) +-- putStrLn "key1=" +-- print key1 +-- +-- key2 <- dhke(prv2, pub1) +-- putStrLn "key2=" +-- print key2 +-- +-- + diff --git a/bin/Main.o b/bin/Main.o index 669f3de..39907d3 100644 Binary files a/bin/Main.o and b/bin/Main.o differ diff --git a/bin/libCryptoFoleo.so b/bin/libCryptoFoleo.so index ae87cb7..18ffc93 100755 Binary files a/bin/libCryptoFoleo.so and b/bin/libCryptoFoleo.so differ diff --git a/bin/main b/bin/main index dc273fa..e819b9b 100755 Binary files a/bin/main and b/bin/main differ