add from hackage; update to support lts-23.24

Dockerfile

@@ -0,0 +1,17 @@
+FROM haskell:9.8.4
+
+WORKDIR /opt/filepath-crypto
+
+# RUN stack install --resolver lts-24.0 --compiler ghc-9.10.1 hpack
+
+# Add just the .cabal file to capture dependencies
+# COPY ./filepath-crypto.cabal /opt/filepath-crypto/filepath-crypto.cabal
+
+# Docker will cache this command as a layer, freeing us up to
+# modify source code without re-installing dependencies
+# (unless the .cabal file changes!)
+
+# Add and Install Application Code
+COPY . /opt/filepath-crypto
+# RUN stack build --resolver lts-24.0 --only-dependencies -j4
+RUN stack build --resolver lts-23.24 --compiler ghc-9.8.4 filepath-crypto

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.

Setup.hs

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

changes.md

@@ -0,0 +1,15 @@
+# 0.1.0.0
+    - Add support for 'cryptoids-class'
+
+# 0.0.0.3
+    - Got rid of `encoding`
+
+# 0.0.0.2
+    - Improved documentation
+
+# 0.0.0.1
+    - Improved documentation
+
+# 0.0.0.0
+
+First published version

filepath-crypto.cabal

@@ -0,0 +1,45 @@
+name: filepath-crypto
+version: 0.2.0.0
+cabal-version: >=1.10
+build-type: Simple
+license: BSD3
+license-file: LICENSE
+maintainer: Gregor Kleen <aethoago@141.li>
+synopsis: Reversable and secure encoding of object ids as filepaths
+category: cryptography
+author: Gregor Kleen <aethoago@141.li>
+extra-source-files:
+    changes.md
+
+source-repository head
+    type: git
+    location: https://git.rheperire.org/cryptoids/filepath-crypto
+
+library
+    exposed-modules:
+        System.FilePath.Cryptographic
+        System.FilePath.Cryptographic.ImplicitNamespace
+        Data.Binary.SerializationLength
+        Data.Binary.SerializationLength.TH
+    build-depends:
+        base >=4.10.1.0 && <5,
+        binary >=0.8.5.1 && <0.9,
+        bytestring >=0.10.8.2 && <0.13,
+        case-insensitive >=1.2.0.10 && <2,
+        cryptoids >=0.6.0.0 && <0.7,
+        exceptions >=0.8.3 && <0.11,
+        filepath >=1.4.1.2 && <2,
+        sandi >=0.4.1 && <0.6,
+        template-haskell >=2.12.0.0 && <3
+    default-language: Haskell2010
+    default-extensions: KindSignatures ViewPatterns FlexibleContexts
+                        GeneralizedNewtypeDeriving PatternGuards RecordWildCards DataKinds
+                        DeriveDataTypeable DeriveGeneric FlexibleInstances
+                        MultiParamTypeClasses TypeFamilies ConstraintKinds
+    other-extensions: ScopedTypeVariables
+    hs-source-dirs: src
+    other-modules:
+        Data.Binary.SerializationLength.Class
+        Paths_filepath_crypto
+    ghc-options: -Wall -fno-warn-name-shadowing
+

packages.yaml

@@ -0,0 +1,13 @@
+name: filepath-crypto
+version: 0.2.0.0
+
+dependencies:
+  - base >=4.10.1.0 && <5
+  - binary >=0.8.5.1 && <0.9
+  - bytestring >=0.10.8.2 && <0.13
+  - case-insensitive >=1.2.0.10 && <2
+  - cryptoids >=0.6.0.0 && <0.7
+  - exceptions >=0.8.3 && <0.9
+  - filepath >=1.4.1.2 && <2
+  - sandi >=0.4.1 && <0.6
+  - template-haskell >=2.12.0.0 && <3

src/Data/Binary/SerializationLength.hs

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

src/Data/Binary/SerializationLength/Class.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Data.Binary.SerializationLength.Class
+  ( HasFixedSerializationLength(..)
+  ) where
+
+import GHC.TypeLits
+
+-- | The class of types for which the result of serialization with @Data.Binary@
+--   is known statically to be of a certain length
+class KnownNat (SerializationLength a) => HasFixedSerializationLength a where
+  -- | The 'SerializationLength' is given in bytes at type level
+  type SerializationLength a :: Nat

src/Data/Binary/SerializationLength/TH.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+module Data.Binary.SerializationLength.TH
+  ( hasFixedSerializationLength
+  ) where
+
+import Language.Haskell.TH
+
+import Data.Binary.SerializationLength.Class
+
+
+hasFixedSerializationLength :: Name -> Integer -> DecsQ
+-- | Shorthand for defining instances of 'HasFixedSerializationLength', morally:
+--
+-- > hasFixedSerializationLength typeName byteN = [d|
+-- >     instance HasFixedSerializiationLength $(typeName) where
+-- >       type SerializationLength $(typeName) = $(byteN)
+-- >   |]
+hasFixedSerializationLength (return . ConT -> t) (return . LitT . NumTyLit -> i) =
+  [d|
+    instance HasFixedSerializationLength $(t) where
+      type SerializationLength $(t) = $(i)
+  |]

src/System/FilePath/Cryptographic.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-|
+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 \left \lceil \frac{l}{b} \right \rceil - l}\)
+where \(l\) is the length of the serialized payload and \(b\) the length of a
+ciphertext block (both in bits).
+-}
+module System.FilePath.Cryptographic
+  ( CryptoFileName
+  , HasCryptoFileName
+  , module Data.Binary.SerializationLength
+  , encrypt
+  , decrypt
+  , module Data.CryptoID.Poly
+  ) where
+
+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
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
+import Data.Binary
+import Data.Binary.SerializationLength
+import Data.Char (toUpper)
+
+import Data.Ratio ((%))
+import Data.List
+
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Char8 as ByteString.Char8
+
+import Control.Monad
+import Control.Monad.Catch
+
+import Data.Proxy
+import GHC.TypeLits
+
+
+type CryptoFileName (namespace :: Symbol) = CryptoID namespace (CI FilePath)
+type HasCryptoFileName (namespace :: Symbol) = HasCryptoID namespace (CI FilePath)
+
+
+paddedLength :: Integral a => a -> a
+-- | Round up to nearest multiple of 'cipherBlockSize'
+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 (== '=') . ByteString.Char8.unpack $ 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) . ByteString.Char8.pack . 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]
+
+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

src/System/FilePath/Cryptographic/ImplicitNamespace.hs

@@ -0,0 +1,20 @@
+{-|
+Description: Reversably generate filepaths from arbitrary serializable types with implicit type level nonces
+License: BSD3
+-}
+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

stack.yaml

@@ -0,0 +1,9 @@
+snapshot: lts-24.0
+compiler: ghc-9.10.1
+
+packages:
+  - .
+
+extra-deps:
+  - git: https://gitea.uniworx.systems/haskell/cryptoid.git
+    commit: 1d3f4843377664f1679f2a18ca3160a0d02b8b1b