~singpolyma/jingle-xmpp

ref: b9ace4a2a7890fc93df2e958bec91f4ff69185d7 jingle-xmpp/StoreChunks.hs -rw-r--r-- 2.0 KiB
b9ace4a2Stephen Paul Weber Current version in use by cheogram 1 year, 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
module 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) =>
	   FilePath
	-> String
	-> UIO (Maybe ByteString)
	-> m (
		Either
			IOError
			(FilePath, Digest SHA1, Digest SHA256, Digest SHA512)
		)
storeChunks storePath tmpName getChunk = loop hashInit hashInit hashInit
	where
	tmpPath = storePath ++ "/tmp/" ++ tmpName
	cidPath digest = storePath ++ "/" ++ textToString (digestCID digest)
	loop sha1 sha256 sha512 = do
			Just chunk <- UIO.lift getChunk
			if ByteString.null chunk then
				finish sha1 sha256 sha512
			else
				step sha1 sha256 sha512 chunk

	step 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
					(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)