Built cryptoids-class

cryptoids-class/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-class/Setup.hs

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

cryptoids-class/changes.md

@@ -0,0 +1,3 @@
+# 0.0.0
+
+First published version

cryptoids-class/cryptoids-class.cabal

@@ -0,0 +1,39 @@
+-- This file has been generated from package.yaml by hpack version 0.21.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 58e6a5c78e58b86751a93cc27c85fb09bbdd1b80ba3aaae841dca1bae5abd231
+
+name:           cryptoids-class
+version:        0.0.0
+synopsis:       Typeclass-based interface to cryptoids
+category:       Web
+author:         Gregor Kleen <aethoago@141.li>
+maintainer:     Gregor Kleen <aethoago@141.li>
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+
+extra-source-files:
+    changes.md
+
+source-repository head
+  type: git
+  location: https://git.rheperire.org/cryptoids/cryptoids-class
+
+library
+  exposed-modules:
+      Data.CryptoID.Class
+      Data.CryptoID.Class.ImplicitNamespace
+  other-modules:
+      Paths_cryptoids_class
+  hs-source-dirs:
+      src
+  default-extensions: DataKinds KindSignatures MultiParamTypeClasses TypeFamilies FlexibleContexts ConstraintKinds PatternSynonyms
+  ghc-options: -Wall -fno-warn-name-shadowing
+  build-depends:
+      base
+    , cryptoids-types
+    , exceptions
+  default-language: Haskell2010

cryptoids-class/package.yaml

@@ -0,0 +1,35 @@
+name: cryptoids-class
+synopsis: Typeclass-based interface to cryptoids
+version: 0.0.0
+license: BSD3
+license-file: LICENSE
+author: Gregor Kleen <aethoago@141.li>
+maintainer: Gregor Kleen <aethoago@141.li>
+category: Web
+extra-source-files:
+  - changes.md
+git: https://git.rheperire.org/cryptoids/cryptoids-class
+
+default-extensions:
+  - DataKinds
+  - KindSignatures
+  - MultiParamTypeClasses
+  - TypeFamilies
+  - FlexibleContexts
+  - ConstraintKinds
+  - PatternSynonyms
+
+ghc-options:
+  - -Wall
+  - -fno-warn-name-shadowing
+
+dependencies:
+  - base
+  - cryptoids-types
+  - exceptions
+
+library:
+  source-dirs: src
+  exposed-modules:
+    - Data.CryptoID.Class
+    - Data.CryptoID.Class.ImplicitNamespace

cryptoids-class/src/Data/CryptoID/Class.hs

@@ -0,0 +1,27 @@
+{-|
+Description: Polymorphic functions on 'CryptoID's
+License: BSD3
+-}
+module Data.CryptoID.Class
+  ( MonadCrypto(..)
+  , HasCryptoID(..)
+  ) where
+
+import Data.CryptoID (CryptoID)
+
+import GHC.TypeLits (Symbol)
+
+import Control.Monad.Catch (MonadThrow)
+
+-- | Class of monads granting reader access to a key and allowing for failure during cryptographic operations
+--
+-- This formulation is weaker than @MonadReader key@ (from mtl) in that it does not require @local@.
+class MonadThrow m => MonadCrypto (m :: * -> *) where
+  type MonadCryptoKey m :: *
+  cryptoIDKey :: (MonadCryptoKey m -> m a) -> m a
+
+class MonadCrypto m => HasCryptoID (namespace :: Symbol) (ciphertext :: *) (plaintext :: *) (m :: * -> *) where
+  encrypt :: plaintext -> m (CryptoID namespace ciphertext)
+  decrypt :: CryptoID namespace ciphertext -> m plaintext
+
+

cryptoids-class/src/Data/CryptoID/Class/ImplicitNamespace.hs

