Skip to content
Snippets Groups Projects
Commit 0a749a33 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone
Browse files

wip - adding BlockCipher to replace the other uses

parent 6bfeb84b
No related branches found
No related tags found
1 merge request!54Switch away from cipher-aes128
......@@ -10,9 +10,10 @@ module Tahoe.CHK.Cipher (
) where
import Control.DeepSeq (NFData)
import Crypto.Cipher.Types (Cipher (..))
import Crypto.Cipher.Types (BlockCipher (..), Cipher (..))
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.Coerce (coerce)
import GHC.Generics (Generic)
data Key cipher = Key {keyBytes :: ScrubbedBytes, keyCipher :: cipher}
......@@ -25,6 +26,18 @@ instance forall cipher. Cipher cipher => Cipher (Key cipher) where
cipherName _ = cipherName @cipher undefined
cipherKeySize _ = cipherKeySize @cipher undefined
instance forall cipher. BlockCipher cipher => BlockCipher (Key cipher) where
blockSize _ = blockSize @cipher undefined
ecbEncrypt = ecbEncrypt . keyCipher
ecbDecrypt = ecbDecrypt . keyCipher
cbcEncrypt (Key _ cipher) iv = cbcEncrypt cipher (coerce iv)
cbcDecrypt (Key _ cipher) iv = cbcDecrypt cipher (coerce iv)
cfbEncrypt (Key _ cipher) iv = cfbEncrypt cipher (coerce iv)
cfbDecrypt (Key _ cipher) iv = cfbDecrypt cipher (coerce iv)
ctrCombine (Key _ cipher) iv = ctrCombine cipher (coerce iv)
aeadInit mode (Key _ cipher) iv = xxx
instance BA.ByteArrayAccess (Key cipher) where
length (Key ba _) = BA.length ba
withByteArray (Key ba _) = BA.withByteArray ba
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
......@@ -35,6 +36,7 @@ import Data.IORef (
)
import qualified Data.Binary as Binary
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
......@@ -60,8 +62,8 @@ import System.IO (
)
import Crypto.Cipher.AES (AES128)
import Crypto.Cipher.Types (BlockCipher, Cipher (cipherInit))
import Crypto.Random (getRandomBytes)
import Crypto.Cipher.Types (BlockCipher, Cipher (cipherInit, cipherKeySize), KeySizeSpecifier (..))
import "cryptonite" Crypto.Random (getRandomBytes)
import Tahoe.CHK.Cipher (Key)
import Tahoe.CHK.Crypto (
......@@ -339,8 +341,14 @@ getConvergentKey secret params content =
buildKeyIO :: forall cipher. BlockCipher cipher => IO (Key cipher)
buildKeyIO = do
keyBytes <- getRandomBytes (cipherKeySize @cipher undefined)
fromJust . maybeCryptoError . cipherInit $ keyBytes
keyBytes <- getRandomBytes @IO @ScrubbedBytes keySize
pure . fromJust . maybeCryptoError . cipherInit $ keyBytes
where
keySize = case cipherKeySize @cipher undefined of
KeySizeRange _ high -> high
KeySizeEnum [] -> error "no key sizes!"
KeySizeEnum (s : _) -> s
KeySizeFixed s -> s
-- Create an uploadable with a random key.
filesystemUploadableRandomConvergence :: FilePath -> Parameters -> IO Uploadable
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment