| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.Encryptable
Description
Data encryption is common security-related practice in
database usage. One of the negative side effects of encryption is
that typed data in its encrypted form becomes untyped and
usually exists in form of ByteString or similar blind type.
Operations with untyped data are very error-prone and should be avoided.
This library proposes the way to fix it.
Let's have an example of User sum type where his Login
is not sensitive type, but Address is sensitive.
Address should never be shown and should be stored only in
encrypted form.
newtype Login
= Login Text
deriving newtype (Eq, Arbitrary, Show, PersistField, PersistFieldSql)
newtype Address
= Address Text
deriving newtype (Eq, Arbitrary, Encryptable ByteString UnicodeException)
instance Show Address where
show = const "SECRET"
data User = User {login :: Login, address :: Address}
deriving (Eq, Generic, Show)
instance Arbitrary User where
arbitrary = genericArbitrary
shrink = genericShrink
Note how easy we derived Encryptable ByteString UnicodeException class
instance for Address type. Address is newtype around Text which already
have this instance - so we just got it for free. GeneralizedNewtypeDeriving
is a very powerful tool, indeed. Having this instance means that now we can
encrypt Address to ByteString form and decrypt back with possible
UnicodeException error (because not every encrypted ByteString represents
valid Address). You can find more details in Encrypted, Encryptable
and Encryptor documentation.
Now let's define UserStorage type, representation of User
stored in database. We will use Persistent library DSL for this.
share
[mkPersist sqlSettings]
[persistLowerCase|
UserStorage
login Login
address (Encrypted ByteString UnicodeException Address)
UniqueUserStorage login
|]
In spite of address database table column type is still just bytes,
compiler knows that these bytes in reality are encrypted representation
of Address value.
Just for fun let's implement class instance to encrypt User value
into UserStorage value.
instance Encryptable UserStorage UnicodeException User where
encrypt c i x = Encrypted $ UserStorage (login x) $ encrypt c i (address x)
decrypt c i x0 = do
let x = coerce x0
a <- decrypt c i $ userStorageAddress x
return $ User (userStorageLogin x) a
And then we can test property - User can be encrypted into
UserStorage form and decrypted back.
spec :: Spec
spec = before newEnv
$ it "UserStorage/User"
$ env -> property $ x -> do
let c = cipher env
let i = iv env
decrypt c i (encrypt c i x :: Encrypted UserStorage UnicodeException User)
`shouldBe` Right x
Synopsis
- newtype Encrypted b e a = Encrypted b
- class Encryptable b e a where
- encrypt :: BlockCipher c => c -> IV c -> a -> Encrypted b e a
- decrypt :: BlockCipher c => c -> IV c -> Encrypted b e a -> Either e a
- class Encryptor m where
- encryptM :: Encryptable b e a => a -> m (Encrypted b e a)
- decryptM :: Encryptable b e a => Encrypted b e a -> m (Either e a)
- reType :: Encrypted b e a -> Encrypted b e c
- data CryptoFailable a
- class Cipher cipher => BlockCipher cipher
- data AES256
- data IV c
- cipherInit :: (Cipher cipher, ByteArray key) => key -> CryptoFailable cipher
- makeIV :: (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
- getRandomBytes :: (MonadRandom m, ByteArray byteArray) => Int -> m byteArray
Type
newtype Encrypted b e a Source #
Value of this type represents value of type a (phantom) encrypted in form of value of type b (non-phantom) which can cause error of type e (phantom) in case where a constructor fails after decryption. This design promotes usage of smart constructors.
Constructors
| Encrypted b |
Instances
| PersistField b => PersistField (Encrypted b e a) Source # | |
Defined in Data.Encryptable Methods toPersistValue :: Encrypted b e a -> PersistValue # fromPersistValue :: PersistValue -> Either Text (Encrypted b e a) # | |
| PersistFieldSql b => PersistFieldSql (Encrypted b e a) Source # | |
Class
class Encryptable b e a where Source #
Class represents the idea of typed symmetric encryption and decryption
Methods
encrypt :: BlockCipher c => c -> IV c -> a -> Encrypted b e a Source #
decrypt :: BlockCipher c => c -> IV c -> Encrypted b e a -> Either e a Source #
Instances
class Encryptor m where Source #
Class represents one particular case of Encryptable
where BlockCipher and IV (initial vector) are
hidden inside m which often is
some sort of "application" monad which implements
this Encryptor class. Promotes finally tagless style.
Utility
reType :: Encrypted b e a -> Encrypted b e c Source #
Casts original phantom type a of Encrypted
value to some other type c. Useful for building
Encryptable instances on top of other already
existing Encryptable instances.
Re-export
data CryptoFailable a #
A simple Either like type to represent a computation that can fail
2 possibles values are:
CryptoPassed: The computation succeeded, and contains the result of the computationCryptoFailed: The computation failed, and contains the cryptographic error associated
Constructors
| CryptoPassed a | |
| CryptoFailed CryptoError |
Instances
class Cipher cipher => BlockCipher cipher #
Symmetric block cipher class
Minimal complete definition
Instances
AES with 256 bit key
Instances
an IV parametrized by the cipher
Instances
| Eq (IV c) | |
| BlockCipher c => ByteArrayAccess (IV c) | |
cipherInit :: (Cipher cipher, ByteArray key) => key -> CryptoFailable cipher #
Initialize a cipher context from a key
makeIV :: (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c) #
Create an IV for a specified block cipher
getRandomBytes :: (MonadRandom m, ByteArray byteArray) => Int -> m byteArray #