encryptable (empty) → 0.1

raw patch · 10 files changed

+438/−0 lines, 10 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, cryptonite, encryptable, esqueleto, generic-arbitrary, hspec, persistent, persistent-template, quickcheck-instances, text, universum

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +3/−0
• Setup.hs +2/−0
• encryptable.cabal +78/−0
• src/Data/Encryptable.hs +175/−0
• test/EncryptableSpec.hs +30/−0
• test/Spec.hs +2/−0
• test/TestEnv.hs +56/−0
• test/UserSpec.hs +59/−0

@@ -0,0 +1,3 @@+# Version 0.1++- Initial version.

@@ -0,0 +1,30 @@+Coingaming (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+# encryptable++Typed encryption with persistent support. You can find documentation at [hackage](http://hackage.haskell.org/package/encryptable/docs/Data-Encryptable.html).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           encryptable+version:        0.1+synopsis:       Typed encryption with persistent support+description:    You can find documentation at <http://hackage.haskell.org/package/encryptable/docs/Data-Encryptable.html hackage>+category:       Cryptography, Database, Yesod+homepage:       https://github.com/coingaming/encryptable#readme+bug-reports:    https://github.com/coingaming/encryptable/issues+author:         Ilja Tkachuk <tkachuk.labs@gmail.com>+maintainer:     Ilja Tkachuk <tkachuk.labs@gmail.com>+copyright:      2020 Coingaming <hello@coingaming.io>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/coingaming/encryptable++library+  exposed-modules:+      Data.Encryptable+  other-modules:+      Paths_encryptable+  hs-source-dirs:+      src+  default-extensions: NoImplicitPrelude MultiParamTypeClasses LambdaCase OverloadedStrings ScopedTypeVariables+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction+  build-depends:+      QuickCheck >=2.13.2 && <2.14+    , base >=4.7 && <5+    , bytestring >=0.10.8 && <0.11+    , cryptonite >=0.25 && <0.27+    , esqueleto >=3.0.0 && <3.4+    , generic-arbitrary >=0.1.0 && <0.2+    , hspec >=2.7.1 && <2.8+    , persistent >=2.9.2 && <2.10+    , persistent-template >=2.6.0 && <2.7+    , quickcheck-instances >=0.3.22 && <0.4+    , text >=1.2.3 && <1.3+    , universum >=1.5.0 && <1.6+  default-language: Haskell2010++test-suite encryptable-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      EncryptableSpec+      TestEnv+      UserSpec+      Paths_encryptable+  hs-source-dirs:+      test+  default-extensions: NoImplicitPrelude MultiParamTypeClasses LambdaCase OverloadedStrings ScopedTypeVariables+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck >=2.13.2 && <2.14+    , base >=4.7 && <5+    , bytestring >=0.10.8 && <0.11+    , cryptonite >=0.25 && <0.27+    , encryptable+    , esqueleto >=3.0.0 && <3.4+    , generic-arbitrary >=0.1.0 && <0.2+    , hspec >=2.7.1 && <2.8+    , persistent >=2.9.2 && <2.10+    , persistent-template >=2.6.0 && <2.7+    , quickcheck-instances >=0.3.22 && <0.4+    , text >=1.2.3 && <1.3+    , universum >=1.5.0 && <1.6+  default-language: Haskell2010

@@ -0,0 +1,175 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | 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+-- @+module Data.Encryptable+  ( -- * Type+    Encrypted (..),++    -- * Class+    Encryptable (..),+    Encryptor (..),++    -- * Utility+    reType,++    -- * Re-export+    CryptoFailable (..),+    BlockCipher,+    AES256,+    IV,+    cipherInit,+    makeIV,+    getRandomBytes,+  )+where++import Crypto.Cipher.AES (AES256)+import Crypto.Cipher.Types (BlockCipher, IV, cipherInit, ctrCombine, makeIV)+import Crypto.Error (CryptoFailable (..))+import Crypto.Random (getRandomBytes)+import qualified Data.ByteString.Lazy as BL (ByteString, fromStrict, toStrict)+import Data.Coerce (coerce)+import qualified Data.Text.Encoding as TE (decodeUtf8', encodeUtf8)+import qualified Data.Text.Lazy as TL (Text, fromStrict, toStrict)+import Database.Esqueleto (PersistField, PersistFieldSql)+import Universum++-- | 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.+newtype Encrypted b e a = Encrypted b+  deriving (PersistField, PersistFieldSql)++-- | Class represents the idea of+-- typed symmetric encryption and decryption+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 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.+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)++instance Encryptable ByteString e ByteString where+  encrypt c i = Encrypted . ctrCombine c i+  decrypt c i = Right . ctrCombine c i . coerce++instance Encryptable ByteString e BL.ByteString where+  encrypt c i = reType . encrypt c i . BL.toStrict+  decrypt c i = second BL.fromStrict . decrypt c i . reType++instance Encryptable ByteString UnicodeException Text where+  encrypt c i = reType . encrypt c i . TE.encodeUtf8+  decrypt c i x = decrypt c i (reType x) >>= TE.decodeUtf8'++instance Encryptable ByteString UnicodeException TL.Text where+  encrypt c i = reType . encrypt c i . TL.toStrict+  decrypt c i = second TL.fromStrict . decrypt c i . reType++instance (Traversable f, Encryptable b e a) => Encryptable (f b) e (f a) where+  encrypt c i =+    Encrypted . ((coerce . (encrypt c i :: a -> Encrypted b e a) :: a -> b) <$>)+  decrypt c i xs =+    mapM (decrypt c i . Encrypted) (coerce xs :: f b)++-- | 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.+reType :: Encrypted b e a -> Encrypted b e c+reType = Encrypted . coerce

@@ -0,0 +1,30 @@+module EncryptableSpec+  ( spec,+  )+where++import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.Lazy as TL+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import TestEnv+import Universum++spec :: Spec+spec = before newEnv $ do+  --+  -- TODO : Traversable and Persistent properties+  --+  it "ByteString/ByteString" $ \env -> property $ \x ->+    reCryptBS env x+      `shouldBe` (Right x :: Either () ByteString)+  it "ByteString/BL.ByteString" $ \env -> property $ \x ->+    reCryptBS env x+      `shouldBe` (Right x :: Either () BL.ByteString)+  it "ByteString/Text" $ \env -> property $ \x ->+    reCryptBS env x+      `shouldBe` (Right x :: Either UnicodeException Text)+  it "ByteString/TL.Text" $ \env -> property $ \x ->+    reCryptBS env x+      `shouldBe` (Right x :: Either UnicodeException TL.Text)

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -Wno-missing-export-lists #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,56 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module TestEnv+  ( Env (..),+    newEnv,+    reCryptBS,+    Login (..),+    Address (..),+  )+where++import Data.Encryptable+import Database.Esqueleto (PersistField, PersistFieldSql)+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import Universum+import Prelude (Show (..))++data Env = Env {cipher :: AES256, iv :: IV AES256}++newEnv :: IO Env+newEnv = do+  c0 :: ByteString <- getRandomBytes 32+  i0 :: ByteString <- getRandomBytes 16+  c <- case cipherInit c0 of+    CryptoPassed x -> return x+    CryptoFailed _ -> fail "BAD_CIPHER"+  i <- case makeIV i0 of+    Just x -> return x+    Nothing -> fail "BAD_IV"+  return $ Env c i++reCryptBS ::+  forall a e.+  (Encryptable ByteString e a) =>+  Env ->+  a ->+  Either e a+reCryptBS env x =+  decrypt c i (encrypt c i x :: Encrypted ByteString e a)+  where+    c = cipher env+    i = iv env++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"

@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module UserSpec+  ( spec,+    -- just supressing warning+    UserStorageId,+  )+where++import Data.Coerce (coerce)+import Data.Encryptable+import Database.Persist.TH+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.Generic+import Test.QuickCheck.Instances ()+import TestEnv+import Universum++data User = User {login :: Login, address :: Address}+  deriving (Eq, Generic, Show)++instance Arbitrary User where+  arbitrary = genericArbitrary+  shrink = genericShrink++share+  [mkPersist sqlSettings]+  [persistLowerCase|+    UserStorage+      login Login+      address (Encrypted ByteString UnicodeException Address)+      UniqueUserStorage login+  |]++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++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