From c76217f75de17b33fb9769e5a61d0bcd79d8772d Mon Sep 17 00:00:00 2001 From: tdietert Date: Sat, 18 Mar 2017 23:57:24 +0000 Subject: [PATCH 1/4] Added more comprehensive tutorial --- Crypto/Tutorial.hs | 77 ++++++++++++++++++++++++++++++---------------- 1 file changed, 50 insertions(+), 27 deletions(-) diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs index 83487c7..55f99f9 100644 --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -1,34 +1,57 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} -{-| How to use @cryptonite@ +{- How to use @cryptonite@ with symmetric block ciphers -> -- | Beware MUST BE 256bits as we use AES256 -> import Data.ByteString (ByteString) -> import Crypto.Cipher.AES (AES256) -> import Crypto.Cipher.Types (BlockCipher(..), Cipher(..),nullIV) -> import Crypto.Error (CryptoFailable(..)) -> -> secretKey :: ByteString -> secretKey = "012-456-89A-CDE-012-456-89A-CDE-" -> -> encrypt :: ByteString -> ByteString -> ByteString -> encrypt secret = ctrCombine ctx nullIV -> where -> ctx = cipherInitNoErr (cipherMakeKey (undefined :: AES256) secret) -> cipherInitNoErr :: BlockCipher c => Key c -> c -> cipherInitNoErr (Key k) = case cipherInit k of -> CryptoPassed a -> a -> CryptoFailed e -> error (show e) -> cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher -> cipherMakeKey _ = Key -- Yeah Lazyness!!!!!! -> -> -> decrypt :: ByteString -> ByteString -> ByteString +> import Crypto.Cipher.AES (AES256) +> import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), nullIV, KeySizeSpecifier(..)) +> import Crypto.Error (CryptoFailable(..), CryptoError(..)) +> +> import qualified Crypto.Random.Types as CRT +> +> import Data.ByteArray (ByteArray) +> import Data.ByteString (ByteString) +> +> -- | Not required, but most general implementation +> data Key c a where +> Key :: (BlockCipher c, ByteArray a) => a -> Key c a +> +> genPrivateKey :: forall m c a. (CRT.MonadRandom m, BlockCipher c, ByteArray a) +> => c -> m (Key c a) +> genPrivateKey _ = fmap Key $ CRT.getRandomBytes $ +> case cipherKeySize (undefined :: c) of +> KeySizeRange _ maxSize -> maxSize +> KeySizeFixed ks -> ks +> KeySizeEnum [] -> error "No key size specified" +> KeySizeEnum kss -> last kss -- largest key size +> +> initCipher :: (BlockCipher c, ByteArray a) => Key c a -> Either CryptoError c +> initCipher (Key k) = case cipherInit k of +> CryptoFailed e -> Left e +> CryptoPassed a -> Right a +> +> encrypt :: (BlockCipher c, ByteArray a) => Key c a -> a -> Either CryptoError a +> encrypt privKey msg = +> case initCipher privKey of +> Left e -> Left e +> Right c -> Right $ ctrCombine c nullIV msg +> +> decrypt :: (BlockCipher c, ByteArray a) => Key c a -> a -> Either CryptoError a > decrypt = encrypt +> +> exampleAES256 :: ByteString -> IO () +> exampleAES256 msg = do +> privKey <- genPrivateKey (undefined :: AES256) +> let eMsg = encrypt privKey msg >>= decrypt privKey +> case eMsg of +> Left err -> error $ show err +> Right msg' -> do +> putStrLn $ "Original Message: " ++ show msg +> putStrLn $ "Message after encryption & decryption: " ++ show msg' +> +> -- | More Examples... ? |-} -module Crypto.Tutorial () where - -import Crypto.Cipher.Types +module Crypto.Tutorial.General where From ec49ea659e6d7d5c1fb0ffbd7ea3fd2024f1d145 Mon Sep 17 00:00:00 2001 From: tdietert Date: Sun, 19 Mar 2017 00:02:07 +0000 Subject: [PATCH 2/4] Move language pragmas inside haddocks --- Crypto/Tutorial.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs index 55f99f9..935694d 100644 --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE GADTs #-} {- How to use @cryptonite@ with symmetric block ciphers +> {-# LANGUAGE OverloadedStrings #-} +> {-# LANGUAGE ScopedTypeVariables #-} +> {-# LANGUAGE GADTs #-} +> > import Crypto.Cipher.AES (AES256) > import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), nullIV, KeySizeSpecifier(..)) > import Crypto.Error (CryptoFailable(..), CryptoError(..)) From fd75eac415b476ada7ca7c86930f74b7718a740c Mon Sep 17 00:00:00 2001 From: tdietert Date: Sun, 19 Mar 2017 00:37:36 +0000 Subject: [PATCH 3/4] Fix Crypto.Tutorial module name --- Crypto/Tutorial.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs index 935694d..369b021 100644 --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -55,4 +55,4 @@ |-} -module Crypto.Tutorial.General where +module Crypto.Tutorial where From f639ac9f0ddc2cb9b1b1788ae22f8b57f898c7f9 Mon Sep 17 00:00:00 2001 From: tdietert Date: Sun, 26 Mar 2017 00:47:02 +0000 Subject: [PATCH 4/4] Update tutorial based on suggestions --- Crypto/Tutorial.hs | 57 ++++++++++++++++++++++++++-------------------- 1 file changed, 32 insertions(+), 25 deletions(-) diff --git a/Crypto/Tutorial.hs b/Crypto/Tutorial.hs index 369b021..f0bdb97 100644 --- a/Crypto/Tutorial.hs +++ b/Crypto/Tutorial.hs @@ -1,12 +1,12 @@ -{- How to use @cryptonite@ with symmetric block ciphers +{- How to use @cryptonite@ with symmetric block ciphers > {-# LANGUAGE OverloadedStrings #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE GADTs #-} > > import Crypto.Cipher.AES (AES256) -> import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), nullIV, KeySizeSpecifier(..)) +> import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), nullIV, KeySizeSpecifier(..), IV, makeIV) > import Crypto.Error (CryptoFailable(..), CryptoError(..)) > > import qualified Crypto.Random.Types as CRT @@ -18,40 +18,47 @@ > data Key c a where > Key :: (BlockCipher c, ByteArray a) => a -> Key c a > -> genPrivateKey :: forall m c a. (CRT.MonadRandom m, BlockCipher c, ByteArray a) -> => c -> m (Key c a) -> genPrivateKey _ = fmap Key $ CRT.getRandomBytes $ -> case cipherKeySize (undefined :: c) of -> KeySizeRange _ maxSize -> maxSize -> KeySizeFixed ks -> ks -> KeySizeEnum [] -> error "No key size specified" -> KeySizeEnum kss -> last kss -- largest key size -> +> -- | Generates a string of bytes (key) of a specific length for a given block cipher +> genSecretKey :: forall m c a. (CRT.MonadRandom m, BlockCipher c, ByteArray a) => c -> Int -> m (Key c a) +> genSecretKey _ = fmap Key . CRT.getRandomBytes +> +> -- | Generate a random initialization vector for a given block cipher +> genRandomIV :: forall m c. (CRT.MonadRandom m, BlockCipher c) => c -> m (Maybe (IV c)) +> genRandomIV _ = do +> bytes :: ByteString <- CRT.getRandomBytes $ blockSize (undefined :: c) +> return $ makeIV bytes +> +> -- | Initialize a block cipher > initCipher :: (BlockCipher c, ByteArray a) => Key c a -> Either CryptoError c > initCipher (Key k) = case cipherInit k of > CryptoFailed e -> Left e > CryptoPassed a -> Right a > -> encrypt :: (BlockCipher c, ByteArray a) => Key c a -> a -> Either CryptoError a -> encrypt privKey msg = -> case initCipher privKey of +> encrypt :: (BlockCipher c, ByteArray a) => Key c a -> IV c -> a -> Either CryptoError a +> encrypt secretKey initIV msg = +> case initCipher secretKey of > Left e -> Left e -> Right c -> Right $ ctrCombine c nullIV msg +> Right c -> Right $ ctrCombine c initIV msg > -> decrypt :: (BlockCipher c, ByteArray a) => Key c a -> a -> Either CryptoError a +> decrypt :: (BlockCipher c, ByteArray a) => Key c a -> IV c -> a -> Either CryptoError a > decrypt = encrypt > > exampleAES256 :: ByteString -> IO () > exampleAES256 msg = do -> privKey <- genPrivateKey (undefined :: AES256) -> let eMsg = encrypt privKey msg >>= decrypt privKey -> case eMsg of -> Left err -> error $ show err -> Right msg' -> do -> putStrLn $ "Original Message: " ++ show msg -> putStrLn $ "Message after encryption & decryption: " ++ show msg' -> -> -- | More Examples... ? +> -- secret key needs 256 bits (32 * 8) +> secretKey <- genSecretKey (undefined :: AES256) 32 +> mInitIV <- genRandomIV (undefined :: AES256) +> case mInitIV of +> Nothing -> error "Failed to generate and initialization vector." +> Just initIV -> do +> let encryptedMsg = encrypt secretKey initIV msg +> decryptedMsg = decrypt secretKey initIV =<< encryptedMsg +> case (,) <$> encryptedMsg <*> decryptedMsg of +> Left err -> error $ show err +> Right (eMsg, dMsg) -> do +> putStrLn $ "Original Message: " ++ show msg +> putStrLn $ "Message after encryption: " ++ show eMsg +> putStrLn $ "Message after decryption: " ++ show dMsg |-}