tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

Digest.hs (1495B)

      1 -- Scoped SHA-256 state, deliberately independent of writers and publication.
      2 module IO.Digest (openDigest) where
      3 
      4 import qualified IO.Resources as R
      5 import Crypto.Hash (Context, SHA256, Digest, hashInit, hashUpdate, hashFinalize)
      6 import Data.ByteArray (convert)
      7 import qualified Data.ByteString.Base16 as Hex
      8 import qualified Data.ByteString.Char8 as BC
      9 import Data.IORef
     10 import Control.Exception (evaluate, mask_)
     11 
     12 openDigest :: R.Runtime -> R.Scope -> String -> IO (Either R.Problem R.Token)
     13 openDigest runtime scope algorithm
     14   | algorithm /= "sha256" = pure (Left (R.Problem "unsupported" "digest-open" (take 128 algorithm) "none"))
     15   | otherwise = R.acquire runtime scope $ do
     16       state <- newIORef (Just (hashInit :: Context SHA256))
     17       let active op = readIORef state >>= maybe
     18             (R.resourceFault (R.Problem "invalid-state" op "digest already finished" "none")) pure
     19           update bytes = mask_ $ do
     20             context <- active "digest-update"
     21             -- Force the new context before storing it: no chain of old chunks.
     22             next <- evaluate (hashUpdate context bytes)
     23             writeIORef state (Just next)
     24           finish = mask_ $ do
     25             context <- active "digest-finish"
     26             let encoded = Hex.encode (convert (hashFinalize context :: Digest SHA256))
     27             _ <- evaluate (BC.length encoded)
     28             writeIORef state Nothing
     29             pure (BC.unpack encoded)
     30       pure (R.Digest update finish (writeIORef state Nothing))