module Botan.Hash.MD5
( MD5(..)
, MD5Digest(..)
, md5
, md5Lazy
) where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Text as Text

import qualified Botan.Hash as Botan
import qualified Botan.Utility as Botan

import Botan.Hash.Class
import Botan.Prelude

-- MD5 type

data MD5

newtype instance Digest MD5 = MD5Digest
    { Digest MD5 -> ByteString
getMD5ByteString :: ByteString {- ByteVector n -} }
    deriving newtype (Digest MD5 -> Digest MD5 -> Bool
(Digest MD5 -> Digest MD5 -> Bool)
-> (Digest MD5 -> Digest MD5 -> Bool) -> Eq (Digest MD5)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Digest MD5 -> Digest MD5 -> Bool
== :: Digest MD5 -> Digest MD5 -> Bool
$c/= :: Digest MD5 -> Digest MD5 -> Bool
/= :: Digest MD5 -> Digest MD5 -> Bool
Eq, Eq (Digest MD5)
Eq (Digest MD5) =>
(Digest MD5 -> Digest MD5 -> Ordering)
-> (Digest MD5 -> Digest MD5 -> Bool)
-> (Digest MD5 -> Digest MD5 -> Bool)
-> (Digest MD5 -> Digest MD5 -> Bool)
-> (Digest MD5 -> Digest MD5 -> Bool)
-> (Digest MD5 -> Digest MD5 -> Digest MD5)
-> (Digest MD5 -> Digest MD5 -> Digest MD5)
-> Ord (Digest MD5)
Digest MD5 -> Digest MD5 -> Bool
Digest MD5 -> Digest MD5 -> Ordering
Digest MD5 -> Digest MD5 -> Digest MD5
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Digest MD5 -> Digest MD5 -> Ordering
compare :: Digest MD5 -> Digest MD5 -> Ordering
$c< :: Digest MD5 -> Digest MD5 -> Bool
< :: Digest MD5 -> Digest MD5 -> Bool
$c<= :: Digest MD5 -> Digest MD5 -> Bool
<= :: Digest MD5 -> Digest MD5 -> Bool
$c> :: Digest MD5 -> Digest MD5 -> Bool
> :: Digest MD5 -> Digest MD5 -> Bool
$c>= :: Digest MD5 -> Digest MD5 -> Bool
>= :: Digest MD5 -> Digest MD5 -> Bool
$cmax :: Digest MD5 -> Digest MD5 -> Digest MD5
max :: Digest MD5 -> Digest MD5 -> Digest MD5
$cmin :: Digest MD5 -> Digest MD5 -> Digest MD5
min :: Digest MD5 -> Digest MD5 -> Digest MD5
Ord)

type MD5Digest = Digest MD5

instance Show (Digest MD5) where
    show :: Digest MD5 -> String
    show :: Digest MD5 -> String
show (MD5Digest ByteString
bytes) = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> HexCase -> Text
Botan.hexEncode ByteString
bytes HexCase
Botan.Lower

instance Hash MD5 where
    hash :: ByteString -> Digest MD5
    hash :: ByteString -> Digest MD5
hash = ByteString -> Digest MD5
MD5Digest (ByteString -> Digest MD5)
-> (ByteString -> ByteString) -> ByteString -> Digest MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString -> ByteString
Botan.hash Hash
Botan.md5

instance IncrementalHash MD5 where
    hashLazy :: Lazy.ByteString -> Digest MD5
    hashLazy :: ByteString -> Digest MD5
hashLazy = ByteString -> Digest MD5
MD5Digest (ByteString -> Digest MD5)
-> (ByteString -> ByteString) -> ByteString -> Digest MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString -> ByteString
Botan.hashLazy Hash
Botan.md5

-- MD5 hash

md5 :: ByteString -> MD5Digest
md5 :: ByteString -> Digest MD5
md5 = ByteString -> Digest MD5
forall hash. Hash hash => ByteString -> Digest hash
hash

md5Lazy :: Lazy.ByteString -> MD5Digest
md5Lazy :: ByteString -> Digest MD5
md5Lazy = ByteString -> Digest MD5
forall hash. IncrementalHash hash => ByteString -> Digest hash
hashLazy

-- Experimental below

-- newtype instance MutableCtx MD5 = MD5Ctx
--     { getMD5Ctx :: Botan.MutableHash }
    
-- -- TODO: Rename MutableMD5?
-- type MD5Ctx = MutableCtx MD5

-- instance (MonadIO m) => MutableHash MD5 m where

--     hashInit :: m MD5Ctx
--     hashInit = MD5Ctx <$> Botan.newHash Botan.md5

--     hashUpdate :: MD5Ctx -> ByteString -> m ()
--     hashUpdate (MD5Ctx ctx) = Botan.updateHash ctx

--     hashUpdates :: MD5Ctx -> [ByteString] -> m ()
--     hashUpdates (MD5Ctx ctx) = Botan.updateHashChunks ctx 

--     hashFinalize :: MD5Ctx -> m (Digest MD5)
--     hashFinalize (MD5Ctx ctx) = MD5Digest <$> Botan.finalizeHash ctx