{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Tahoe.CHK.SHA256d where
import Crypto.Hash (Context, Digest, HashAlgorithm, SHA256, digestFromByteString, hash)
import Crypto.Hash.IO (HashAlgorithm (..))
import qualified Data.ByteArray as BA
import Data.ByteString (packCStringLen, useAsCString)
import qualified Data.ByteString as B
import Data.ByteString.Base32 (decodeBase32Unpadded, encodeBase32Unpadded')
import qualified Data.ByteString.Char8 as C8
import Data.Char (toLower)
import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Maybe (fromJust, fromMaybe)
import Data.Primitive (Ptr)
import Data.Primitive.Ptr (copyPtr)
import Data.String (IsString (..))
import Data.TreeDiff.Class (ToExpr (..))
import Foreign.C (CString)
newtype Digest' a = Digest' (Digest a) deriving newtype (Digest' a -> Digest' a -> Bool
(Digest' a -> Digest' a -> Bool)
-> (Digest' a -> Digest' a -> Bool) -> Eq (Digest' a)
forall a. Digest' a -> Digest' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Digest' a -> Digest' a -> Bool
$c/= :: forall a. Digest' a -> Digest' a -> Bool
== :: Digest' a -> Digest' a -> Bool
$c== :: forall a. Digest' a -> Digest' a -> Bool
Eq, Eq (Digest' a)
Eq (Digest' a)
-> (Digest' a -> Digest' a -> Ordering)
-> (Digest' a -> Digest' a -> Bool)
-> (Digest' a -> Digest' a -> Bool)
-> (Digest' a -> Digest' a -> Bool)
-> (Digest' a -> Digest' a -> Bool)
-> (Digest' a -> Digest' a -> Digest' a)
-> (Digest' a -> Digest' a -> Digest' a)
-> Ord (Digest' a)
Digest' a -> Digest' a -> Bool
Digest' a -> Digest' a -> Ordering
Digest' a -> Digest' a -> Digest' a
forall a. Eq (Digest' a)
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
forall a. Digest' a -> Digest' a -> Bool
forall a. Digest' a -> Digest' a -> Ordering
forall a. Digest' a -> Digest' a -> Digest' a
min :: Digest' a -> Digest' a -> Digest' a
$cmin :: forall a. Digest' a -> Digest' a -> Digest' a
max :: Digest' a -> Digest' a -> Digest' a
$cmax :: forall a. Digest' a -> Digest' a -> Digest' a
>= :: Digest' a -> Digest' a -> Bool
$c>= :: forall a. Digest' a -> Digest' a -> Bool
> :: Digest' a -> Digest' a -> Bool
$c> :: forall a. Digest' a -> Digest' a -> Bool
<= :: Digest' a -> Digest' a -> Bool
$c<= :: forall a. Digest' a -> Digest' a -> Bool
< :: Digest' a -> Digest' a -> Bool
$c< :: forall a. Digest' a -> Digest' a -> Bool
compare :: Digest' a -> Digest' a -> Ordering
$ccompare :: forall a. Digest' a -> Digest' a -> Ordering
$cp1Ord :: forall a. Eq (Digest' a)
Ord)
instance HashAlgorithm hash => Show (Digest' hash) where
show :: Digest' hash -> String
show (Digest' Digest hash
digest) = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> (Digest hash -> String) -> Digest hash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C8.unpack (ByteString -> String)
-> (Digest hash -> ByteString) -> Digest hash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encodeBase32Unpadded' (ByteString -> ByteString)
-> (Digest hash -> ByteString) -> Digest hash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest hash -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes (Digest hash -> String) -> Digest hash -> String
forall a b. (a -> b) -> a -> b
$ Digest hash
digest
instance ToExpr (Digest' a) where
toExpr :: Digest' a -> Expr
toExpr (Digest' Digest a
d) = ByteString -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Digest a -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes Digest a
d)
deriving instance BA.ByteArrayAccess (Digest' hash)
instance HashAlgorithm hash => IsString (Digest' hash) where
fromString :: String -> Digest' hash
fromString =
Digest hash -> Digest' hash
forall a. Digest a -> Digest' a
Digest'
(Digest hash -> Digest' hash)
-> (String -> Digest hash) -> String -> Digest' hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest hash -> Maybe (Digest hash) -> Digest hash
forall a. a -> Maybe a -> a
fromMaybe (String -> Digest hash
forall a. HasCallStack => String -> a
error String
"invalid base32-encoded digest")
(Maybe (Digest hash) -> Digest hash)
-> (String -> Maybe (Digest hash)) -> String -> Digest hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Digest hash))
-> (ByteString -> Maybe (Digest hash))
-> Either Text ByteString
-> Maybe (Digest hash)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Text -> Maybe (Digest hash)
forall a. HasCallStack => String -> a
error String
"invalid base32-encoded digest") ByteString -> Maybe (Digest hash)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString
(Either Text ByteString -> Maybe (Digest hash))
-> (String -> Either Text ByteString)
-> String
-> Maybe (Digest hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase32Unpadded
(ByteString -> Either Text ByteString)
-> (String -> ByteString) -> String -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack
zero :: forall hash. HashAlgorithm hash => Digest' hash
zero :: Digest' hash
zero = Digest hash -> Digest' hash
forall a. Digest a -> Digest' a
Digest' (Digest hash -> Digest' hash)
-> (Word8 -> Digest hash) -> Word8 -> Digest' hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Digest hash) -> Digest hash
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Digest hash) -> Digest hash)
-> (Word8 -> Maybe (Digest hash)) -> Word8 -> Digest hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba.
(HashAlgorithm hash, ByteArrayAccess ba) =>
ba -> Maybe (Digest hash)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @hash (ByteString -> Maybe (Digest hash))
-> (Word8 -> ByteString) -> Word8 -> Maybe (Digest hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ByteString
B.replicate (hash -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (hash
forall a. HasCallStack => a
undefined :: hash)) (Word8 -> Digest' hash) -> Word8 -> Digest' hash
forall a b. (a -> b) -> a -> b
$ Word8
0
data DoubleHash hash = DoubleHash
type SHA256d = DoubleHash SHA256
deriving instance Show hash => Show (DoubleHash hash)
deriving instance Data hash => Data (DoubleHash hash)
instance HashAlgorithm hash => HashAlgorithm (DoubleHash hash) where
type HashBlockSize (DoubleHash hash) = HashBlockSize hash
type HashDigestSize (DoubleHash hash) = HashDigestSize hash
type HashInternalContextSize (DoubleHash hash) = HashInternalContextSize hash
hashBlockSize :: DoubleHash hash -> Int
hashBlockSize DoubleHash hash
_ = hash -> Int
forall a. HashAlgorithm a => a -> Int
hashBlockSize @hash hash
forall a. HasCallStack => a
undefined
hashDigestSize :: DoubleHash hash -> Int
hashDigestSize DoubleHash hash
_ = hash -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize @hash hash
forall a. HasCallStack => a
undefined
hashInternalContextSize :: DoubleHash hash -> Int
hashInternalContextSize DoubleHash hash
_ = hash -> Int
forall a. HashAlgorithm a => a -> Int
hashInternalContextSize @hash hash
forall a. HasCallStack => a
undefined
hashInternalInit :: Ptr (Context (DoubleHash hash)) -> IO ()
hashInternalInit Ptr (Context (DoubleHash hash))
ctxPtr = Ptr (Context hash) -> IO ()
forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit (Ptr (Context (DoubleHash hash)) -> Ptr (Context hash)
coerce Ptr (Context (DoubleHash hash))
ctxPtr :: Ptr (Context hash))
hashInternalUpdate :: Ptr (Context (DoubleHash hash)) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate Ptr (Context (DoubleHash hash))
ctxPtr = Ptr (Context hash) -> Ptr Word8 -> Word32 -> IO ()
forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate (Ptr (Context (DoubleHash hash)) -> Ptr (Context hash)
coerce Ptr (Context (DoubleHash hash))
ctxPtr :: Ptr (Context hash))
hashInternalFinalize :: Ptr (Context (DoubleHash hash))
-> Ptr (Digest (DoubleHash hash)) -> IO ()
hashInternalFinalize Ptr (Context (DoubleHash hash))
ctxPtr Ptr (Digest (DoubleHash hash))
digestPtr = do
Ptr (Context hash) -> Ptr (Digest hash) -> IO ()
forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr (Digest a) -> IO ()
hashInternalFinalize
(Ptr (Context (DoubleHash hash)) -> Ptr (Context hash)
coerce Ptr (Context (DoubleHash hash))
ctxPtr :: Ptr (Context hash))
(Ptr (Digest (DoubleHash hash)) -> Ptr (Digest hash)
coerce Ptr (Digest (DoubleHash hash))
digestPtr :: Ptr (Digest hash))
ByteString
firstHash <- Ptr (Digest (DoubleHash hash)) -> IO ByteString
forall hash.
HashAlgorithm hash =>
Ptr (Digest hash) -> IO ByteString
digestPtrToByteString Ptr (Digest (DoubleHash hash))
digestPtr
let secondHash :: Digest hash
secondHash = ByteString -> Digest hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
firstHash :: Digest hash
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (Digest hash -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes Digest hash
secondHash) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
new -> CString -> CString -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> Ptr a -> Int -> m ()
copyPtr (Ptr (Digest (DoubleHash hash)) -> CString
coerce Ptr (Digest (DoubleHash hash))
digestPtr :: CString) CString
new (hash -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize @hash hash
forall a. HasCallStack => a
undefined)
toBytes :: BA.ByteArrayAccess a => a -> B.ByteString
toBytes :: a -> ByteString
toBytes = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> (a -> [Word8]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack
digestPtrToByteString :: forall hash. HashAlgorithm hash => Ptr (Digest hash) -> IO B.ByteString
digestPtrToByteString :: Ptr (Digest hash) -> IO ByteString
digestPtrToByteString = CStringLen -> IO ByteString
packCStringLen (CStringLen -> IO ByteString)
-> (Ptr (Digest hash) -> CStringLen)
-> Ptr (Digest hash)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,hash -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize @hash hash
forall a. HasCallStack => a
undefined) (CString -> CStringLen)
-> (Ptr (Digest hash) -> CString)
-> Ptr (Digest hash)
-> CStringLen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible (Ptr (Digest hash)) CString =>
Ptr (Digest hash) -> CString
coerce @(Ptr (Digest hash)) @CString