import Control.Monad (mfilter)
import Crypto.Hash.SHA256 (hash)
import qualified Data.ByteString as B
import Data.ByteString.Builder (byteStringHex, char7, hPutBuilder)
import Data.Functor ((<&>))
import Data.Maybe (listToMaybe)
import Data.Strict.Tuple (Pair(..))
import qualified Data.Strict.Tuple as T
import System.Environment (getArgs)
import System.IO (Handle, stdin, stdout)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as S
import Text.Read (readMaybe)

type Node a    = Pair Int a
type LevelPred = Int -> Int -> Bool
type Combine a = a -> a -> a






build :: Combine a -> [Node a] -> InputStream (Node a) -> IO (Maybe (Node a))
build combine !stack is = S.read is >>= \case
  Nothing -> return $ listToMaybe $ reduce always combine stack
  Just h  -> build combine (reduce (==) combine (h:stack)) is




reduce :: LevelPred -> Combine a -> [Node a] -> [Node a]
reduce prd combine (x@(i:!: _):y@(j:!: _):zs)
  | prd i j = reduce prd combine (nodeLift combine y x: zs)
reduce _ _ zs = zs



nodeLift :: Combine a -> Node a -> Node a -> Node a
nodeLift f (i:!: x) (j:!: y) = max i j + 1:!: f x y

always :: a -> b -> Bool
always _ _ = True



merkleTreeSha256 :: Int -> Handle -> IO (Maybe B.ByteString)
merkleTreeSha256 sz h = mkHash <&> fmap T.snd
  where mkHash = S.makeInputStream getBuf >>=
                 S.map (\bs -> 0:!: hash bs) >>=
                 build (\x y -> hash (x `B.append` y)) []
        getBuf = B.hGet h sz <&> (mfilter (/= B.empty) . Just)


printByteStringHex :: B.ByteString -> IO ()
printByteStringHex = hPutBuilder stdout . (<> char7 '\n') . byteStringHex

main :: IO ()
main = getArgs <&> map readMaybe >>= \case
  [Just sz] -> merkleTreeSha256 sz stdin >>= \case
                 Nothing -> putStrLn "No input to hash"
                 Just h  -> printByteStringHex h
  _         -> putStrLn "Argument usage: chunk-size"