Refactor & generalize

cryptoids-types/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2017, Gregor Kleen
+
+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 Gregor Kleen 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.

cryptoids-types/Setup.hs

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

cryptoids-types/cryptoids-types.cabal

@@ -0,0 +1,24 @@
+name:                cryptoids-types
+description:         Shared types for encrypting internal object identifiers before exposing them in public facing apis
+version:             0.0.0
+license:             BSD3
+license-file:        LICENSE
+author:              Gregor Kleen
+maintainer:          aethoago@141.li
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Data.CryptoID
+  default-extensions:  KindSignatures
+                     , DataKinds
+                     , GeneralizedNewtypeDeriving
+                     , DeriveGeneric
+                     , DeriveDataTypeable
+  build-depends:       base >=4.9 && <4.10
+                     , binary
+                     , path-pieces
+                     , http-api-data
+  hs-source-dirs:      src
+  default-language:    Haskell2010

cryptoids-types/cryptoids-types.nix

@@ -0,0 +1,8 @@
+{ mkDerivation, base, binary, http-api-data, path-pieces, stdenv }:
+mkDerivation {
+  pname = "cryptoids-types";
+  version = "0.0.0";
+  src = ./.;
+  libraryHaskellDepends = [ base binary http-api-data path-pieces ];
+  license = stdenv.lib.licenses.bsd3;
+}

cryptoids-types/src/Data/CryptoID.hs

@@ -0,0 +1,22 @@
+module Data.CryptoID
+  ( CryptoID(..)
+  ) where
+
+import GHC.Generics (Generic)
+import Data.Typeable (Typeable)
+import Data.Data (Data)
+import GHC.TypeLits (Symbol)
+
+import Data.Binary (Binary)
+import Foreign.Storable (Storable)
+
+import Web.PathPieces (PathPiece)
+import Web.HttpApiData (ToHttpApiData, FromHttpApiData)
+
+newtype CryptoID (namespace :: Symbol) a = CryptoID { ciphertext :: a }
+  deriving ( Eq, Ord
+           , Read, Show
+           , Binary, Storable
+           , Data, Typeable, Generic
+           , PathPiece, ToHttpApiData, FromHttpApiData
+           )

cryptoids.nix

@@ -0,0 +1,7 @@
+{ callPackage }:
+
+rec {
+  cryptoids-types = callPackage ./cryptoids-types/cryptoids-types.nix {};
+  uuid-crypto = callPackage ./uuid-crypto/uuid-crypto.nix {};
+  cryptoids = callPackage ./cryptoids/cryptoids.nix { inherit cryptoids-types; };
+}

cryptoids/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2017, Gregor Kleen
+
+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 Gregor Kleen 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.

cryptoids/Setup.hs

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

cryptoids/cryptoids.cabal

@@ -0,0 +1,34 @@
+-- Initial cryptoids.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                cryptoids
+version:             0.0.0
+synopsis:            Reversable and secure encoding of object ids as a bytestring
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Gregor Kleen
+maintainer:          aethoago@141.li
+-- copyright:           
+category:            cryptography
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Data.CryptoID.Poly
+  -- other-modules:       
+  default-extensions:  RankNTypes
+                     , DataKinds
+                     , GeneralizedNewtypeDeriving
+                     , ViewPatterns
+                     , RecordWildCards
+                     , FlexibleContexts
+  build-depends:       base >=4.9 && <4.10
+                     , cryptoids-types
+                     , cryptonite
+                     , bytestring
+                     , binary
+                     , memory
+                     , mtl
+  hs-source-dirs:      src
+  default-language:    Haskell2010

cryptoids/cryptoids.nix

@@ -0,0 +1,13 @@
+{ mkDerivation, base, binary, bytestring, cryptoids-types
+, cryptonite, memory, stdenv
+}:
+mkDerivation {
+  pname = "cryptoids";
+  version = "0.0.0";
+  src = ./.;
+  libraryHaskellDepends = [
+    base binary bytestring cryptoids-types cryptonite memory
+  ];
+  description = "Reversable and secure encoding of object ids as a bytestring";
+  license = stdenv.lib.licenses.bsd3;
+}

