-- | Utilities to interact with the dhall-docs home directory

{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# LANGUAGE QuasiQuotes #-}

module Dhall.Docs.Store (getDocsHomeDirectory, makeHashForDirectory) where

import Crypto.Hash  (Digest, SHA256)
import Dhall.Crypto (SHA256Digest (..))
import Path         (Abs, Dir, Path, Rel, (</>))
import Path.IO      (XdgDirectory (..))

import qualified Control.Monad           as Monad
import qualified Crypto.Hash             as Hash
import qualified Data.ByteArray          as ByteArray
import qualified Data.ByteString         as ByteString
import qualified Data.ByteString.Char8   as ByteString.Char8
import qualified Data.List               as List
import qualified Path
import qualified Path.IO

{-| Fetches the dhall-docs home directory. If @XDG_DATA_HOME@ env var is
    defined, then @${XDG_DATA_HOME}/dhall-docs@ will be returned. Otherwise,
    "${HOME}/.local/share/dhall-docs"
-}
getDocsHomeDirectory :: IO (Path Abs Dir)
getDocsHomeDirectory :: IO (Path Abs Dir)
getDocsHomeDirectory = do
    Path Abs Dir
dir <- XdgDirectory -> Maybe (Path Rel Dir) -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> Maybe (Path Rel Dir) -> m (Path Abs Dir)
Path.IO.getXdgDir XdgDirectory
Path.IO.XdgData (Maybe (Path Rel Dir) -> IO (Path Abs Dir))
-> Maybe (Path Rel Dir) -> IO (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> Maybe (Path Rel Dir)
forall a. a -> Maybe a
Just (Path Rel Dir -> Maybe (Path Rel Dir))
-> Path Rel Dir -> Maybe (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ [Path.reldir|dhall-docs|]
    Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
Path.IO.ensureDir Path Abs Dir
dir
    Path Abs Dir -> IO (Path Abs Dir)
forall (m :: * -> *) a. Monad m => a -> m a
return Path Abs Dir
dir

{-| Compute the hash for a directory. It takes into account the hierarchy
    structure of it and the contents of its files, but not the name of the
    actual files.

    This is done by computing the hash of each file and sorting them by its
    absolute file name, and computing the hash of the concatenation of all
    hashes.
-}
makeHashForDirectory :: Path Abs Dir -> IO SHA256Digest
makeHashForDirectory :: Path Abs Dir -> IO SHA256Digest
makeHashForDirectory Path Abs Dir
dir = do
    ([Path Rel Dir]
dirs, [Path Rel File]
files) <- Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
Path.IO.listDirRecurRel Path Abs Dir
dir

    let context0 :: Context SHA256
context0 = Context SHA256
forall a. HashAlgorithm a => Context a
Hash.hashInit

    let addDir :: Context a -> Path b t -> m (Context a)
addDir Context a
context Path b t
directory = do
            let nameBytes :: ByteString
nameBytes = [Char] -> ByteString
ByteString.Char8.pack (Path b t -> [Char]
forall b t. Path b t -> [Char]
Path.toFilePath Path b t
directory)

            Context a -> m (Context a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context a -> m (Context a)) -> Context a -> m (Context a)
forall a b. (a -> b) -> a -> b
$! Context a -> ByteString -> Context a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
Hash.hashUpdate Context a
context ByteString
nameBytes

    Context SHA256
context1 <- (Context SHA256 -> Path Rel Dir -> IO (Context SHA256))
-> Context SHA256 -> [Path Rel Dir] -> IO (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Context SHA256 -> Path Rel Dir -> IO (Context SHA256)
forall (m :: * -> *) a b t.
(Monad m, HashAlgorithm a) =>
Context a -> Path b t -> m (Context a)
addDir Context SHA256
context0 ([Path Rel Dir] -> [Path Rel Dir]
forall a. Ord a => [a] -> [a]
List.sort [Path Rel Dir]
dirs)

    let addFile :: Context a -> Path Rel t -> IO (Context a)
addFile Context a
context Path Rel t
file = do
            let nameBytes :: ByteString
nameBytes = [Char] -> ByteString
ByteString.Char8.pack (Path Rel t -> [Char]
forall b t. Path b t -> [Char]
Path.toFilePath Path Rel t
file)

            ByteString
contentBytes <- [Char] -> IO ByteString
ByteString.readFile (Path Abs t -> [Char]
forall b t. Path b t -> [Char]
Path.toFilePath (Path Abs Dir
dir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
file))

            Context a -> IO (Context a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context a -> IO (Context a)) -> Context a -> IO (Context a)
forall a b. (a -> b) -> a -> b
$! Context a -> [ByteString] -> Context a
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
Hash.hashUpdates Context a
context [ ByteString
nameBytes, ByteString
contentBytes ]

    Context SHA256
context2 <- (Context SHA256 -> Path Rel File -> IO (Context SHA256))
-> Context SHA256 -> [Path Rel File] -> IO (Context SHA256)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Context SHA256 -> Path Rel File -> IO (Context SHA256)
forall a t.
HashAlgorithm a =>
Context a -> Path Rel t -> IO (Context a)
addFile Context SHA256
context1 ([Path Rel File] -> [Path Rel File]
forall a. Ord a => [a] -> [a]
List.sort [Path Rel File]
files)

    let digest :: Digest SHA256
        digest :: Digest SHA256
digest = Context SHA256 -> Digest SHA256
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize Context SHA256
context2

    SHA256Digest -> IO SHA256Digest
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> SHA256Digest
SHA256Digest (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert Digest SHA256
digest))