55 lines
1.8 KiB
Haskell
55 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 Data.ByteArray.Encoding
|
|
|
|
import qualified Data.ByteString.Char8 as CBS
|
|
|
|
import Web.PathPieces
|
|
import Web.HttpApiData
|
|
import Data.Aeson as Aeson
|
|
|
|
import Text.Read as Read
|
|
|
|
|
|
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 => Read (Digest hash) where
|
|
readPrec = do
|
|
str <- replicateM (2 * hashDigestSize (error "Value of type hash forced" :: hash)) Read.get
|
|
bs <- either fail return . convertFromBase Base16 $ CBS.pack str
|
|
maybe (fail "Could not convert digestFromByteString") return $ digestFromByteString (bs :: ByteString)
|
|
|
|
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
|