cryptoids/src/Data/CryptoID/Poly.hs

@@ -0,0 +1,181 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-|
+Description: Reversably generate variable length bytestrings from arbitrary serializable types in a secure fashion
+License: BSD3
+
+Given a value of a serializable type (like 'Int') we perform serialization and
+compute a cryptographic hash of the associated namespace (carried as a phantom
+type of kind 'Symbol').
+The serialized payload is then encrypted using the a symmetric cipher in CBC
+mode using the hashed namespace as an initialization vector (IV).
+
+The probability of detecting a namespace mismatch is thus \(1 - 2^{128-l}\)
+where \(l\) is the length of the serialized payload.
+-}
+module Data.CryptoID.Poly
+  ( CryptoID(..)
+  , CryptoIDKey
+  , genKey
+  , encrypt
+  , decrypt
+  , CryptoIDError(..)
+  , CryptoCipher, CryptoHash
+  ) where
+
+import Data.CryptoID
+
+import Data.Binary
+import Data.Binary.Put
+import Data.Binary.Get
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Char8 as ByteString.Char
+
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Data.ByteString.Lazy as Lazy.ByteString
+
+import Data.List (sortOn)
+import Data.Ord (Down(..))
+
+import Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as ByteArray
+
+import Data.Foldable (asum)
+import Control.Monad.Except
+import Control.Exception
+
+import Data.Typeable
+import GHC.TypeLits
+
+import Crypto.Cipher.Types
+import Crypto.Cipher.Blowfish (Blowfish)
+import Crypto.Hash (hash, Digest)
+import Crypto.Hash.Algorithms (SHAKE128)
+import Crypto.Error
+
+import Crypto.Random.Entropy
+
+
+-- | The symmetric cipher 'BlockCipher' this module uses 
+type CryptoCipher = Blowfish
+-- | The cryptographic 'HashAlgorithm' this module uses
+--
+-- We expect the block size of 'CryptoCipher' to be exactly the size of the
+-- 'Digest' generated by 'CryptoHash' (since a 'Digest' is used as an 'IV').
+--
+-- Violation of this expectation causes runtime errors.
+type CryptoHash   = SHAKE128 64
+  
+
+-- | This newtype ensures only keys of the correct length can be created
+--
+-- Use 'genKey' to securely generate keys.
+--
+-- Use the 'Binary' instance to save and restore values of 'CryptoIDKey' across
+-- executions.
+newtype CryptoIDKey = CryptoIDKey { keyMaterial :: ByteString }
+  deriving (Typeable, ByteArrayAccess)
+
+-- | Does not actually show any key material
+instance Show CryptoIDKey where
+  show = show . typeOf
+
+instance Binary CryptoIDKey where
+  put = putByteString . keyMaterial
+  get = CryptoIDKey <$> getKey (cipherKeySize cipher)
+    where
+      cipher :: CryptoCipher
+      cipher = undefined
+
+      -- Try key sizes from large to small ('Get' commits to the first branch
+      -- that parses)
+      getKey (KeySizeFixed n) = getByteString n
+      getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ]
+      getKey (KeySizeRange min max) = getKey $ KeySizeEnum [max .. min]
+
+
+-- | Error cases that can be encountered during 'encrypt' and 'decrypt'
+data CryptoIDError
+  = AlgorithmError CryptoError
+    -- ^ One of the underlying cryptographic algorithms
+    --   ('CryptoHash' or 'CryptoCipher') failed.
+  | NamespaceHashIsWrongLength ByteString
+    -- ^ The length of the digest produced by 'CryptoHash' does
+    --   not match the block size of 'CryptoCipher'.
+    --
+    -- The offending digest is included.
+    --
+    -- This error should not occur and is included primarily
+    -- for sake of totality.
+  | CiphertextConversionFailed
+    -- ^ The produced 'ByteString' is the wrong length for conversion into a
+    --   ciphertext.
+  | DeserializationError (Lazy.ByteString, ByteOffset, String)
+    -- ^ The plaintext obtained by decrypting a ciphertext with the given
+    --   'CryptoIDKey' in the context of the @namespace@ could not be
+    --   deserialized into a value of the expected @payload@-type.
+    --
+    -- This is expected behaviour if the @namespace@ or @payload@-type does not
+    -- match the ones used during 'encrypt'ion or if the 'ciphertext' was
+    -- tempered with.
+  | InvalidNamespaceDetected
+    -- ^ We have determined that, allthough deserializion succeded, the
+    --   ciphertext was likely modified during transit or created using a
+    --   different namespace.
+  deriving (Show, Eq)
+
+instance Exception CryptoIDError
+
+-- | Securely generate a new key using system entropy
+--
+-- When 'CryptoCipher' accepts keys of varying lengths this function generates a
+-- key of the largest accepted size.
+genKey :: MonadIO m => m CryptoIDKey
+genKey = CryptoIDKey <$> liftIO (getEntropy keySize)
+  where
+    keySize' = cipherKeySize (undefined :: CryptoCipher)
+
+    keySize
+      | KeySizeFixed n <- keySize' = n
+      | KeySizeEnum ns <- keySize' = maximum ns
+      | KeySizeRange _ max <- keySize' = max
+  
+
+-- | Use 'CryptoHash' to generate a 'Digest' of the Symbol passed as proxy type
+namespace' :: forall proxy namespace m.
+              ( KnownSymbol namespace, MonadError CryptoIDError m
+              ) => proxy namespace -> m (IV CryptoCipher)
+namespace' p = case makeIV namespaceHash of
+                 Nothing -> throwError . NamespaceHashIsWrongLength $ ByteArray.convert namespaceHash
+                 Just iv -> return iv
+  where
+    namespaceHash :: Digest CryptoHash
+    namespaceHash = hash . ByteString.Char.pack $ symbolVal p
+
+-- | Wrap failure of one of the cryptographic algorithms as a 'CryptoIDError'
+cryptoFailable :: MonadError CryptoIDError m => CryptoFailable a -> m a
+cryptoFailable = either (throwError . AlgorithmError) return . eitherCryptoError
+
+-- | Encrypt an arbitrary serializable value
+encrypt :: forall a m namespace.
+           ( KnownSymbol namespace
+           , MonadError CryptoIDError m
+           ) => CryptoIDKey -> ByteString -> m (CryptoID namespace ByteString)
+encrypt (keyMaterial -> key) plaintext = do
+  cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
+  namespace <- namespace' (Proxy :: Proxy namespace)
+  return . CryptoID $ cbcEncrypt cipher namespace plaintext
+
+
+-- | Decrypt an arbitrary serializable value
+decrypt :: forall a m namespace.
+           ( KnownSymbol namespace
+           , MonadError CryptoIDError m
+           ) => CryptoIDKey -> CryptoID namespace ByteString -> m ByteString
+decrypt (keyMaterial -> key) CryptoID{..} = do
+  cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
+  namespace <- namespace' (Proxy :: Proxy namespace)
+  return $ cbcDecrypt cipher namespace ciphertext
+

