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