@@ -0,0 +1,28 @@
+module Data.CryptoID.Class.ImplicitNamespace
+  ( E.MonadCrypto(..)
+  , CryptoIDNamespace
+  , HasCryptoID
+  , CryptoID, pattern E.CryptoID, E.ciphertext
+  , encrypt, decrypt
+  ) where
+
+import qualified Data.CryptoID.Class as E
+import qualified Data.CryptoID as E
+
+import GHC.TypeLits (Symbol)
+  
+
+type family CryptoIDNamespace (ciphertext :: *) (plaintext :: *) :: Symbol
+
+type HasCryptoID ciphertext plaintext = E.HasCryptoID (CryptoIDNamespace ciphertext plaintext) ciphertext plaintext
+
+type CryptoID ciphertext plaintext = E.CryptoID (CryptoIDNamespace ciphertext plaintext) ciphertext
+
+
+encrypt :: HasCryptoID ciphertext plaintext m => plaintext -> m (CryptoID ciphertext plaintext)
+-- ^ Specialised version of 'encrypt' for when @(plaintext, ciphertext)@ uniquely determines the namespace
+encrypt = E.encrypt
+
+decrypt :: HasCryptoID ciphertext plaintext m => CryptoID ciphertext plaintext -> m plaintext
+-- ^ Specialised version of 'decrypt' for when @(plaintext, ciphertext)@ uniquely determines the namespace
+decrypt = E.decrypt

cryptoids/changes.md

@@ -1,3 +1,6 @@
+# 0.5.0.0
+    - Add support for 'cryptoids-class'
+
 # 0.4.0.0
     - Expose 'cipherBlockSize'
     - Adjust 'Data.CryptoID.Poly' to allow for more dynamic padding

cryptoids/package.yaml

@@ -1,5 +1,5 @@
 name: cryptoids
-version: 0.4.0.0
+version: 0.5.0.0
 synopsis: Reversable and secure encoding of object ids as a bytestring
 category: cryptography
 author: Gregor Kleen <aethoago@141.li>
@@ -16,12 +16,17 @@ default-extensions:
   - ViewPatterns
   - RecordWildCards
   - FlexibleContexts
+  - FlexibleInstances
+  - MultiParamTypeClasses
+  - TypeFamilies
+  - ConstraintKinds
 ghc-options:
   - -Wall
   - -fno-warn-name-shadowing
 dependencies:
   - base
   - cryptoids-types
+  - cryptoids-class
   - cryptonite
   - bytestring
   - binary
@@ -34,4 +39,6 @@ library:
   source-dirs: src
   exposed-modules:
     - Data.CryptoID.Poly
+    - Data.CryptoID.Poly.ImplicitNamespace
     - Data.CryptoID.ByteString
+    - Data.CryptoID.ByteString.ImplicitNamespace

cryptoids/src/Data/CryptoID/ByteString.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-|
 Description: Encryption of bytestrings using a type level nonce for determinism
@@ -13,7 +14,8 @@ The probability of detecting a namespace mismatch is thus the density of valid
 payloads within all 'ByteString's of the correct length.
 -}
 module Data.CryptoID.ByteString
