54 lines
1.8 KiB
Haskell
54 lines
1.8 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Crypto.Hash.Instances
|
|
() where
|
|
|
|
import ClassyPrelude
|
|
|
|
import Crypto.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 ()
|
|
|
|
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 = showToPathPiece
|
|
fromPathPiece = readFromPathPiece
|
|
|
|
instance HashAlgorithm hash => ToHttpApiData (Digest hash) where
|
|
toUrlPiece = tshow
|
|
|
|
instance HashAlgorithm hash => FromHttpApiData (Digest hash) where
|
|
parseUrlPiece = maybe (Left "Could not read Digest") Right . readMay
|
|
|
|
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 Hashable (Digest hash) where
|
|
hashWithSalt s = (hashWithSalt s :: ByteString -> Int) . convert
|
|
|
|
instance HashAlgorithm hash => Lift (Digest hash) where
|
|
liftTyped dgst = [||fromMaybe (error "Lifted digest has wrong length") $ digestFromByteString $$(liftTyped (convert dgst :: ByteString))||]
|