default.nix

@@ -0,0 +1,6 @@
+argumentPackages@{ ... }:
+
+let
+  defaultPackages = (import <nixpkgs> {}).haskellPackages;
+  haskellPackages = defaultPackages // argumentPackages;
+in import ./cryptoids.nix { inherit (haskellPackages) callPackage; }

gup/Gupfile

@@ -0,0 +1,2 @@
+cabal2nix.gup:
+  **/*.nix

gup/cabal2nix.gup

@@ -0,0 +1,8 @@
+#! /usr/bin/env nix-shell
+#! nix-shell -i zsh -p zsh haskellPackages.cabal2nix
+
+gup -u ${2:r}.cabal
+
+cd ${2:h}
+
+cabal2nix . > $1

shell.nix

@@ -0,0 +1,20 @@
+{ nixpkgs ? import <nixpkgs> {}, compiler ? null }:
+
+let
+  inherit (nixpkgs) pkgs;
+
+  haskellPackages = if isNull compiler
+                       then pkgs.haskellPackages
+                       else pkgs.haskell.packages.${compiler};
+
+  drvs = import ./. { inherit (haskellPackages) callPackage; };
+
+  override = oldAttrs: {
+    nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ cabal2nix gup ]) ++ (with haskellPackages; [ hlint stack cabal-install ]);
+    shellHook = ''
+      ${oldAttrs.shellHook}
+      export PROMPT_INFO="${oldAttrs.name}"
+    '';
+  };
+in
+  pkgs.lib.mapAttrs (name: drv: pkgs.stdenv.lib.overrideDerivation drv.env override) drvs

stack.nix

@@ -0,0 +1,13 @@
+{ ghc, nixpkgs ? (import <nixpkgs> {}) }:
+
+let
+  inherit (nixpkgs) haskell pkgs;
+in haskell.lib.buildStackProject {
+  inherit ghc;
+  name = ''stackenv-uuid-crypto'';
+  buildInputs = with pkgs;
+    [ postgresql zlib.dev ncurses.dev
+      haskellPackages.yesod-bin haskellPackages.happy
+      haskellPackages.alex
+    ];
+}

stack.yaml

@@ -0,0 +1,72 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-9.3
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+  - cryptoids-types
+  - cryptoids
+  - uuid-crypto
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.4"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
+nix:
+  packages: []
+  shell-file: ./stack.nix

uuid-crypto/src/Data/UUID/Cryptographic.hs

@@ -10,184 +10,59 @@ type of kind 'Symbol').
 The serialized payload is then encrypted using the a symmetric cipher in CBC
 mode using the hashed namespace as an initialization vector (IV).
 
-Since the serialized payload is padded to exactly the length of a single cipher
+Since the serialized payload is padded to the length of an UUID we can detect
-block we can detect namespace mismatches by checking that all bytes expected to
+namespace mismatches by checking that all bytes expected to have been inserted
-have been inserted during padding are nil.
+during padding are nil.
 The probability of detecting a namespace mismatch is thus \(1 - 2^{128-l}\)
 where \(l\) is the length of the serialized payload.
 -}
 module Data.UUID.Cryptographic
   ( CryptoID(..)
-  , CryptoIDKey
+  , CryptoUUID
-  , genKey
-  , CryptoIDError(..)
   , encrypt
   , decrypt
-  , CryptoCipher, CryptoHash
+  , CryptoIDError(..)
   ) where
 
+import Data.CryptoID
+import Data.CryptoID.Poly hiding (encrypt, decrypt)
+import qualified Data.CryptoID.Poly as Poly (encrypt, decrypt)
+
 import Data.UUID (UUID, toByteString, fromByteString)
 import Data.Binary
-import Data.Binary.Put
-import Data.Binary.Get
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Char8 as ByteString.Char
 
-import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 
-import Data.List (sortOn)
-import Data.Ord (Down(..))
-
 import Data.ByteArray (ByteArrayAccess)
 import qualified Data.ByteArray as ByteArray
 
-import Data.Foldable (asum)
 import Control.Monad.Except
-import Control.Exception
 
-import Data.Typeable
 import GHC.TypeLits
 
 import Crypto.Cipher.Types
-import Crypto.Cipher.AES (AES256)
-import Crypto.Hash (hash, Digest)
-import Crypto.Hash.Algorithms (SHAKE128)
-import Crypto.Error
-
-import Crypto.Random.Entropy
-
-import GHC.Generics (Generic)
-import Data.Data (Data)
-import Foreign.Storable (Storable)
 
 
--- | The symmetric cipher 'BlockCipher' this module uses 
+type CryptoUUID (namespace :: Symbol) = CryptoID namespace UUID
-type CryptoCipher = AES256
--- | The cryptographic 'HashAlgorithm' this module uses
---
--- We expect the block size of 'CryptoCipher' to be exactly the size of the
--- 'Digest' generated by 'CryptoHash'.
---
--- Violation of this expectation causes runtime errors.
-type CryptoHash   = SHAKE128 128
 
 
--- | This newtype ensures only keys of the correct length can be created
+mapCiphertext :: Functor m => (a -> m b) -> CryptoID n a -> m (CryptoID n b)
---
+mapCiphertext f (CryptoID x) = CryptoID <$> f x
--- Use 'genKey' to securely generate keys.
---
--- Use the 'Binary' instance to save and restore values of 'CryptoIDKey' across
--- executions.
-newtype CryptoIDKey = CryptoIDKey { keyMaterial :: ByteString }
-  deriving (Typeable, ByteArrayAccess)
-
--- | Does not actually show any key material
-instance Show CryptoIDKey where
-  show = show . typeOf
-
-instance Binary CryptoIDKey where
-  put = putByteString . keyMaterial
-  get = CryptoIDKey <$> getKey (cipherKeySize cipher)
-    where
-      cipher :: CryptoCipher
-      cipher = undefined
-
-      -- Try key sizes from large to small ('Get' commits to the first branch
-      -- that parses)
-      getKey (KeySizeFixed n) = getByteString n
-      getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ]
-      getKey (KeySizeRange min max) = getKey $ KeySizeEnum [max .. min]
-
-
--- | A thin wrapper around 'UUID' to carry the type information from which we
---   infer what payload we expect the 'UUID' to contain.
-newtype CryptoID (namespace :: Symbol) = CryptoID { ciphertext :: UUID }
-  deriving (Eq, Data, Ord, Read, Show, Binary, Typeable, Storable, Generic)
-
--- | Error cases that can be encountered during 'encrypt' and 'decrypt'
-data CryptoIDError = AlgorithmError CryptoError
-                     -- ^ One of the underlying cryptographic algorithms
-                     --   ('CryptoHash' or 'CryptoCipher') failed.
-                   | NamespaceHashIsWrongLength ByteString
-                     -- ^ The length of the digest produced by 'CryptoHash' does
-                     --   not match the block size of 'CryptoCipher'.
-                     --
-                     -- The offending digest is included.
-                     --
-                     -- This error should not occur and is included primarily
-                     -- for sake of totality.
-                   | PlaintextTooLong ByteString
-                     -- ^ The serialized representation of the payload exceeds
-                     --   the block size of 'CryptoCipher'.
-                     --
-                     -- The offending serialization is included.
-                   | UUIDConversionFailed
-                     -- ^ The length of the produced ciphertext (which is
-                     --   expected to be exactly one block size of
-                     --   'CryptoCipher') does not match the size expected for a
-                     --   'UUID' (128 bits).
-                     --
-                     -- This error should not occur and is included primarily
-                     -- for sake of totality.
-                   | DeserializationError (Lazy.ByteString, ByteOffset, String)
-                     -- ^ The plaintext obtained by decrypting a 'UUID' with the
-                     --   given 'CryptoIDKey' in the context of the @namespace@
-                     --   could not be deserialized into a value of the expected
-                     --   @payload@-type.
-                     --
-                     -- This is expected behaviour if the @namespace@ or
-                     -- @payload@-type does not match the ones used during
-                     -- 'encrypt'ion or if the 'ciphertext' was tempered with.
-                   | InvalidNamespaceDetected
-                     -- ^ We have determined that, allthough deserializion
-                     --   succeded, the 'UUID' was likely modified during
-                     --   transit or created using a different namespace.
-  deriving (Show, Eq)
-
-instance Exception CryptoIDError
-
--- | Securely generate a new key using system entropy
---
--- When 'CryptoCipher' accepts keys of varying lengths this function generates a
--- key of the largest accepted size.
-genKey :: MonadIO m => m CryptoIDKey
-genKey = CryptoIDKey <$> liftIO (getEntropy keySize)
-  where
-    keySize' = cipherKeySize (undefined :: CryptoCipher)
-
-    keySize
-      | KeySizeFixed n <- keySize' = n
-      | KeySizeEnum ns <- keySize' = maximum ns
-      | KeySizeRange _ max <- keySize' = max
 
 
 -- | @pad err size src@ appends null bytes to @src@ until it has length @size@.
 --
 -- If @src@ is already longer than @size@ @err@ is thrown instead.
-pad :: (MonadError e m, ByteArrayAccess a) => (ByteString -> e) -> Int -> a -> m ByteString
+pad :: (MonadError CryptoIDError m, ByteArrayAccess a) => Int -> a -> m ByteString
-pad err n (ByteArray.unpack -> src)
+pad n (ByteArray.unpack -> src)
-  | l > n     = throwError . err $ ByteString.pack src
+  | l > n     = throwError CiphertextConversionFailed
   | otherwise = return . ByteString.pack $ src ++ replicate (n - l) 0
   where
     l = length src
 
--- | Use 'CryptoHash' to generate a 'Digest' of the Symbol passed as proxy type
-namespace' :: forall proxy namespace m.
-              ( KnownSymbol namespace, MonadError CryptoIDError m
-              ) => proxy namespace -> m (IV CryptoCipher)
-namespace' p = case makeIV namespaceHash of
-                 Nothing -> throwError . NamespaceHashIsWrongLength $ ByteArray.convert namespaceHash
-                 Just iv -> return iv
-  where
-    namespaceHash = hash . ByteString.Char.pack $ symbolVal p :: Digest CryptoHash
-
--- | Wrap failure of one of the cryptographic algorithms as a 'CryptoIDError'
-cryptoFailable :: MonadError CryptoIDError m => CryptoFailable a -> m a
-cryptoFailable = either (throwError . AlgorithmError) return . eitherCryptoError
-
 -- | Encrypt an arbitrary serializable value
 --
 -- We only expect to fail if the given value is not serialized in such a fashion
@@ -199,16 +74,15 @@ encrypt :: forall a m namespace.
            ( KnownSymbol namespace
            , Binary a
            , MonadError CryptoIDError m
-           ) => CryptoIDKey -> a -> m (CryptoID namespace)
+           ) => CryptoIDKey -> a -> m (CryptoUUID namespace)
-encrypt (keyMaterial -> key) val = do
+encrypt key val = do
-  cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
+  plaintext <- pad (blockSize cipher) . Lazy.ByteString.toStrict $ encode val
   
-  namespace <- namespace' (Proxy :: Proxy namespace)
+  mapCiphertext uuidConversion =<< Poly.encrypt key plaintext
-  plaintext <- pad PlaintextTooLong (blockSize cipher) . Lazy.ByteString.toStrict $ encode val
-  
-  CryptoID <$> uuidConversion (cbcEncrypt cipher namespace plaintext)
     where
-      uuidConversion = maybe (throwError UUIDConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict
+      uuidConversion = maybe (throwError CiphertextConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict
+      cipher :: CryptoCipher
+      cipher = undefined
 
 
 -- | Decrypt an arbitrary serializable value
@@ -220,13 +94,10 @@ decrypt :: forall a m namespace.
            ( KnownSymbol namespace
            , Binary a
            , MonadError CryptoIDError m
-           ) => CryptoIDKey -> CryptoID namespace -> m a
+           ) => CryptoIDKey -> CryptoUUID namespace -> m a
-decrypt (keyMaterial -> key) CryptoID{..} = do
+decrypt key id = do
-  cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
+  id' <- (return . Lazy.ByteString.toStrict . toByteString) `mapCiphertext` id
-  
+  plaintext <- Lazy.ByteString.fromStrict <$> Poly.decrypt key id'
-  namespace <- namespace' (Proxy :: Proxy namespace)
-  let ciphertext' = Lazy.ByteString.toStrict $ toByteString ciphertext
-      plaintext = Lazy.ByteString.fromStrict (cbcDecrypt cipher namespace ciphertext')
 
   case decodeOrFail plaintext of
     Left err -> throwError $ DeserializationError err

uuid-crypto/uuid-crypto.cabal

@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                uuid-crypto
-version:             0.1.0
+version:             1.0.0
 synopsis:            Reversable and secure encoding of object ids as uuids
 -- description:         
 license:             BSD3
@@ -28,6 +28,8 @@ library
                      , DeriveGeneric
   other-extensions:    ScopedTypeVariables
   build-depends:       base >=4.9 && <4.11
+                     , cryptoids-types
+                     , cryptoids
                      , uuid
                      , cryptonite
                      , binary