-  ( CryptoID(..)
+  ( CryptoByteString
+  , HasCryptoByteString
   , CryptoIDKey
   , genKey, readKeyFile
   , encrypt
@@ -21,9 +23,13 @@ module Data.CryptoID.ByteString
   , CryptoIDError(..)
   , CryptoCipher, CryptoHash
   , cipherBlockSize
+  , module Data.CryptoID
+  , module Data.CryptoID.Class
   ) where
 
 import Data.CryptoID
+import Data.CryptoID.Class hiding (encrypt, decrypt)
+import qualified Data.CryptoID.Class as Class (encrypt, decrypt)
 
 import Data.Binary
 import Data.Binary.Put
@@ -175,6 +181,11 @@ readKeyFile keyFile = liftIO $ decodeFile keyFile `catch` generateInstead
       | otherwise = throw e
 
 
+type CryptoByteString (namespace :: Symbol) = CryptoID namespace ByteString
+
+type HasCryptoByteString (namespace :: Symbol) = HasCryptoID namespace ByteString
+  
+
 -- | Use 'CryptoHash' to generate a 'Digest' of the Symbol passed as proxy type
 namespace' :: forall proxy namespace m.
               ( KnownSymbol namespace, MonadThrow m
@@ -212,3 +223,10 @@ decrypt (keyMaterial -> key) CryptoID{..} = do
   cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
   namespace <- namespace' (Proxy :: Proxy namespace)
   return $ cbcDecrypt cipher namespace ciphertext
+
+instance ( MonadCrypto m
+         , MonadCryptoKey m ~ CryptoIDKey
+         , KnownSymbol namespace
+         ) => HasCryptoID namespace ByteString ByteString m where
+  encrypt = cryptoIDKey . flip encrypt
+  decrypt = cryptoIDKey . flip decrypt

cryptoids/src/Data/CryptoID/ByteString/ImplicitNamespace.hs

@@ -0,0 +1,15 @@
+module Data.CryptoID.ByteString.ImplicitNamespace
+  ( CryptoByteString
+  , HasCryptoByteString
+  , module Data.CryptoID.ByteString
+  , module Data.CryptoID.Class.ImplicitNamespace
+  ) where
+
+import Data.CryptoID.Class.ImplicitNamespace
+
+import Data.CryptoID.ByteString hiding (encrypt, decrypt, CryptoID, HasCryptoID, CryptoByteString, HasCryptoByteString)
+
+import Data.ByteString (ByteString)
+
+type CryptoByteString plaintext = CryptoID ByteString plaintext
+type HasCryptoByteString plaintext = HasCryptoID ByteString plaintext

cryptoids/src/Data/CryptoID/Poly.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-|
 Description: Encryption of bytestrings using a type level nonce for determinism
@@ -18,18 +19,15 @@ The probability of detecting a namespace mismatch is thus \(1 - 2^{l \
 \text{mod} \ 64}\) where \(l\) is the length of the serialized payload in bits.
 -}
 module Data.CryptoID.Poly
-  ( CryptoID(..)
-  , CryptoIDKey
-  , genKey, readKeyFile
-  , encrypt
+  ( encrypt
   , decrypt
-  , CryptoIDError(..)
-  , CryptoCipher, CryptoHash
+  , module Data.CryptoID.ByteString
   ) where
 
-import Data.CryptoID
 import Data.CryptoID.ByteString hiding (encrypt, decrypt)
 import qualified Data.CryptoID.ByteString as ByteString (encrypt, decrypt)
+import Data.CryptoID.Class (HasCryptoID)
+import qualified Data.CryptoID.Class as Class (HasCryptoID(..))
 
 import Data.Binary
 
@@ -87,3 +85,11 @@ decrypt decode key cID = do
     Right (rem, _, res)
       | Lazy.ByteString.all (== 0) rem -> return res
       | otherwise -> throwM InvalidNamespaceDetected
+
+instance ( MonadCrypto m
+         , MonadCryptoKey m ~ CryptoIDKey
+         , KnownSymbol namespace
+         , Binary a
+         ) => HasCryptoID namespace ByteString a m where
+  encrypt = cryptoIDKey . flip (encrypt (const $ return Nothing) return)
+  decrypt = cryptoIDKey . flip (decrypt return)

cryptoids/src/Data/CryptoID/Poly/ImplicitNamespace.hs

@@ -0,0 +1,8 @@
+module Data.CryptoID.Poly.ImplicitNamespace
+  ( module Data.CryptoID.Poly
+  , module Data.CryptoID.Class.ImplicitNamespace
+  ) where
+
+import Data.CryptoID.Class.ImplicitNamespace
+
+import Data.CryptoID.Poly hiding (encrypt, decrypt, CryptoID, HasCryptoID)

filepath-crypto/changes.md

@@ -1,3 +1,6 @@
+# 0.1.0.0
+    - Add support for 'cryptoids-class'
+
 # 0.0.0.3
     - Got rid of `encoding`
 

filepath-crypto/package.yaml

@@ -1,5 +1,5 @@
 name: filepath-crypto
-version: 0.0.0.3
+version: 0.1.0.0
 synopsis: Reversable and secure encoding of object ids as filepaths
 category: cryptography
 author: Gregor Kleen <aethoago@141.li>
@@ -19,6 +19,10 @@ default-extensions:
   - DataKinds
   - DeriveDataTypeable
   - DeriveGeneric
+  - FlexibleInstances
+  - MultiParamTypeClasses
+  - TypeFamilies
+  - ConstraintKinds
 other-extensions:
   - ScopedTypeVariables
 ghc-options:
@@ -27,6 +31,7 @@ ghc-options:
 dependencies:
   - base
   - cryptoids-types
+  - cryptoids-class
   - cryptoids
   - filepath
   - sandi
@@ -40,5 +45,6 @@ library:
   source-dirs: src
   exposed-modules:
     - System.FilePath.Cryptographic
+    - System.FilePath.Cryptographic.ImplicitNamespace
     - Data.Binary.SerializationLength
     - Data.Binary.SerializationLength.TH

filepath-crypto/src/System/FilePath/Cryptographic.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-|
 Description: Reversably generate filepaths from arbitrary serializable types in a secure fashion
@@ -28,18 +29,19 @@ where \(l\) is the length of the serialized payload and \(b\) the length of a
 ciphertext block (both in bits).
 -}
 module System.FilePath.Cryptographic
-  ( CryptoID(..)
-  , CryptoFileName
+  ( CryptoFileName
+  , HasCryptoFileName
   , module Data.Binary.SerializationLength
   , encrypt
   , decrypt
-  , CryptoIDError(..)
+  , module Data.CryptoID.Poly
   ) where
 
-import Data.CryptoID
 import Data.CryptoID.Poly hiding (encrypt, decrypt)
 import Data.CryptoID.ByteString (cipherBlockSize)
 import qualified Data.CryptoID.Poly as Poly (encrypt, decrypt)
+import Data.CryptoID.Class (HasCryptoID)
+import qualified Data.CryptoID.Class as Class (HasCryptoID(..))
 
 import System.FilePath (FilePath)
 import qualified Codec.Binary.Base32 as Base32
@@ -63,6 +65,7 @@ import GHC.TypeLits
 
 
 type CryptoFileName (namespace :: Symbol) = CryptoID namespace (CI FilePath)
+type HasCryptoFileName (namespace :: Symbol) = HasCryptoID namespace (CI FilePath)
 
 
 paddedLength :: Integral a => a -> a
@@ -107,3 +110,12 @@ decrypt = Poly.decrypt $ (\str -> either (const . throwM $ CiphertextConversionF
       where
         l' = paddedLength l
     paddingTable = [0, 6, 4, 3, 1]
+
+instance ( MonadCrypto m
+         , MonadCryptoKey m ~ CryptoIDKey
+         , KnownSymbol namespace
+         , Binary a
+         , HasFixedSerializationLength a
+         ) => HasCryptoID namespace (CI FilePath) a m where
+  encrypt = cryptoIDKey . flip encrypt
+  decrypt = cryptoIDKey . flip decrypt

filepath-crypto/src/System/FilePath/Cryptographic/ImplicitNamespace.hs

@@ -0,0 +1,16 @@
+module System.FilePath.Cryptographic.ImplicitNamespace
+  ( CryptoFileName
+  , HasCryptoFileName
+  , module System.FilePath.Cryptographic
+  , module Data.CryptoID.Class.ImplicitNamespace
+  ) where
+
+import Data.CryptoID.Class.ImplicitNamespace
+
+import System.FilePath.Cryptographic hiding (encrypt, decrypt, CryptoID, HasCryptoID, CryptoFileName, HasCryptoFileName)
+
+import System.FilePath (FilePath)
+import Data.CaseInsensitive (CI)
+
+type CryptoFileName plaintext = CryptoID (CI FilePath) plaintext
+type HasCryptoFileName plaintext = HasCryptoID (CI FilePath) plaintext

gup/cryptoids.nix.gup

@@ -7,6 +7,7 @@ gup -u \
     ./cryptoids-types/cryptoids-types.nix \
     ./uuid-crypto/uuid-crypto.nix \
     ./filepath-crypto/filepath-crypto.nix \
+    ./cryptoids/cryptoids-class.nix \
     ./cryptoids/cryptoids.nix
 
  <<EOF
@@ -16,6 +17,7 @@ rec {
   cryptoids-types = callPackage ./cryptoids-types/cryptoids-types.nix {};
   uuid-crypto = callPackage ./uuid-crypto/uuid-crypto.nix {};
   filepath-crypto = callPackage ./filepath-crypto/filepath-crypto.nix {};
+  cryptoids-class = callPackage ./cryptoids-class/cryptoids-class.nix { inherit cryptoids cryptoids-types; };
   cryptoids = callPackage ./cryptoids/cryptoids.nix { inherit cryptoids-types; };
 }
 EOF

stack.yaml

@@ -38,6 +38,7 @@ resolver: lts-10.3
 packages:
   - cryptoids-types
   - cryptoids
+  - cryptoids-class
   - uuid-crypto
   - filepath-crypto
 # Dependency packages to be pulled from upstream that are not in the resolver

uuid-crypto/changes.md

@@ -1,3 +1,6 @@
+# 1.4.0.0
+    - Add support for 'cryptoids-class'
+
 # 1.3.1.0
     - Fix documentation mistake
     - Bump @cryptoids@ to @0.4.0.*@

uuid-crypto/package.yaml

@@ -1,5 +1,5 @@
 name: uuid-crypto
-version: 1.3.1.0
+version: 1.4.0.0
 synopsis: Reversable and secure encoding of object ids as uuids
 category: cryptography
 author: Gregor Kleen <aethoago@141.li>
@@ -19,6 +19,10 @@ default-extensions:
   - DataKinds
   - DeriveDataTypeable
   - DeriveGeneric
+  - FlexibleInstances
+  - MultiParamTypeClasses
+  - TypeFamilies
+  - ConstraintKinds
 other-extensions:
   - ScopedTypeVariables
 ghc-options:
@@ -27,6 +31,7 @@ ghc-options:
 dependencies:
   - base
   - cryptoids-types
+  - cryptoids-class
   - cryptoids
   - uuid
   - binary
@@ -37,3 +42,4 @@ library:
   source-dirs: src
   exposed-modules:
     - Data.UUID.Cryptographic
+    - Data.UUID.Cryptographic.ImplicitNamespace

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-|
 Description: Reversably generate UUIDs from arbitrary serializable types in a secure fashion
@@ -17,16 +18,17 @@ 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(..)
-  , CryptoUUID
+  ( CryptoUUID
+  , HasCryptoUUID
   , encrypt
   , decrypt
-  , CryptoIDError(..)
+  , module Data.CryptoID.Poly
   ) where
 
-import Data.CryptoID
 import Data.CryptoID.Poly hiding (encrypt, decrypt)
 import qualified Data.CryptoID.Poly as Poly (encrypt, decrypt)
+import Data.CryptoID.Class (HasCryptoID)
+import qualified Data.CryptoID.Class as Class (HasCryptoID(..))
 
 import Data.UUID (UUID, toByteString, fromByteString)
 import Data.Binary
@@ -39,6 +41,7 @@ import GHC.TypeLits
 
 
 type CryptoUUID (namespace :: Symbol) = CryptoID namespace UUID
+type HasCryptoUUID (namespace :: Symbol) = HasCryptoID namespace UUID
 
 
 -- | Encrypt an arbitrary serializable value
@@ -64,3 +67,11 @@ decrypt :: forall a m namespace.
            , MonadThrow m
            ) => CryptoIDKey -> CryptoUUID namespace -> m a
 decrypt = Poly.decrypt $ return . Lazy.ByteString.toStrict . toByteString
+
+instance ( MonadCrypto m
+         , MonadCryptoKey m ~ CryptoIDKey
+         , KnownSymbol namespace
+         , Binary a
+         ) => HasCryptoID namespace UUID a m where
+  encrypt = cryptoIDKey . flip encrypt
+  decrypt = cryptoIDKey . flip decrypt

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

@@ -0,0 +1,15 @@
+module Data.UUID.Cryptographic.ImplicitNamespace
+  ( CryptoUUID
+  , HasCryptoUUID
+  , module Data.UUID.Cryptographic
+  , module Data.CryptoID.Class.ImplicitNamespace
+  ) where
+
+import Data.CryptoID.Class.ImplicitNamespace
+
+import Data.UUID.Cryptographic hiding (encrypt, decrypt, CryptoID, HasCryptoID, CryptoUUID, HasCryptoUUID)
+
+import Data.UUID (UUID)
+
+type CryptoUUID plaintext = CryptoID UUID plaintext
+type HasCryptoUUID plaintext = HasCryptoID UUID plaintext