filepath-crypto (empty) → 0.0.0.0

raw patch · 8 files changed

+238/−0 lines, 8 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, case-insensitive, cryptoids, cryptoids-types, encoding, exceptions, filepath, sandi, template-haskell

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• changes.md +3/−0
• filepath-crypto.cabal +45/−0
• src/Data/Binary/SerializationLength.hs +24/−0
• src/Data/Binary/SerializationLength/Class.hs +10/−0
• src/Data/Binary/SerializationLength/TH.hs +17/−0
• src/System/FilePath/Cryptographic.hs +107/−0

@@ -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.

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

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

@@ -0,0 +1,45 @@+name: filepath-crypto+version: 0.0.0.0+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: aethoago@141.li+synopsis: Reversable and secure encoding of object ids as filepaths+category: cryptography+author: Gregor Kleen+extra-source-files:+    changes.md++source-repository head+    type: git+    location: https://git.rheperire.org/cryptoids+    subdir: filepath-crypto++library+    exposed-modules:+        System.FilePath.Cryptographic+        Data.Binary.SerializationLength+        Data.Binary.SerializationLength.TH+    build-depends:+        base >=4.9 && <4.11,+        cryptoids-types ==0.0.0,+        cryptoids ==0.4.0.*,+        filepath >=1.4.1.1 && <1.5,+        sandi >=0.4.1 && <0.5,+        case-insensitive >=1.2.0.10 && <1.3,+        binary >=0.8.3.0 && <0.9,+        bytestring >=0.10.8.1 && <0.11,+        exceptions >=0.8.3 && <0.9,+        encoding >=0.8.2 && <0.9,+        template-haskell >=2.11.0.0 && <2.13+    default-language: Haskell2010+    default-extensions: KindSignatures ViewPatterns FlexibleContexts+                        GeneralizedNewtypeDeriving PatternGuards RecordWildCards DataKinds+                        DeriveDataTypeable DeriveGeneric+    other-extensions: ScopedTypeVariables+    hs-source-dirs: src+    other-modules:+        Data.Binary.SerializationLength.Class+    ghc-options: -Wall -fno-warn-name-shadowing+

@@ -0,0 +1,24 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.Binary.SerializationLength+  ( HasFixedSerializationLength(..)+  ) where++import Data.Binary.SerializationLength.Class+import Data.Binary.SerializationLength.TH++import Data.Int+import Data.Word++$(hasFixedSerializationLength ''Word8 1)+$(hasFixedSerializationLength ''Word16 2)+$(hasFixedSerializationLength ''Word32 4)+$(hasFixedSerializationLength ''Word64 8)++$(hasFixedSerializationLength ''Int8 1)+$(hasFixedSerializationLength ''Int16 2)+$(hasFixedSerializationLength ''Int32 4)+$(hasFixedSerializationLength ''Int64 8)

@@ -0,0 +1,10 @@+{-# LANGUAGE TypeFamilies #-}++module Data.Binary.SerializationLength.Class+  ( HasFixedSerializationLength(..)+  ) where++import GHC.TypeLits++class KnownNat (SerializationLength a) => HasFixedSerializationLength a where+  type SerializationLength a :: Nat

@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++module Data.Binary.SerializationLength.TH+  ( hasFixedSerializationLength+  ) where++import Language.Haskell.TH++import Data.Binary.SerializationLength.Class+++hasFixedSerializationLength :: Name -> Integer -> DecsQ+hasFixedSerializationLength (return . ConT -> t) (return . LitT . NumTyLit -> i) =+  [d|+    instance HasFixedSerializationLength $(t) where+      type SerializationLength $(t) = $(i)+  |]

@@ -0,0 +1,107 @@+{-# LANGUAGE ScopedTypeVariables #-}++{-|+Description: Reversably generate filepaths 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 encrypted using a symmetric cipher in CBC mode using+the hashed namespace as an initialization vector (IV).+The ciphertext is then <https://hackage.haskell.org/package/sandi/docs/Codec-Binary-Base32.html base32>-encoded and padding stripped.++Rather than being indicated by the amount of padding, the length of the+serialized plaintext is instead carried at the type level within+'CryptoFileName' (analogously to the namespace).+Mismatches in serialized plaintext length are checked for but are /not/+guaranteed to cause runtime errors in all cases.++Since the serialized payload is padded to the length of the next cipher block we+can detect namespace mismatches by checking that all bytes expected to have been+inserted during padding are nil.+The probability of detecting a namespace mismatch is thus+\[1 - 2^{b \cdot \left \lceil \frac{l}{b} \right \rceil-l}])+where \(l\) is the length of the serialized payload.+-}+module System.FilePath.Cryptographic+  ( CryptoID(..)+  , CryptoFileName+  , module Data.Binary.SerializationLength+  , encrypt+  , decrypt+  , CryptoIDError(..)+  ) 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 System.FilePath (FilePath)+import qualified Codec.Binary.Base32 as Base32+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Binary+import Data.Binary.SerializationLength+import Data.Encoding.UTF8+import Data.Encoding (decodeStrictByteString, encodeStrictByteString)+import Data.Char (toUpper)++import Data.Ratio ((%))+import Data.List++import qualified Data.ByteString as ByteString++import Control.Monad+import Control.Monad.Catch++import Data.Proxy+import GHC.TypeLits+++-- | @serializedLength@ is given in bytes.+type CryptoFileName (namespace :: Symbol) = CryptoID namespace (CI FilePath)+++paddedLength :: Integral a => a -> a+paddedLength l = bs * ceiling (l % bs)+  where bs = fromIntegral cipherBlockSize++-- | Encrypt an arbitrary serializable value+--+-- We only expect to fail if the given value is not serialized in such a fashion+-- that it meets the expected length given at type level.+encrypt :: forall a m namespace.+           ( KnownSymbol namespace+           , Binary a+           , MonadThrow m+           , HasFixedSerializationLength a+           ) => CryptoIDKey -> a -> m (CryptoFileName namespace)+encrypt = Poly.encrypt determineLength $ return . encode+  where+    determineLength str = do+      let l = ByteString.length str+      unless (fromIntegral l == natVal (Proxy :: Proxy (SerializationLength a))) $+        throwM $ CiphertextConversionFailed str+      return . Just $ paddedLength l+    encode str = CI.mk . dropWhileEnd (== '=') . decodeStrictByteString UTF8 $ Base32.encode str+++-- | Decrypt an arbitrary serializable value+--+-- Since no integrity guarantees can be made (we do not sign the values we+-- 'encrypt') it is likely that deserialization will fail emitting+-- 'DeserializationError' or 'InvalidNamespaceDetected'.+decrypt :: forall a m namespace.+           ( KnownSymbol namespace+           , Binary a+           , MonadThrow m+           , HasFixedSerializationLength a+           ) => CryptoIDKey -> CryptoFileName namespace -> m a+decrypt = Poly.decrypt $ (\str -> either (const . throwM $ CiphertextConversionFailed str) return $ Base32.decode str) . encodeStrictByteString UTF8 . padding (natVal (Proxy :: Proxy (SerializationLength a))) . map toUpper . CI.original+  where+    padding l str = str ++ replicate (genericIndex paddingTable $ l' `mod` 5) '='+      where+        l' = paddedLength l+    paddingTable = [0, 6, 4, 3, 1]