    {-# LANGUAGE CPP #-}
    {-
    Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- Functions for maintaining user list and session state.
    -}

    module Network.Gitit.Cache ( expireCachedFile
                               , lookupCache
                               , cacheContents )
    where

    import qualified Data.ByteString as B (ByteString, readFile, writeFile)
    import System.FilePath
    import System.Directory (doesFileExist, removeFile, createDirectoryIfMissing, getModificationTime)
    import Data.Time.Clock (UTCTime)
    #if MIN_VERSION_directory(1,2,0)
    #else
    import System.Time (ClockTime(..))
    import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
    #endif
    import Network.Gitit.State
    import Network.Gitit.Types
    import Control.Monad
    import Control.Monad.Trans (liftIO)
    import Text.Pandoc.UTF8 (encodePath)

    -- | Expire a cached file, identified by its filename in the filestore.
    -- If there is an associated exported PDF, expire it too.
    -- Returns () after deleting a file from the cache, fails if no cached file.
    expireCachedFile :: String -> GititServerPart ()
    expireCachedFile :: String -> GititServerPart ()
    expireCachedFile file :: String
    file = do
      Config
    cfg <- GititServerPart Config
    getConfig
      let target :: String
    target = String -> String
    encodePath (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    cacheDir Config
    cfg String -> String -> String
    </> String
    file
      Bool
    exists <- IO Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ServerPartT (ReaderT WikiState IO) Bool)
    -> IO Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall a b. (a -> b) -> a -> b
    $ String -> IO Bool
    doesFileExist String
    target
      Bool -> GititServerPart () -> GititServerPart ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    exists (GititServerPart () -> GititServerPart ())
    -> GititServerPart () -> GititServerPart ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> GititServerPart ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> GititServerPart ()) -> IO () -> GititServerPart ()
    forall a b. (a -> b) -> a -> b
    $ do
        IO () -> IO ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    removeFile String
    target
        String -> String -> IO ()
    expireCachedPDF String
    target (Config -> String
    defaultExtension Config
    cfg)

    expireCachedPDF :: String -> String -> IO ()
    expireCachedPDF :: String -> String -> IO ()
    expireCachedPDF file :: String
    file ext :: String
    ext =
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> String
    takeExtension String
    file String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ext) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let pdfname :: String
    pdfname = String
    file String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ".export.pdf"
        Bool
    exists <- String -> IO Bool
    doesFileExist String
    pdfname
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    exists (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    removeFile String
    pdfname

    lookupCache :: String -> GititServerPart (Maybe (UTCTime, B.ByteString))
    lookupCache :: String -> GititServerPart (Maybe (UTCTime, ByteString))
    lookupCache file :: String
    file = do
      Config
    cfg <- GititServerPart Config
    getConfig
      let target :: String
    target = String -> String
    encodePath (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    cacheDir Config
    cfg String -> String -> String
    </> String
    file
      Bool
    exists <- IO Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ServerPartT (ReaderT WikiState IO) Bool)
    -> IO Bool -> ServerPartT (ReaderT WikiState IO) Bool
    forall a b. (a -> b) -> a -> b
    $ String -> IO Bool
    doesFileExist String
    target
      if Bool
    exists
         then IO (Maybe (UTCTime, ByteString))
    -> GititServerPart (Maybe (UTCTime, ByteString))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe (UTCTime, ByteString))
     -> GititServerPart (Maybe (UTCTime, ByteString)))
    -> IO (Maybe (UTCTime, ByteString))
    -> GititServerPart (Maybe (UTCTime, ByteString))
    forall a b. (a -> b) -> a -> b
    $ do
    #if MIN_VERSION_directory(1,2,0)
           UTCTime
    modtime <- String -> IO UTCTime
    getModificationTime String
    target
    #else
           TOD secs _ <- getModificationTime target
           let modtime = posixSecondsToUTCTime $ fromIntegral secs
    #endif
           ByteString
    contents <- String -> IO ByteString
    B.readFile String
    target
           Maybe (UTCTime, ByteString) -> IO (Maybe (UTCTime, ByteString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (UTCTime, ByteString) -> IO (Maybe (UTCTime, ByteString)))
    -> Maybe (UTCTime, ByteString) -> IO (Maybe (UTCTime, ByteString))
    forall a b. (a -> b) -> a -> b
    $ (UTCTime, ByteString) -> Maybe (UTCTime, ByteString)
    forall a. a -> Maybe a
    Just (UTCTime
    modtime, ByteString
    contents)
         else Maybe (UTCTime, ByteString)
    -> GititServerPart (Maybe (UTCTime, ByteString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (UTCTime, ByteString)
    forall a. Maybe a
    Nothing

    cacheContents :: String -> B.ByteString -> GititServerPart ()
    cacheContents :: String -> ByteString -> GititServerPart ()
    cacheContents file :: String
    file contents :: ByteString
    contents = do
      Config
    cfg <- GititServerPart Config
    getConfig
      let target :: String
    target = String -> String
    encodePath (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> String
    cacheDir Config
    cfg String -> String -> String
    </> String
    file
      let targetDir :: String
    targetDir = String -> String
    takeDirectory String
    target
      IO () -> GititServerPart ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> GititServerPart ()) -> IO () -> GititServerPart ()
    forall a b. (a -> b) -> a -> b
    $ do
        Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True String
    targetDir
        String -> ByteString -> IO ()
    B.writeFile String
    target ByteString
    contents
        String -> String -> IO ()
    expireCachedPDF String
    target (Config -> String
    defaultExtension Config
    cfg)