c7f4fa0e41
BREAKING CHANGE: digests now json encode via base64 Also improve efficiency of marking workflow files as referenced
67 lines
2.4 KiB
Haskell
67 lines
2.4 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Crypto.Hash.Instances
|
|
() where
|
|
|
|
import ClassyPrelude
|
|
|
|
import Crypto.Hash hiding (hash)
|
|
|
|
import Database.Persist
|
|
import Database.Persist.Sql
|
|
|
|
import Data.ByteArray (convert)
|
|
|
|
import Web.PathPieces
|
|
import Web.HttpApiData
|
|
import Data.Aeson as Aeson
|
|
|
|
import Control.Monad.Fail
|
|
|
|
import Language.Haskell.TH.Syntax (Lift(liftTyped))
|
|
import Instances.TH.Lift ()
|
|
|
|
import Data.Binary
|
|
import qualified Data.Binary.Put as Binary
|
|
import qualified Data.Binary.Get as Binary
|
|
|
|
import qualified Data.ByteString.Base64.URL as Base64
|
|
|
|
import Type.Reflection (typeRep)
|
|
|
|
|
|
instance HashAlgorithm hash => PersistField (Digest hash) where
|
|
toPersistValue = PersistByteString . convert
|
|
fromPersistValue (PersistByteString bs) = maybe (Left "Could not convert Digest from ByteString") Right $ digestFromByteString bs
|
|
fromPersistValue (PersistText t) = maybe (Left "Cours not convert Digest from String") Right $ readMay t
|
|
fromPersistValue _ = Left "Digest values must be converted from PersistByteString or PersistText"
|
|
|
|
instance HashAlgorithm hash => PersistFieldSql (Digest hash) where
|
|
sqlType _ = SqlBlob
|
|
|
|
instance HashAlgorithm hash => PathPiece (Digest hash) where
|
|
toPathPiece = decodeUtf8 . Base64.encodeUnpadded . convert
|
|
fromPathPiece = digestFromByteString <=< either (const Nothing) Just . Base64.decodeUnpadded . encodeUtf8
|
|
|
|
instance HashAlgorithm hash => ToHttpApiData (Digest hash) where
|
|
toUrlPiece = toPathPiece
|
|
|
|
instance HashAlgorithm hash => FromHttpApiData (Digest hash) where
|
|
parseUrlPiece = maybe (Left "Could not read Digest") Right . fromPathPiece
|
|
|
|
instance HashAlgorithm hash => ToJSON (Digest hash) where
|
|
toJSON = Aeson.String . toUrlPiece
|
|
|
|
instance HashAlgorithm hash => FromJSON (Digest hash) where
|
|
parseJSON = withText "Digest" $ either (fail . unpack) return . parseUrlPiece
|
|
|
|
instance Typeable hash => Hashable (Digest hash) where
|
|
hashWithSalt s h = s `hashWithSalt` hash (typeRep @hash) `hashWithSalt` hash @ByteString (convert h)
|
|
|
|
instance HashAlgorithm hash => Lift (Digest hash) where
|
|
liftTyped dgst = [||fromMaybe (error "Lifted digest has wrong length") $ digestFromByteString $$(liftTyped (convert dgst :: ByteString))||]
|
|
|
|
instance HashAlgorithm hash => Binary (Digest hash) where
|
|
put = Binary.putByteString . convert
|
|
get = Binary.getByteString (hashDigestSize (error "hashDigestSize inspected value of type hash" :: hash)) >>= maybe (fail "Could not parse Digest") return . digestFromByteString
|