{-# 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))||]