~singpolyma/jingle-xmpp

jingle-xmpp/Jingle/StoreChunks.hs -rw-r--r-- 2.3 KiB
4c93bbd1Stephen Paul Weber Loosen clock 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
module Jingle.StoreChunks (storeChunks) where

import Prelude ()
import BasicPrelude
import Crypto.Hash
	(Digest, SHA1, SHA256, SHA512, hashUpdate, hashFinalize, hashInit)
import System.Directory
	(createDirectoryIfMissing, renameFile, createFileLink, doesFileExist)
import UnexceptionalIO (Unexceptional, UIO)
import qualified UnexceptionalIO as UIO
import qualified Data.ByteString as ByteString
import qualified Data.IPLD.CID as CID
import qualified Data.Multihash as Multihash

digestCID :: (Multihash.Multihashable a) => Digest a -> Text
digestCID = CID.cidToText . CID.newCidV1 CID.Raw

createLinkIfNotExist :: FilePath -> FilePath -> IO ()
createLinkIfNotExist target link = do
	exist <- doesFileExist link
	when (not exist) $ createFileLink target link

storeChunks :: (Unexceptional m) =>
	   Maybe Int
	-> FilePath
	-> String
	-> UIO (Maybe ByteString)
	-> m (
		Either
			IOError
			(FilePath, Digest SHA1, Digest SHA256, Digest SHA512)
		)
storeChunks size storePath tmpName getChunk = loop 0 hashInit hashInit hashInit
	where
	tmpPath = storePath ++ "/tmp/" ++ tmpName
	cidPath digest = storePath ++ "/" ++ textToString (digestCID digest)
	loop currentSize sha1 sha256 sha512
		| Just totalSize <- size,
		  currentSize >= totalSize = finish sha1 sha256 sha512
	loop currentSize sha1 sha256 sha512 = do
		maybeChunk <- UIO.lift getChunk
		case maybeChunk of
			Nothing -> return $ Left $ userError "Failed to getChunk"
			Just chunk
				| ByteString.null chunk -> finish sha1 sha256 sha512
				| otherwise -> step currentSize sha1 sha256 sha512 chunk

	step currentSize sha1 sha256 sha512 chunk = do
		result <- UIO.fromIO' (error.show) $ do
			createDirectoryIfMissing True (storePath ++ "/tmp")
			ByteString.appendFile tmpPath chunk
		case result of
			Left e -> return (Left e)
			Right () ->
				loop
					(currentSize + ByteString.length chunk)
					(hashUpdate sha1 chunk)
					(hashUpdate sha256 chunk)
					(hashUpdate sha512 chunk)

	finish sha1 sha256 sha512 = do
		let sha1f = hashFinalize sha1
		let sha256f = hashFinalize sha256
		let sha512f = hashFinalize sha512
		let finalPath = cidPath sha512f
		let finalCID = textToString (digestCID sha512f)
		(fmap.fmap) (const (finalPath, sha1f, sha256f, sha512f)) $
			UIO.fromIO' (error.show) $ do
				renameFile tmpPath finalPath
				createLinkIfNotExist finalCID (cidPath sha1f)
				createLinkIfNotExist finalCID (cidPath sha256f)